Steel Bank Common Lisp

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

Modified Files:
      Tag: x86-64-again-branch
	backend-parms.lisp float.lisp insts.lisp type-vops.lisp 
Log Message:
0.8.15.14.x86-64-again-branch.15:
	* Use SB!VM::N-MACHINE-WORD-BITS instead of N-WORD-BITS in sb-posix
          to avoid breaking Alpha.
        * Fix double-float dumping in genesis with 64-bit words. 
          Add some OAOOM.
        * Set +BACKEND-FASL-FILE-IMPLEMENTATION+ to x86-64.
        * Oops. Double-float-low-bits is unsigned, not signed. Remove
          sign-extension.
        * Fix instruction argument order in float conversion vops.
        * Force a rex-prefix on some SSE2 instructions to always enable
          64-bitness.
        * Fix off-by one in unsigned-byte-32 type check vops.


Index: backend-parms.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86-64/backend-parms.lisp,v
retrieving revision 1.1
retrieving revision 1.1.8.1
diff -u -d -r1.1 -r1.1.8.1
--- backend-parms.lisp	26 Jun 2004 17:48:22 -0000	1.1
+++ backend-parms.lisp	29 Nov 2004 21:04:29 -0000	1.1.8.1
@@ -17,7 +17,7 @@
 
 ;;;; compiler constants
 
-(def!constant +backend-fasl-file-implementation+ :x86)
+(def!constant +backend-fasl-file-implementation+ :x86-64)
 
 (setf *backend-register-save-penalty* 3)
 

Index: float.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86-64/float.lisp,v
retrieving revision 1.2.8.8
retrieving revision 1.2.8.9
diff -u -d -r1.2.8.8 -r1.2.8.9
--- float.lisp	28 Nov 2004 02:26:28 -0000	1.2.8.8
+++ float.lisp	29 Nov 2004 21:04:31 -0000	1.2.8.9
@@ -630,7 +630,7 @@
 		(:vop-var vop)
 		(:save-p :compute-only)
 		(:generator 6
-		  (inst ,inst x y)))))
+		  (inst ,inst y x)))))
   (frob %single-float/unsigned %single-float cvtsi2ss single-reg single-float)
   (frob %double-float/unsigned %double-float cvtsi2sd double-reg double-float))
 
@@ -647,7 +647,7 @@
 	       (:save-p :compute-only)
 	       (:generator 2
 		(note-this-location vop :internal-error)
-		(inst ,inst x y)))))
+		(inst ,inst y x)))))
   (frob %single-float/double-float %single-float cvtsd2ss double-reg
 	double-float single-reg single-float)
 
@@ -843,7 +843,7 @@
 	(loadw lo-bits float double-float-value-slot
 	       other-pointer-lowtag)))
      (inst shl lo-bits 32)
-     (inst sar lo-bits 32)))
+     (inst shr lo-bits 32)))
 
 
 ;;;; float mode hackery

Index: insts.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86-64/insts.lisp,v
retrieving revision 1.1.8.9
retrieving revision 1.1.8.10
diff -u -d -r1.1.8.9 -r1.1.8.10
--- insts.lisp	28 Nov 2004 02:26:29 -0000	1.1.8.9
+++ insts.lisp	29 Nov 2004 21:04:32 -0000	1.1.8.10
@@ -908,9 +908,11 @@
 		(not (zerop (logior rex-w rex-r rex-x rex-b))))
 	(emit-rex-byte segment #b0100 rex-w rex-r rex-x rex-b)))))
 
-(defun maybe-emit-rex-for-ea (segment ea reg)
+(defun maybe-emit-rex-for-ea (segment ea reg &key operand-size)
   (let ((ea-p (ea-p ea)))		;emit-ea can also be called with a tn
-    (maybe-emit-rex-prefix segment (operand-size ea) reg 
+    (maybe-emit-rex-prefix segment
+			   (or operand-size (operand-size ea))
+			   reg
 			   (and ea-p (ea-index ea))
 			   (cond (ea-p (ea-base ea))
 				 ((and (tn-p ea)
@@ -2973,7 +2975,7 @@
 ;  (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong
   (:emitter
    (emit-byte segment #xf2)
-   (maybe-emit-rex-for-ea segment src dst)
+   (maybe-emit-rex-for-ea segment src dst :operand-size :qword)
    (emit-byte segment #x0f)
    (emit-byte segment #x2d)
    (emit-ea segment src (reg-tn-encoding dst))))
@@ -2991,7 +2993,7 @@
 ;  (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong
   (:emitter
    (emit-byte segment #xf3)
-   (maybe-emit-rex-for-ea segment src dst)
+   (maybe-emit-rex-for-ea segment src dst :operand-size :qword)
    (emit-byte segment #x0f)
    (emit-byte segment #x2d)
    (emit-ea segment src (reg-tn-encoding dst))))
@@ -3046,7 +3048,7 @@
 ;  (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong
   (:emitter
    (emit-byte segment #xf2)
-   (maybe-emit-rex-for-ea segment src dst)
+   (maybe-emit-rex-for-ea segment src dst :operand-size :qword)
    (emit-byte segment #x0f)
    (emit-byte segment #x2c)
    (emit-ea segment src (reg-tn-encoding dst))))
@@ -3055,7 +3057,7 @@
 ;  (:printer reg-reg/mem ((op #x10) (width 1))) ;wrong
   (:emitter
    (emit-byte segment #xf3)
-   (maybe-emit-rex-for-ea segment src dst)
+   (maybe-emit-rex-for-ea segment src dst :operand-size :qword)
    (emit-byte segment #x0f)
    (emit-byte segment #x2c)
    (emit-ea segment src (reg-tn-encoding dst))))

Index: type-vops.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86-64/type-vops.lisp,v
retrieving revision 1.1.8.5
retrieving revision 1.1.8.6
diff -u -d -r1.1.8.5 -r1.1.8.6
--- type-vops.lisp	24 Nov 2004 20:02:00 -0000	1.1.8.5
+++ type-vops.lisp	29 Nov 2004 21:04:34 -0000	1.1.8.6
@@ -212,7 +212,7 @@
     (move rax-tn value)
     (inst test rax-tn 7)
     (inst jmp :ne (if not-p target not-target))
-    (inst sar rax-tn (+ 32 3 -1))
+    (inst shr rax-tn (+ 32 sb!vm::n-fixnum-tag-bits))
     (inst jmp (if not-p :nz :z) target)
     NOT-TARGET))
 
@@ -223,7 +223,7 @@
       (move rax-tn value)
       (inst test rax-tn 7)
       (inst jmp :ne nope)
-      (inst sar rax-tn (+ 32 3 -1))
+      (inst shr rax-tn (+ 32 sb!vm::n-fixnum-tag-bits))
       (inst jmp :nz nope)
       (move result value))))