X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcompiler%2Fsaptran.lisp;h=f709ceabb939765169e5ff9c69c32dd7d09bdeb8;hb=78fa16bf55be44cc16845be84d98023e83fb14bc;hp=4270fed71ececd847c4c0c8a1a82d58cf0177b15;hpb=0c7ffa8fb85a94482814835c9f28abfd0400ab99;p=sbcl.git

diff --git a/src/compiler/saptran.lisp b/src/compiler/saptran.lisp
index 4270fed..f709cea 100644
--- a/src/compiler/saptran.lisp
+++ b/src/compiler/saptran.lisp
@@ -13,8 +13,29 @@
 
 ;;;; DEFKNOWNs
 
-(defknown foreign-symbol-address (simple-string) system-area-pointer
-  (movable flushable))
+#!+linkage-table
+(deftransform foreign-symbol-address-as-integer ((symbol &optional datap)
+						 (simple-string boolean))
+  (if (and (constant-lvar-p symbol) (constant-lvar-p datap))
+      `(sap-int (foreign-symbol-address symbol datap))
+      (give-up-ir1-transform)))
+
+(deftransform foreign-symbol-address ((symbol &optional datap)
+				      (simple-string &optional boolean))
+    #!-linkage-table
+    (if (null datap)
+	(give-up-ir1-transform)
+	`(foreign-symbol-address 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-address ,name) ; VOP
+	      `(foreign-symbol-dataref-address ,name))) ; VOP
+	(give-up-ir1-transform)))
 
 (defknown (sap< sap<= sap= sap>= sap>)
 	  (system-area-pointer system-area-pointer) boolean
@@ -22,12 +43,14 @@
 
 (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)
@@ -48,14 +71,23 @@
   (unsigned-byte 32)
   ())
 
-#!+alpha
+;; FIXME These are supported natively on alpha and using deftransforms
+;; in compiler/x86/sap.lisp, which in OAO$n$ style need copying to
+;; other 32 bit systems
 (defknown sap-ref-64 (system-area-pointer fixnum) (unsigned-byte 64)
   (flushable))
-#!+alpha
 (defknown %set-sap-ref-64 (system-area-pointer fixnum (unsigned-byte 64))
   (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))
@@ -74,14 +106,20 @@
   (signed-byte 32)
   ())
 
-#!+alpha
 (defknown signed-sap-ref-64 (system-area-pointer fixnum) (signed-byte 64)
   (flushable))
-#!+alpha
 (defknown %set-signed-sap-ref-64 (system-area-pointer fixnum (signed-byte 64))
   (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)
@@ -121,8 +159,8 @@
 ;;;; transforms for optimizing SAP+
 
 (deftransform sap+ ((sap offset))
-  (cond ((and (constant-continuation-p offset)
-	      (eql (continuation-value offset) 0))
+  (cond ((and (constant-lvar-p offset)
+	      (eql (lvar-value offset) 0))
 	 'sap)
 	(t
 	 (extract-fun-args sap 'sap+ 2)
@@ -146,6 +184,10 @@
   (def %set-sap-ref-32)
   (def signed-sap-ref-32)
   (def %set-signed-sap-ref-32)
+  (def sap-ref-64)
+  (def %set-sap-ref-64)
+  (def signed-sap-ref-64)
+  (def %set-signed-sap-ref-64)
   (def sap-ref-sap)
   (def %set-sap-ref-sap)
   (def sap-ref-single)
@@ -158,3 +200,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))