1.0.15.9: further ASSOC & MEMBER transform improvements

[sbcl.git] / src / compiler / x86 / arith.lisp

diff --git a/src/compiler/x86/arith.lisp b/src/compiler/x86/arith.lisp
index 1b29e8d..7511b32 100644 (file)
--- a/src/compiler/x86/arith.lisp
+++ b/src/compiler/x86/arith.lisp
@@ -597,24 +597,27 @@
   (:note "inline ASH")
   (:generator 2
     (cond ((and (= amount 1) (not (location= number result)))
-           (inst lea result (make-ea :dword :index number :scale 2)))
+           (inst lea result (make-ea :dword :base number :index number)))
           ((and (= amount 2) (not (location= number result)))
            (inst lea result (make-ea :dword :index number :scale 4)))
           ((and (= amount 3) (not (location= number result)))
            (inst lea result (make-ea :dword :index number :scale 8)))
           (t
            (move result number)
-           (cond ((plusp amount)
-                  ;; We don't have to worry about overflow because of the
-                  ;; result type restriction.
-                  (inst shl result amount))
-                 (t
-                  ;; If the amount 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 (- amount)))
-                  ;; Fixnum correction.
-                  (inst and result (lognot fixnum-tag-mask))))))))
+           (cond ((< -32 amount 32)
+                  ;; this code is used both in ASH and ASH-SMOD30, so
+                  ;; be careful
+                  (if (plusp amount)
+                      (inst shl result amount)
+                      (progn
+                        (inst sar result (- amount))
+                        (inst and result (lognot fixnum-tag-mask)))))
+                 ((plusp amount)
+                  (if (sc-is result any-reg)
+                      (inst xor result result)
+                      (inst mov result 0)))
+                 (t (inst sar result 31)
+                    (inst and result (lognot fixnum-tag-mask))))))))
 
 (define-vop (fast-ash-left/fixnum=>fixnum)
   (:translate ash)
@@ -655,7 +658,7 @@
   (:note "inline ASH")
   (:generator 3
     (cond ((and (= amount 1) (not (location= number result)))
-           (inst lea result (make-ea :dword :index number :scale 2)))
+           (inst lea result (make-ea :dword :base number :index number)))
           ((and (= amount 2) (not (location= number result)))
            (inst lea result (make-ea :dword :index number :scale 4)))
           ((and (= amount 3) (not (location= number result)))
@@ -682,7 +685,7 @@
   (:note "inline ASH")
   (:generator 3
     (cond ((and (= amount 1) (not (location= number result)))
-           (inst lea result (make-ea :dword :index number :scale 2)))
+           (inst lea result (make-ea :dword :base number :index number)))
           ((and (= amount 2) (not (location= number result)))
            (inst lea result (make-ea :dword :index number :scale 4)))
           ((and (= amount 3) (not (location= number result)))
@@ -1476,7 +1479,9 @@
 
 (define-full-reffer bignum-ref * bignum-digits-offset other-pointer-lowtag
   (unsigned-reg) unsigned-num sb!bignum:%bignum-ref)
-
+(define-full-reffer+offset bignum-ref-with-offset *
+  bignum-digits-offset other-pointer-lowtag
+  (unsigned-reg) unsigned-num sb!bignum:%bignum-ref-with-offset)
 (define-full-setter bignum-set * bignum-digits-offset other-pointer-lowtag
   (unsigned-reg) unsigned-num sb!bignum:%bignum-set)
 
@@ -1736,10 +1741,7 @@
   (:results (y :scs (unsigned-reg) :from (:eval 0)))
   (:result-types unsigned-num)
   (:generator 50
-    (inst mov k (make-ea :dword :base state
-                         :disp (- (* (+ 2 vector-data-offset)
-                                     n-word-bytes)
-                                  other-pointer-lowtag)))
+    (loadw k state (+ 2 vector-data-offset) other-pointer-lowtag)
     (inst cmp k 624)
     (inst jmp :ne no-update)
     (inst mov tmp state)        ; The state is passed in EAX.
@@ -1748,25 +1750,15 @@
     (inst xor k k)
     NO-UPDATE
     ;; y = ptgfsr[k++];
-    (inst mov y (make-ea :dword :base state :index k :scale 4
-                         :disp (- (* (+ 3 vector-data-offset)
-                                     n-word-bytes)
-                                  other-pointer-lowtag)))
+    (inst mov y (make-ea-for-vector-data state :index k :offset 3))
     ;; y ^= (y >> 11);
     (inst shr y 11)
-    (inst xor y (make-ea :dword :base state :index k :scale 4
-                         :disp (- (* (+ 3 vector-data-offset)
-                                     n-word-bytes)
-                                  other-pointer-lowtag)))
+    (inst xor y (make-ea-for-vector-data state :index k :offset 3))
     ;; y ^= (y << 7) & #x9d2c5680
     (inst mov tmp y)
     (inst inc k)
     (inst shl tmp 7)
-    (inst mov (make-ea :dword :base state
-                       :disp (- (* (+ 2 vector-data-offset)
-                                   n-word-bytes)
-                                other-pointer-lowtag))
-          k)
+    (storew k state (+ 2 vector-data-offset) other-pointer-lowtag)
     (inst and tmp #x9d2c5680)
     (inst xor y tmp)
     ;; y ^= (y << 15) & #xefc60000