X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fgeneric%2Fvm-tran.lisp;h=256ead30be28f6d43f185f67c64cfb3039e7f763;hb=74cf7a4d01664fbf72a662ba093ad67ca243b524;hp=1196ba21c037187ad4578747a8ff6cff9fe3e0ad;hpb=e9984509712529c60d1158d44207d6abf11dccce;p=sbcl.git diff --git a/src/compiler/generic/vm-tran.lisp b/src/compiler/generic/vm-tran.lisp index 1196ba2..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,7 +113,7 @@ ;;; 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* ((type (lvar-type array))