X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fgeneric%2Fvm-tran.lisp;h=256ead30be28f6d43f185f67c64cfb3039e7f763;hb=cd1b14acf6f548b28b8a14e554d779f0473122ec;hp=cd675186ce5b4a110d1177f8e6c723c844c09059;hpb=47c0c169c106f17a212593cb781bb792355cb5d3;p=sbcl.git

diff --git a/src/compiler/generic/vm-tran.lisp b/src/compiler/generic/vm-tran.lisp
index cd67518..256ead3 100644
--- a/src/compiler/generic/vm-tran.lisp
+++ b/src/compiler/generic/vm-tran.lisp
@@ -50,20 +50,24 @@
                               index offset &optional setter-p)
   (multiple-value-bind (func index-args) (extract-fun-args index '(+ -) 2)
     (destructuring-bind (x constant) index-args
-      (declare (ignorable x))
-      (unless (constant-lvar-p constant)
+      (unless (and (constant-lvar-p constant)
+                   ;; we lose if the remaining argument isn't a fixnum
+                   (csubtypep (lvar-type x) (specifier-type 'fixnum)))
         (give-up-ir1-transform))
-      (let ((value (lvar-value constant)))
+      (let ((value (lvar-value constant))
+            new-offset)
         (unless (and (integerp value)
                      (sb!vm::foldable-constant-offset-p
                       element-size lowtag data-offset
-                      (funcall func value (lvar-value offset))))
+                      (setf new-offset (funcall func (lvar-value offset)
+                                                value))))
           (give-up-ir1-transform "constant is too large for inlining"))
         (splice-fun-args index func 2)
         `(lambda (thing index off1 off2 ,@(when setter-p
                                             '(value)))
-           (,fun-name thing index (,func off2 off1) ,@(when setter-p
-                                                        '(value))))))))
+           (declare (ignore off1 off2))
+           (,fun-name thing index ',new-offset ,@(when setter-p
+                                                   '(value))))))))
 
 #!+(or x86 x86-64)
 (deftransform sb!bignum:%bignum-ref-with-offset
@@ -109,11 +113,12 @@
 ;;; This and the corresponding -SET transform work equally well on non-simple
 ;;; arrays, but after benchmarking (on x86), Nikodemus didn't find any cases
 ;;; where it actually helped with non-simple arrays -- to the contrary, it
-;;; only made for bigger and up 1o 100% slower code.
+;;; only made for bigger and up to 100% slower code.
 (deftransform hairy-data-vector-ref ((array index) (simple-array t) *)
   "avoid runtime dispatch on array element type"
-  (let ((element-ctype (extract-upgraded-element-type array))
-        (declared-element-ctype (extract-declared-element-type array)))
+  (let* ((type (lvar-type array))
+         (element-ctype (array-type-upgraded-element-type type))
+         (declared-element-ctype (array-type-declared-element-type type)))
     (declare (type ctype element-ctype))
     (when (eq *wild-type* element-ctype)
       (give-up-ir1-transform
@@ -200,8 +205,9 @@
                                      (simple-array t t)
                                      *)
   "avoid runtime dispatch on array element type"
-  (let ((element-ctype (extract-upgraded-element-type array))
-        (declared-element-ctype (extract-declared-element-type array)))
+  (let* ((type (lvar-type array))
+         (element-ctype (array-type-upgraded-element-type type))
+         (declared-element-ctype (array-type-declared-element-type type)))
     (declare (type ctype element-ctype))
     (when (eq *wild-type* element-ctype)
       (give-up-ir1-transform
@@ -622,14 +628,13 @@
   ;; This should really be dependent on SB!VM:N-WORD-BITS, but since we
   ;; don't have a true Alpha64 port yet, we'll have to stick to
   ;; SB!VM:N-MACHINE-WORD-BITS for the time being.  --njf, 2004-08-14
-  #!+#.(cl:if (cl:= 32 sb!vm:n-machine-word-bits) '(and) '(or))
-  (progn
-    #!+x86 (def sb!vm::ash-left-smod30 :tagged 30 t)
-    (def sb!vm::ash-left-mod32 :untagged 32 nil))
-  #!+#.(cl:if (cl:= 64 sb!vm:n-machine-word-bits) '(and) '(or))
-  (progn
-    #!+x86-64 (def sb!vm::ash-left-smod61 :tagged 61 t)
-    (def sb!vm::ash-left-mod64 :untagged 64 nil)))
+  #.`(progn
+       #!+(or x86 x86-64)
+       (def sb!vm::ash-left-modfx
+           :tagged ,(- sb!vm:n-word-bits sb!vm:n-fixnum-tag-bits) t)
+       (def ,(intern (format nil "ASH-LEFT-MOD~D" sb!vm:n-machine-word-bits)
+                     "SB!VM")
+           :untagged ,sb!vm:n-machine-word-bits nil)))
 
 ;;;; word-wise logical operations