-(macrolet ((def (fun &optional setp)
- `(deftransform ,fun ((sap offset ,@(when setp `(new-value))) * *)
- (extract-fun-args sap 'sap+ 2)
- `(lambda (sap offset1 offset2 ,@',(when setp `(new-value)))
- (,',fun sap (+ offset1 offset2) ,@',(when setp `(new-value)))))))
- (def sap-ref-8)
- (def %set-sap-ref-8 t)
- (def signed-sap-ref-8)
- (def %set-signed-sap-ref-8 t)
- (def sap-ref-16)
- (def %set-sap-ref-16 t)
- (def signed-sap-ref-16)
- (def %set-signed-sap-ref-16 t)
- (def sap-ref-32)
- (def %set-sap-ref-32 t)
- (def signed-sap-ref-32)
- (def %set-signed-sap-ref-32 t)
- (def sap-ref-64)
- (def %set-sap-ref-64 t)
- (def signed-sap-ref-64)
- (def %set-signed-sap-ref-64 t)
- (def sap-ref-sap)
- (def %set-sap-ref-sap t)
- (def sap-ref-single)
- (def %set-sap-ref-single t)
- (def sap-ref-double)
- (def %set-sap-ref-double t)
- ;; The original CMUCL code had #!+(and x86 long-float) for this first one,
- ;; but only #!+long-float for the second. This was redundant, since the
- ;; LONG-FLOAT target feature only exists on X86. So we removed the
- ;; redundancy. --njf 2002-01-08
- #!+long-float (def sap-ref-long)
- #!+long-float (def %set-sap-ref-long t))
+(macrolet ((def (fun element-size &optional setp value-type)
+ (declare (ignorable value-type))
+ `(progn
+ (deftransform ,fun ((sap offset ,@(when setp `(new-value))) * *)
+ (splice-fun-args sap 'sap+ 2)
+ `(lambda (sap offset1 offset2 ,@',(when setp `(new-value)))
+ (,',fun sap (+ offset1 offset2) ,@',(when setp `(new-value)))))
+ ;; Avoid defining WITH-OFFSET transforms for accessors whose
+ ;; sizes are larger than the word size; they'd probably be
+ ;; pointless to optimize anyway and tricky to boot.
+ ,(unless (and (listp value-type)
+ (or (eq (first value-type) 'unsigned-byte)
+ (eq (first value-type) 'signed-byte))
+ (> (second value-type) sb!vm:n-word-bits))
+ #!+x86
+ (let ((with-offset-fun (intern (format nil "~A-WITH-OFFSET" fun))))
+ `(progn
+ ,(cond
+ (setp
+ `(deftransform ,fun ((sap offset new-value)
+ (system-area-pointer fixnum ,value-type) *)
+ `(,',with-offset-fun sap (truly-the fixnum offset) 0 new-value)))
+ (t
+ `(deftransform ,fun ((sap offset) (system-area-pointer fixnum) *)
+ `(,',with-offset-fun sap (truly-the fixnum offset) 0))))
+ (deftransform ,with-offset-fun ((sap offset disp
+ ,@(when setp `(new-value))) * *)
+ (fold-index-addressing ',with-offset-fun
+ ,element-size
+ 0 ; lowtag
+ 0 ; data offset
+ offset disp ,setp))))))))
+ (def sap-ref-8 8)
+ (def %set-sap-ref-8 8 t (unsigned-byte 8))
+ (def signed-sap-ref-8 8)
+ (def %set-signed-sap-ref-8 8 t (signed-byte 8))
+ (def sap-ref-16 16)
+ (def %set-sap-ref-16 16 t (unsigned-byte 16))
+ (def signed-sap-ref-16 16)
+ (def %set-signed-sap-ref-16 16 t (signed-byte 16))
+ (def sap-ref-32 32)
+ (def %set-sap-ref-32 32 t (unsigned-byte 32))
+ (def signed-sap-ref-32 32)
+ (def %set-signed-sap-ref-32 32 t (signed-byte 32))
+ (def sap-ref-64 64)
+ (def %set-sap-ref-64 64 t (unsigned-byte 64))
+ (def signed-sap-ref-64 64)
+ (def %set-signed-sap-ref-64 64 t (signed-byte 64))
+ (def sap-ref-sap sb!vm:n-word-bits)
+ (def %set-sap-ref-sap sb!vm:n-word-bits t system-area-pointer)
+ (def sap-ref-single 32)
+ (def %set-sap-ref-single 32 t single-float)
+ (def sap-ref-double 64)
+ (def %set-sap-ref-double 64 t double-float)
+ #!+long-float (def sap-ref-long 96)
+ #!+long-float (def %set-sap-ref-long 96 t 8))