X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fsaptran.lisp;h=80b5e581469e229dc22e03e2196b105ad97e0aa2;hb=b2ed34b667665e52609cf431c00179b136be450d;hp=066572ea3ff1678e0fd8e56a16d55f2b065d1b8f;hpb=7d10bcf57926aa6709eeb2e09ca447af9e96f141;p=sbcl.git

diff --git a/src/compiler/saptran.lisp b/src/compiler/saptran.lisp
index 066572e..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)
@@ -109,7 +119,7 @@
             (sap+ sap (+ offset1 offset2))))))
 
 (macrolet ((def (fun &optional setp value-type)
-             (declare (ignorable value-type) (ignore element-size))
+             (declare (ignorable value-type))
              `(progn
                 (deftransform ,fun ((sap offset ,@(when setp `(new-value))) * *)
                   (splice-fun-args sap 'sap+ 2)
@@ -158,6 +168,8 @@
   (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)
@@ -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)