[Sbcl-commits] CVS: sbcl/src/compiler saptran.lisp,1.8.2.2,1.8.2.3

[Juho S. <js...@us...>]

Update of /cvsroot/sbcl/sbcl/src/compiler
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv6497/src/compiler

Modified Files:
      Tag: x86-64-again-branch
	saptran.lisp 
Log Message:
0.8.15.14.x86-64-again-branch.28:
	Fix a bunch of bugs revealed by (an two month old copy of)
        Paul Dietz's ansi-tests. "60 out of 18248 total tests failed".
        * Remove 32-bit assumptions from bignum -> float coercion.
        * It just wouldn't feel like a x86-64 commit without a sign 
          extension fix. This time to fast constant binops.
        * Rework the bit-twiddling in DEF-SMALL-DATA-VECTOR-FROBS
          to MOV the mask into a temporary register, since it no
          longer fits in an immediate.
        * Fix completely broken accessing of float arrays.
        * Implement accessing complex float arrays.
        * Add missing shift to single-float ABS VOP.
        * Encode float registers properly, so that c-calls with more
          than one float argument work.
        * Add a rex-prefix to the sign-extending moves based on
          dst size instead of src size.
	* Add (%SET-)(SIGNED-)SAP-REF-WORD as suggested by Nathan Froyd.
          Replace at the obvious usages of SAP-REF-32 with this.


Index: saptran.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/saptran.lisp,v
retrieving revision 1.8.2.2
retrieving revision 1.8.2.3
diff -u -d -r1.8.2.2 -r1.8.2.3
--- saptran.lisp	3 Dec 2004 03:17:02 -0000	1.8.2.2
+++ saptran.lisp	5 Dec 2004 04:34:04 -0000	1.8.2.3
@@ -80,6 +80,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))
@@ -104,6 +112,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)
@@ -184,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))