0.8.3.62:

[sbcl.git] / src / compiler / saptran.lisp

diff --git a/src/compiler/saptran.lisp b/src/compiler/saptran.lisp
index 4719183..1d6d4ee 100644 (file)
--- a/src/compiler/saptran.lisp
+++ b/src/compiler/saptran.lisp
@@ -10,9 +10,6 @@
 ;;;; files for more information.
 
 (in-package "SB!C")
-
-(file-comment
-  "$Header$")
 \f
 ;;;; DEFKNOWNs
 
@@ -51,10 +48,11 @@
   (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)
   ())
@@ -77,10 +75,8 @@
   (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)
   ())
@@ -112,34 +108,56 @@
 \f
 ;;;; transforms for converting sap relation operators
 
-(dolist (info '((sap< <) (sap<= <=) (sap= =) (sap>= >=) (sap> >)))
-  (destructuring-bind (sap-fun int-fun) info
-    (deftransform sap-fun ((x y) '* '* :eval-name t)
-      `(,int-fun (sap-int x) (sap-int y)))))
+(macrolet ((def (sap-fun int-fun)
+             `(deftransform ,sap-fun ((x y) * *)
+                `(,',int-fun (sap-int x) (sap-int y)))))
+  (def sap< <)
+  (def sap<= <=)
+  (def sap= =)
+  (def sap>= >=)
+  (def sap> >))
 \f
 ;;;; 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-function-args sap 'sap+ 2)
+        (extract-fun-args sap 'sap+ 2)
         '(lambda (sap offset1 offset2)
            (sap+ sap (+ offset1 offset2))))))
 
-(dolist (fun '(sap-ref-8 %set-sap-ref-8
-              signed-sap-ref-8 %set-signed-sap-ref-8
-              sap-ref-16 %set-sap-ref-16
-              signed-sap-ref-16 %set-signed-sap-ref-16
-              sap-ref-32 %set-sap-ref-32
-              signed-sap-ref-32 %set-signed-sap-ref-32
-              sap-ref-sap %set-sap-ref-sap
-              sap-ref-single %set-sap-ref-single
-              sap-ref-double %set-sap-ref-double
-              #!+(or x86 long-float) sap-ref-long
-              #!+long-float %set-sap-ref-long))
-  (deftransform fun ((sap offset) '* '* :eval-name t)
-    (extract-function-args sap 'sap+ 2)
-    `(lambda (sap offset1 offset2)
-       (,fun sap (+ offset1 offset2)))))
+(macrolet ((def (fun)
+             `(deftransform ,fun ((sap offset) * *)
+                (extract-fun-args sap 'sap+ 2)
+                 `(lambda (sap offset1 offset2)
+                   (,',fun sap (+ offset1 offset2))))))
+  (def sap-ref-8)
+  (def %set-sap-ref-8)
+  (def signed-sap-ref-8)
+  (def %set-signed-sap-ref-8)
+  (def sap-ref-16)
+  (def %set-sap-ref-16)
+  (def signed-sap-ref-16)
+  (def %set-signed-sap-ref-16)
+  (def sap-ref-32)
+  (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)
+  (def %set-sap-ref-single)
+  (def sap-ref-double)
+  (def %set-sap-ref-double)
+  ;; 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))