X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcompiler%2Fsaptran.lisp;h=9f2c643bc55be1eab1312234e7cc10697dab3131;hb=bd455348d39bee562296741689882dcb97c46ba3;hp=178e61e5d550d11bfece0226f33bff4c6bd30bd8;hpb=dc33d6a6b84f8338e603759cec8e25da29055d50;p=sbcl.git

diff --git a/src/compiler/saptran.lisp b/src/compiler/saptran.lisp
index 178e61e..9f2c643 100644
--- a/src/compiler/saptran.lisp
+++ b/src/compiler/saptran.lisp
@@ -20,29 +20,29 @@
       (give-up-ir1-transform)))
 
 (deftransform foreign-symbol-sap ((symbol &optional datap)
-				      (simple-string &optional boolean))
+                                      (simple-string &optional boolean))
     #!-linkage-table
     (if (null datap)
-	(give-up-ir1-transform)
-	`(foreign-symbol-sap symbol))
+        (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
+        (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)))
+                  (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) 
+(defknown sap- (system-area-pointer system-area-pointer)
                (signed-byte #.sb!vm::n-word-bits)
   (movable flushable))
 
@@ -134,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
@@ -159,52 +159,52 @@
 
 (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))))))
-
-(macrolet ((def (fun)
-             `(deftransform ,fun ((sap offset) * *)
+              (eql (lvar-value offset) 0))
+         'sap)
+        (t
+         (extract-fun-args sap 'sap+ 2)
+         '(lambda (sap offset1 offset2)
+            (sap+ sap (+ offset1 offset2))))))
+
+(macrolet ((def (fun &optional setp)
+             `(deftransform ,fun ((sap offset ,@(when setp `(new-value))) * *)
                 (extract-fun-args sap 'sap+ 2)
-                 `(lambda (sap offset1 offset2)
-                   (,',fun sap (+ offset1 offset2))))))
+                 `(lambda (sap offset1 offset2 ,@',(when setp `(new-value)))
+                   (,',fun sap (+ offset1 offset2) ,@',(when setp `(new-value)))))))
   (def sap-ref-8)
-  (def %set-sap-ref-8)
+  (def %set-sap-ref-8 t)
   (def signed-sap-ref-8)
-  (def %set-signed-sap-ref-8)
+  (def %set-signed-sap-ref-8 t)
   (def sap-ref-16)
-  (def %set-sap-ref-16)
+  (def %set-sap-ref-16 t)
   (def signed-sap-ref-16)
-  (def %set-signed-sap-ref-16)
+  (def %set-signed-sap-ref-16 t)
   (def sap-ref-32)
-  (def %set-sap-ref-32)
+  (def %set-sap-ref-32 t)
   (def signed-sap-ref-32)
-  (def %set-signed-sap-ref-32)
+  (def %set-signed-sap-ref-32 t)
   (def sap-ref-64)
-  (def %set-sap-ref-64)
+  (def %set-sap-ref-64 t)
   (def signed-sap-ref-64)
-  (def %set-signed-sap-ref-64)
+  (def %set-signed-sap-ref-64 t)
   (def sap-ref-sap)
-  (def %set-sap-ref-sap)
+  (def %set-sap-ref-sap t)
   (def sap-ref-single)
-  (def %set-sap-ref-single)
+  (def %set-sap-ref-single t)
   (def sap-ref-double)
-  (def %set-sap-ref-double)
+  (def %set-sap-ref-double t)
   ;; The original CMUCL code had #!+(and x86 long-float) for this first one,
   ;; but only #!+long-float for the second.  This was redundant, since the
   ;; LONG-FLOAT target feature only exists on X86.  So we removed the
   ;; redundancy.  --njf 2002-01-08
   #!+long-float (def sap-ref-long)
-  #!+long-float (def %set-sap-ref-long))
+  #!+long-float (def %set-sap-ref-long t))
 
 (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))))))
+               `(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)