X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86-64%2Ffloat.lisp;h=f6de9ba5d457f5155bd94c31517d464adfe21c7c;hb=3da8e4ca35e534942f7a5046490d169509170c85;hp=b0dfce008d70f2b3663e2a1d2828f3dbf9d7dc3e;hpb=d42fc83f2dd4d1f191aa164425f33d2d60fc4b36;p=sbcl.git

diff --git a/src/compiler/x86-64/float.lisp b/src/compiler/x86-64/float.lisp
index b0dfce0..f6de9ba 100644
--- a/src/compiler/x86-64/float.lisp
+++ b/src/compiler/x86-64/float.lisp
@@ -16,8 +16,6 @@
 	       :qword :base ,tn
 	       :disp (- (* ,slot n-word-bytes)
 			other-pointer-lowtag))))
-  (defun ea-for-sf-desc (tn)
-    (ea-for-xf-desc tn single-float-value-slot))
   (defun ea-for-df-desc (tn)
     (ea-for-xf-desc tn double-float-value-slot))
   ;; complex floats
@@ -207,13 +205,12 @@
 (define-vop (move-from-single)
   (:args (x :scs (single-reg) :to :save))
   (:results (y :scs (descriptor-reg)))
-  (:node-var node)
   (:note "float to pointer coercion")
-  (:generator 13
-     (with-fixed-allocation (y
-			     single-float-widetag
-			     single-float-size node)
-       (inst movss (ea-for-sf-desc y) x))))
+  (:generator 4
+    (inst movd y x)
+    (inst shl y 32)
+    (inst or y single-float-widetag)))
+
 (define-move-vop move-from-single :move
   (single-reg) (descriptor-reg))
 
@@ -247,11 +244,15 @@
 
 ;;; Move from a descriptor to a float register.
 (define-vop (move-to-single)
-  (:args (x :scs (descriptor-reg)))
+  (:args (x :scs (descriptor-reg) :target tmp))
+  (:temporary (:sc unsigned-reg) tmp)
   (:results (y :scs (single-reg)))
   (:note "pointer to float coercion")
   (:generator 2
-    (inst movss y (ea-for-sf-desc x))))
+    (move tmp x)
+    (inst shr tmp 32)
+    (inst movd y tmp)))
+
 (define-move-vop move-to-single :move (descriptor-reg) (single-reg))
 
 (define-vop (move-to-double)
@@ -430,7 +431,7 @@
 
 (macrolet ((frob (name sc ptype)
 	     `(define-vop (,name float-op)
-		(:args (x :scs (,sc))
+		(:args (x :scs (,sc) :target r)
 		       (y :scs (,sc)))
 		(:results (r :scs (,sc)))
 		(:arg-types ,ptype ,ptype)
@@ -469,6 +470,7 @@
   (frob * mulss */single-float 4 mulsd */double-float 5 t)
   (frob / divss //single-float 12 divsd //double-float 19 nil))
 
+
 
 (macrolet ((frob ((name translate sc type) &body body)
 	     `(define-vop (,name)
@@ -800,9 +802,8 @@
 	 (single-stack
 	  (move bits float))
 	 (descriptor-reg
-	  (loadw
-	   bits float single-float-value-slot
-	   other-pointer-lowtag))))
+	  (move bits float)
+	  (inst shr bits 32))))
       (signed-stack
        (sc-case float
 	 (single-reg
@@ -827,7 +828,7 @@
 	(inst movsd temp float)
 	(move hi-bits temp))
        (double-stack
-	(loadw hi-bits ebp-tn (- (tn-offset float))))
+	(loadw hi-bits ebp-tn (- (1+ (tn-offset float)))))
        (descriptor-reg
 	(loadw hi-bits float double-float-value-slot
 	       other-pointer-lowtag)))
@@ -849,7 +850,7 @@
 	(inst movsd temp float)
 	(move lo-bits temp))
        (double-stack
-	(loadw lo-bits ebp-tn (- (tn-offset float))))
+	(loadw lo-bits ebp-tn (- (1+ (tn-offset float)))))
        (descriptor-reg
 	(loadw lo-bits float double-float-value-slot
 	       other-pointer-lowtag)))