X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fsaptran.lisp;h=80b5e581469e229dc22e03e2196b105ad97e0aa2;hb=8e4ec430504f0f563280be26034af590dff50d34;hp=10a08c58217803886122e54d89df444ba6fe431a;hpb=06b4f7dc62e1ce045ff7409686f27534ecb13ada;p=sbcl.git diff --git a/src/compiler/saptran.lisp b/src/compiler/saptran.lisp index 10a08c5..80b5e58 100644 --- a/src/compiler/saptran.lisp +++ b/src/compiler/saptran.lisp @@ -14,9 +14,13 @@ ;;;; 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) @@ -27,13 +31,18 @@ `(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>) @@ -80,6 +89,7 @@ (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) @@ -108,7 +118,7 @@ '(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))) * *) @@ -136,34 +146,36 @@ (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) @@ -176,3 +188,48 @@ %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)) + +;;; 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)