X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fsaptran.lisp;h=cf84c28133cfe4c9f56ddcbd28b589ef28133aef;hb=6c741e202637adec3fc830f0454cddd9438392b1;hp=1d6d4ee37f761029c4f6c520332b1e1f3661151f;hpb=57e21c4b62e8c1a1ee7ef59ed2abb0c864fb06bc;p=sbcl.git

diff --git a/src/compiler/saptran.lisp b/src/compiler/saptran.lisp
index 1d6d4ee..cf84c28 100644
--- a/src/compiler/saptran.lisp
+++ b/src/compiler/saptran.lisp
@@ -13,21 +13,43 @@
 
 ;;;; DEFKNOWNs
 
-(defknown foreign-symbol-address (simple-string) system-area-pointer
-  (movable flushable))
+#!+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))
+      (give-up-ir1-transform)))
+
+(deftransform foreign-symbol-sap ((symbol &optional datap)
+                                      (simple-string &optional boolean))
+    #!-linkage-table
+    (if (null datap)
+        (give-up-ir1-transform)
+        `(foreign-symbol-sap symbol))
+    #!+linkage-table
+    (if (and (constant-lvar-p symbol) (constant-lvar-p datap))
+        (let ((name (lvar-value symbol))
+              (datap (lvar-value datap)))
+          (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
+        (give-up-ir1-transform)))
 
 (defknown (sap< sap<= sap= sap>= sap>)
-	  (system-area-pointer system-area-pointer) boolean
+          (system-area-pointer system-area-pointer) boolean
   (movable flushable))
 
 (defknown sap+ (system-area-pointer integer) system-area-pointer
   (movable flushable))
-(defknown sap- (system-area-pointer system-area-pointer) (signed-byte 32)
+(defknown sap- (system-area-pointer system-area-pointer)
+               (signed-byte #.sb!vm::n-word-bits)
   (movable flushable))
 
-(defknown sap-int (system-area-pointer) (unsigned-byte #!-alpha 32 #!+alpha 64)
+(defknown sap-int (system-area-pointer)
+  (unsigned-byte #.sb!vm::n-machine-word-bits)
   (movable flushable))
-(defknown int-sap ((unsigned-byte #!-alpha 32 #!+alpha 64))
+(defknown int-sap ((unsigned-byte #.sb!vm::n-machine-word-bits))
   system-area-pointer (movable))
 
 (defknown sap-ref-8 (system-area-pointer fixnum) (unsigned-byte 8)
@@ -57,6 +79,14 @@
   (unsigned-byte 64)
   ())
 
+(defknown sap-ref-word (system-area-pointer fixnum)
+  (unsigned-byte #.sb!vm::n-machine-word-bits)
+  (flushable))
+(defknown %set-sap-ref-word
+    (system-area-pointer fixnum (unsigned-byte #.sb!vm::n-machine-word-bits))
+  (unsigned-byte #.sb!vm::n-machine-word-bits)
+  ())
+
 (defknown signed-sap-ref-8 (system-area-pointer fixnum) (signed-byte 8)
   (flushable))
 (defknown %set-signed-sap-ref-8 (system-area-pointer fixnum (signed-byte 8))
@@ -81,6 +111,14 @@
   (signed-byte 64)
   ())
 
+(defknown signed-sap-ref-word (system-area-pointer fixnum)
+  (signed-byte #.sb!vm::n-machine-word-bits)
+  (flushable))
+(defknown %set-signed-sap-ref-word
+    (system-area-pointer fixnum (signed-byte #.sb!vm::n-machine-word-bits))
+  (signed-byte #.sb!vm::n-machine-word-bits)
+  ())
+
 (defknown sap-ref-sap (system-area-pointer fixnum) system-area-pointer
   (flushable))
 (defknown %set-sap-ref-sap (system-area-pointer fixnum system-area-pointer)
@@ -96,14 +134,14 @@
   (flushable))
 
 (defknown %set-sap-ref-single
-	  (system-area-pointer fixnum single-float) single-float
+          (system-area-pointer fixnum single-float) single-float
   ())
 (defknown %set-sap-ref-double
-	  (system-area-pointer fixnum double-float) double-float
+          (system-area-pointer fixnum double-float) double-float
   ())
 #!+long-float
 (defknown %set-sap-ref-long
-	  (system-area-pointer fixnum long-float) long-float
+          (system-area-pointer fixnum long-float) long-float
   ())
 
 ;;;; transforms for converting sap relation operators
@@ -121,12 +159,12 @@
 
 (deftransform sap+ ((sap offset))
   (cond ((and (constant-lvar-p offset)
-	      (eql (lvar-value offset) 0))
-	 'sap)
-	(t
-	 (extract-fun-args sap 'sap+ 2)
-	 '(lambda (sap offset1 offset2)
-	    (sap+ sap (+ offset1 offset2))))))
+              (eql (lvar-value offset) 0))
+         'sap)
+        (t
+         (extract-fun-args sap 'sap+ 2)
+         '(lambda (sap offset1 offset2)
+            (sap+ sap (+ offset1 offset2))))))
 
 (macrolet ((def (fun)
              `(deftransform ,fun ((sap offset) * *)
@@ -161,3 +199,15 @@
   ;; redundancy.  --njf 2002-01-08
   #!+long-float (def sap-ref-long)
   #!+long-float (def %set-sap-ref-long))
+
+(macrolet ((def (fun args 32-bit 64-bit)
+               `(deftransform ,fun (,args)
+                  (ecase sb!vm::n-word-bits
+                    (32 '(,32-bit ,@args))
+                    (64 '(,64-bit ,@args))))))
+  (def sap-ref-word (sap offset) sap-ref-32 sap-ref-64)
+  (def signed-sap-ref-word (sap offset) signed-sap-ref-32 signed-sap-ref-64)
+  (def %set-sap-ref-word (sap offset value)
+    %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))