+;;; We don't want to clutter the bignum code.
+#!+(or x86 x86-64)
+(define-source-transform sb!bignum:%bignum-ref (bignum index)
+ ;; KLUDGE: We use TRULY-THE here because even though the bignum code
+ ;; is (currently) compiled with (SAFETY 0), the compiler insists on
+ ;; inserting CAST nodes to ensure that INDEX is of the correct type.
+ ;; These CAST nodes do not generate any type checks, but they do
+ ;; interfere with the operation of FOLD-INDEX-ADDRESSING, below.
+ ;; This scenario is a problem for the more user-visible case of
+ ;; folding as well. --njf, 2006-12-01
+ `(sb!bignum:%bignum-ref-with-offset ,bignum
+ (truly-the bignum-index ,index) 0))
+
+#!+(or x86 x86-64)
+(defun fold-index-addressing (fun-name element-size lowtag data-offset
+ 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)
+ (give-up-ir1-transform))
+ (let ((value (lvar-value constant)))
+ (unless (and (integerp value)
+ (sb!vm::foldable-constant-offset-p
+ element-size lowtag data-offset
+ (funcall func value (lvar-value offset))))
+ (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))))))))
+
+#!+(or x86 x86-64)
+(deftransform sb!bignum:%bignum-ref-with-offset
+ ((bignum index offset) * * :node node)
+ (fold-index-addressing 'sb!bignum:%bignum-ref-with-offset
+ sb!vm:n-word-bits sb!vm:other-pointer-lowtag
+ sb!vm:bignum-digits-offset
+ index offset))
+
+#!+x86
+(progn
+(define-source-transform sb!kernel:%vector-raw-bits (thing index)
+ `(sb!kernel:%raw-bits-with-offset ,thing ,index 2))
+
+(define-source-transform sb!kernel:%raw-bits (thing index)
+ `(sb!kernel:%raw-bits-with-offset ,thing ,index 0))
+
+(define-source-transform sb!kernel:%set-vector-raw-bits (thing index value)
+ `(sb!kernel:%set-raw-bits-with-offset ,thing ,index 2 ,value))
+
+(define-source-transform sb!kernel:%set-raw-bits (thing index value)
+ `(sb!kernel:%set-raw-bits-with-offset ,thing ,index 0 ,value))
+
+(deftransform sb!kernel:%raw-bits-with-offset ((thing index offset) * * :node node)
+ (fold-index-addressing 'sb!kernel:%raw-bits-with-offset
+ sb!vm:n-word-bits sb!vm:other-pointer-lowtag
+ 0 index offset))
+
+(deftransform sb!kernel:%set-raw-bits-with-offset ((thing index offset value) * *)
+ (fold-index-addressing 'sb!kernel:%set-raw-bits-with-offset
+ sb!vm:n-word-bits sb!vm:other-pointer-lowtag
+ 0 index offset t))
+) ; PROGN
+