;;;; DEFKNOWNs
#!+linkage-table
-(deftransform foreign-symbol-address ((symbol &optional datap) (simple-string boolean))
- (if (and (constant-lvar-p symbol) (constant-lvar-p datap))
- `(sap-int (foreign-symbol-sap symbol datap))
+(deftransform foreign-symbol-address ((symbol &optional datap) (simple-string boolean)
+ * :important t :policy :fast-safe)
+ (if (and (constant-lvar-p symbol)
+ (constant-lvar-p datap)
+ #!+sb-dynamic-core (not (lvar-value datap)))
+ `(values (sap-int (foreign-symbol-sap symbol datap))
+ (or #!+sb-dynamic-core t))
(give-up-ir1-transform)))
(deftransform foreign-symbol-sap ((symbol &optional datap)
`(foreign-symbol-sap symbol))
#!+linkage-table
(if (and (constant-lvar-p symbol) (constant-lvar-p datap))
- (let ((name (lvar-value symbol))
+ (let (#!-sb-dynamic-core (name (lvar-value symbol))
(datap (lvar-value datap)))
+ #!-sb-dynamic-core
(if (or #+sb-xc-host t ; only static symbols on host
(not datap)
(find-foreign-symbol-in-table name *static-foreign-symbols*))
`(foreign-symbol-sap ,name) ; VOP
- `(foreign-symbol-dataref-sap ,name))) ; VOP
+ `(foreign-symbol-dataref-sap ,name)) ; VOP
+ #!+sb-dynamic-core
+ (if datap
+ `(foreign-symbol-dataref-sap symbol)
+ `(foreign-symbol-sap symbol)))
(give-up-ir1-transform)))
(defknown (sap< sap<= sap= sap>= sap>)
(defknown sap-int (system-area-pointer)
(unsigned-byte #.sb!vm::n-machine-word-bits)
- (movable flushable))
+ (movable flushable foldable))
(defknown int-sap ((unsigned-byte #.sb!vm::n-machine-word-bits))
system-area-pointer (movable))
(defsapref signed-sap-ref-64 (signed-byte 64))
(defsapref signed-sap-ref-word (signed-byte #.sb!vm:n-word-bits))
(defsapref sap-ref-sap system-area-pointer)
+ (defsapref sap-ref-lispobj t)
(defsapref sap-ref-single single-float)
(defsapref sap-ref-double double-float)
(defsapref sap-ref-long long-float)
'(lambda (sap offset1 offset2)
(sap+ sap (+ offset1 offset2))))))
-(macrolet ((def (fun element-size &optional setp value-type)
+(macrolet ((def (fun &optional setp value-type)
(declare (ignorable value-type))
`(progn
(deftransform ,fun ((sap offset ,@(when setp `(new-value))) * *)
(deftransform ,with-offset-fun ((sap offset disp
,@(when setp `(new-value))) * *)
(fold-index-addressing ',with-offset-fun
- ,element-size
+ 8 ; all sap-offsets are in bytes
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))
+ (def sap-ref-8)
+ (def %set-sap-ref-8 t (unsigned-byte 8))
+ (def signed-sap-ref-8)
+ (def %set-signed-sap-ref-8 t (signed-byte 8))
+ (def sap-ref-16)
+ (def %set-sap-ref-16 t (unsigned-byte 16))
+ (def signed-sap-ref-16)
+ (def %set-signed-sap-ref-16 t (signed-byte 16))
+ (def sap-ref-32)
+ (def %set-sap-ref-32 t (unsigned-byte 32))
+ (def signed-sap-ref-32)
+ (def %set-signed-sap-ref-32 t (signed-byte 32))
+ (def sap-ref-64)
+ (def %set-sap-ref-64 t (unsigned-byte 64))
+ (def signed-sap-ref-64)
+ (def %set-signed-sap-ref-64 t (signed-byte 64))
+ (def sap-ref-sap)
+ (def %set-sap-ref-sap t system-area-pointer)
+ (def sap-ref-lispobj)
+ (def %set-sap-ref-lispobj t t)
+ (def sap-ref-single)
+ (def %set-sap-ref-single t single-float)
+ (def sap-ref-double)
+ (def %set-sap-ref-double t double-float)
+ #!+long-float (def sap-ref-long)
+ #!+long-float (def %set-sap-ref-long t long-float))
(macrolet ((def (fun args 32-bit 64-bit)
`(deftransform ,fun (,args)
%set-sap-ref-32 %set-sap-ref-64)
(def %set-signed-sap-ref-word (sap offset value)
%set-signed-sap-ref-32 %set-signed-sap-ref-64))
+\f
+;;; Transforms for 64-bit SAP accessors on 32-bit platforms.
+
+#!+#.(cl:if (cl:= 32 sb!vm:n-machine-word-bits) '(and) '(or))
+(progn
+#!+#.(cl:if (cl:eq :little-endian sb!c:*backend-byte-order*) '(and) '(or))
+(progn
+ (deftransform sap-ref-64 ((sap offset) (* *))
+ '(logior (sap-ref-32 sap offset)
+ (ash (sap-ref-32 sap (+ offset 4)) 32)))
+
+ (deftransform signed-sap-ref-64 ((sap offset) (* *))
+ '(logior (sap-ref-32 sap offset)
+ (ash (signed-sap-ref-32 sap (+ offset 4)) 32)))
+
+ (deftransform %set-sap-ref-64 ((sap offset value) (* * *))
+ '(progn
+ (%set-sap-ref-32 sap offset (logand value #xffffffff))
+ (%set-sap-ref-32 sap (+ offset 4) (ash value -32))))
+
+ (deftransform %set-signed-sap-ref-64 ((sap offset value) (* * *))
+ '(progn
+ (%set-sap-ref-32 sap offset (logand value #xffffffff))
+ (%set-signed-sap-ref-32 sap (+ offset 4) (ash value -32)))))
+
+#!+#.(cl:if (cl:eq :big-endian sb!c:*backend-byte-order*) '(and) '(or))
+(progn
+ (deftransform sap-ref-64 ((sap offset) (* *))
+ '(logior (ash (sap-ref-32 sap offset) 32)
+ (sap-ref-32 sap (+ offset 4))))
+
+ (deftransform signed-sap-ref-64 ((sap offset) (* *))
+ '(logior (ash (signed-sap-ref-32 sap offset) 32)
+ (sap-ref-32 sap (+ 4 offset))))
+
+ (deftransform %set-sap-ref-64 ((sap offset value) (* * *))
+ '(progn
+ (%set-sap-ref-32 sap offset (ash value -32))
+ (%set-sap-ref-32 sap (+ offset 4) (logand value #xffffffff))))
+
+ (deftransform %set-signed-sap-ref-64 ((sap offset value) (* * *))
+ '(progn
+ (%set-signed-sap-ref-32 sap offset (ash value -32))
+ (%set-sap-ref-32 sap (+ 4 offset) (logand value #xffffffff)))))
+) ; (= 32 SB!VM:N-MACHINE-WORD-BITS)
projects / sbcl.git / blobdiff