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
;;; 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
(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
;; 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)))
\f
;;;; word-wise logical operations