[cmucl-commit] [git] CMU Common Lisp branch master updated. snapshot-2014-09-29-g3ff38ff

[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  3ff38ffa166153b7266ecdb04a3ff59b85b4c0b4 (commit)
      from  2f316750cc7f9ed3b49349c2ca858a8d31e1ceb9 (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 3ff38ffa166153b7266ecdb04a3ff59b85b4c0b4
Author: Raymond Toy <toy.raymond at gmail.com>
Date:   Wed Oct 1 20:59:56 2014 -0700

    Add FAST-ASH-C/FIXNUM=>SIGNED vop.
    
    This allows the compiler to shift a fixnum to a signed-reg without
    first converting the fixnum to a signed-reg, saving a shift.

diff --git a/src/compiler/x86/arith.lisp b/src/compiler/x86/arith.lisp
index d889e47..3b51b05 100644
--- a/src/compiler/x86/arith.lisp
+++ b/src/compiler/x86/arith.lisp
@@ -750,6 +750,41 @@
 		  ;; at the low five bits of the result.
 		  (inst sar result (min 31 (- amount)))))))))
 
+(define-vop (fast-ash-c/fixnum=>signed)
+  (:translate ash)
+  (:policy :fast-safe)
+  (:args (number :scs (any-reg) :target result
+		 :load-if (not (and (sc-is number signed-stack)
+				    (sc-is result signed-stack)
+				    (location= number result)))))
+  (:info amount)
+  (:arg-types fixnum (:constant integer))
+  (:results (result :scs (signed-reg)
+		    :load-if (not (and (sc-is number signed-stack)
+				       (sc-is result signed-stack)
+				       (location= number result)))))
+  (:result-types signed-num)
+  (:note "inline ASH")
+  (:generator 1
+    (let ((shift (- amount vm:fixnum-tag-bits)))
+      (cond ((and (= shift 1) (not (location= number result)))
+	     (inst lea result (make-ea :dword :index number :scale 2)))
+	    ((and (= shift 2) (not (location= number result)))
+	     (inst lea result (make-ea :dword :index number :scale 4)))
+	    ((and (= shift 3) (not (location= number result)))
+	     (inst lea result (make-ea :dword :index number :scale 8)))
+	    (t
+	     (move result number)
+	     (cond ((plusp shift)
+		    ;; We don't have to worry about overflow because of the
+		    ;; result type restriction.
+		    (inst shl result shift))
+		   (t
+		    ;; If the shift is greater than 31, only shift by 31.  We
+		    ;; have to do this because the shift instructions only look
+		    ;; at the low five bits of the result.
+		    (inst sar result (min 31 (- shift))))))))))
+
 (define-vop (fast-ash-left/unsigned=>unsigned)
   (:translate ash)
   (:args (number :scs (unsigned-reg) :target result

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

Summary of changes:
 src/compiler/x86/arith.lisp |   35 +++++++++++++++++++++++++++++++++++
 1 file changed, 35 insertions(+)


hooks/post-receive
-- 
CMU Common Lisp