[cmucl-cvs] [git] CMU Common Lisp branch master updated. snapshot-2013-02-4-gd1af0b8

[Raymond Toy]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "CMU Common Lisp".

The branch, master has been updated
       via  d1af0b85c857baaa7bab870b22590b7b44486a7f (commit)
      from  089f104aa5fe1af71c8172a43a2330cc241479c2 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit d1af0b85c857baaa7bab870b22590b7b44486a7f
Author: Raymond Toy <toy.raymond at gmail.com>
Date:   Mon Feb 18 16:17:24 2013 -0800

    Optimize TRUNCATE when the second arg is a compile-time constant.

diff --git a/src/compiler/x86/arith.lisp b/src/compiler/x86/arith.lisp
index 5751abb..6739f9b 100644
--- a/src/compiler/x86/arith.lisp
+++ b/src/compiler/x86/arith.lisp
@@ -474,6 +474,7 @@
 	(inst lea quo (make-ea :dword :index eax :scale 4)))
     (move rem edx)))
 
+#+nil
 (define-vop (fast-truncate-c/fixnum=>fixnum fast-safe-arith-op)
   (:translate truncate)
   (:args (x :scs (any-reg) :target eax))
@@ -527,6 +528,7 @@
     (move quo eax)
     (move rem edx)))
 
+#+nil
 (define-vop (fast-truncate-c/unsigned=>unsigned fast-safe-arith-op)
   (:translate truncate)
   (:args (x :scs (unsigned-reg) :target eax))
@@ -551,6 +553,44 @@
     (move quo eax)
     (move rem edx)))
 
+(define-vop (fast-truncate-c/unsigned=>unsigned fast-unsigned-binop-c)
+  (:translate truncate)
+  (:args (x :scs (unsigned-reg)))
+  (:info y)
+  (:arg-types unsigned-num (:constant (integer 2 #.(1- (ash 1 vm:word-bits)))))
+  (:results (r :scs (unsigned-reg))
+            (rem :scs (unsigned-reg)))
+  (:result-types unsigned-num unsigned-num)
+  (:note "inline (unsigned-byte 32) arithmetic")
+  (:temporary (:sc unsigned-reg :offset edx-offset) edx)
+  (:temporary (:sc unsigned-reg :offset eax-offset) eax)
+  (:generator 6
+    (multiple-value-bind (recip shift overflowp)
+        (c::find-unsigned-reciprocal y vm:word-bits)
+      ;; q = floor(M*x/2^32)
+      (inst mov eax recip)
+      (inst mul eax x)			; edx:eax = x*recip
+      (cond (overflowp
+	     ;; The case where the sum overflows.  X86 has a rotate
+	     ;; with carry instruction so use that to get the MSB of
+	     ;; the sum and then a regular shift to get the correct
+	     ;; number of shifts.
+	     (inst add edx x)
+	     (inst rcr edx 1)
+	     (when (> shift 1)
+	       (inst shr edx (1- shift))))
+            (t
+             ;; The easy case
+             (unless (zerop shift)
+               (inst shr edx shift))))
+      ;; Compute the remainder
+      (move rem x)			; Save x in case r is the same tn
+      (move r edx)
+      (move eax edx)
+      (inst mov edx y)
+      (inst mul eax edx)
+      (inst sub rem eax))))
+
 (define-vop (fast-truncate/signed=>signed fast-safe-arith-op)
   (:translate truncate)
   (:args (x :scs (signed-reg) :target eax)
@@ -578,6 +618,7 @@
     (move quo eax)
     (move rem edx)))
 
+#+nil
 (define-vop (fast-truncate-c/signed=>signed fast-safe-arith-op)
   (:translate truncate)
   (:args (x :scs (signed-reg) :target eax))
@@ -602,6 +643,43 @@
     (move quo eax)
     (move rem edx)))
 
+(define-vop (fast-truncate-c/signed=>signed fast-signed-binop-c)
+  (:translate truncate)
+  (:args (x :scs (signed-reg)))
+  (:info y)
+  (:arg-types signed-num (:constant (integer 2 #.(1- (ash 1 vm:word-bits)))))
+  (:results (r :scs (signed-reg))
+            (rem :scs (signed-reg)))
+  (:result-types signed-num signed-num)
+  (:note "inline (signed-byte 32) arithmetic")
+  (:temporary (:sc signed-reg :offset edx-offset) edx)
+  (:temporary (:sc signed-reg :offset eax-offset) eax)
+  (:generator 13
+    (multiple-value-bind (recip shift)
+        (c::find-signed-reciprocal y vm:word-bits)
+      ;; Compute q = floor(M*n/2^32).  That is, the high half of the
+      ;; product.
+      (inst mov eax recip)
+      (inst imul x)			; edx:eax = x * recip
+      ;; Adjust if the M is negative.
+      (when (minusp recip)
+        (inst add edx x))
+      ;; Shift quotient as needed.
+      (unless (zerop shift)
+	(inst sar edx shift))
+      ;; Add one to quotient if X is negative.  This is done by right
+      ;; shifting X to give either -1 or 0.  Then subtract this from
+      ;; the quotient.  (NOTE: in the book, the sample code has this
+      ;; wrong and ADDS instead of SUBTRACTS.)
+      (move eax x)
+      (inst sar eax 31)
+      (inst sub edx eax)
+
+      ;; Now compute the remainder.
+      (move rem x)
+      (move r edx)			; Save quotient for return
+      (inst imul edx y)			; edx = q * y
+      (inst sub rem edx))))
 
 
 ;;;; Shifting
diff --git a/src/general-info/release-20e.txt b/src/general-info/release-20e.txt
index e5b7331..8d14c58 100644
--- a/src/general-info/release-20e.txt
+++ b/src/general-info/release-20e.txt
@@ -31,7 +31,9 @@ New in this release:
     * The sparc port can be built using gcc once again.
     * The old Cheney stop-and-copy GC supported on sparc once again.
       However, there are no plans on supplying sparc binaries with
-      this GC. 
+      this GC.
+    * For x86, optimize TRUNCATE when the second arg is a compile-time
+      constant.  (Sparc and ppc already had this optimization)
 
   * ANSI compliance fixes:
 

-----------------------------------------------------------------------

Summary of changes:
 src/compiler/x86/arith.lisp      |   78 ++++++++++++++++++++++++++++++++++++++
 src/general-info/release-20e.txt |    4 +-
 2 files changed, 81 insertions(+), 1 deletions(-)


hooks/post-receive
-- 
CMU Common Lisp