CMUCL commit: amd64-dd-branch src/compiler/amd64 (float.lisp)

[Raymond Toy]

    Date: Tuesday, November 3, 2009 @ 22:47:28
  Author: rtoy
    Path: /project/cmucl/cvsroot/src/compiler/amd64
     Tag: amd64-dd-branch

Modified: float.lisp

New make-double-float vop.  Be more careful with the big fixnums that
we now have, and store the result in the right place on the stack.


------------+
 float.lisp |   30 +++++++++++++++++++++++++++++-
 1 file changed, 29 insertions(+), 1 deletion(-)


Index: src/compiler/amd64/float.lisp
diff -u src/compiler/amd64/float.lisp:1.2.36.2 src/compiler/amd64/float.lisp:1.2.36.3
--- src/compiler/amd64/float.lisp:1.2.36.2	Tue Nov  3 15:07:54 2009
+++ src/compiler/amd64/float.lisp	Tue Nov  3 22:47:28 2009
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group at cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /project/cmucl/cvsroot/src/compiler/amd64/float.lisp,v 1.2.36.2 2009-11-03 20:07:54 rtoy Exp $")
+  "$Header: /project/cmucl/cvsroot/src/compiler/amd64/float.lisp,v 1.2.36.3 2009-11-04 03:47:28 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -2179,6 +2179,7 @@
 	   (with-empty-tn at fp-top(res)
 	      (inst fld bits))))))))
 
+#+nil
 (define-vop (make-double-float)
   (:args (hi-bits :scs (signed-reg))
 	 (lo-bits :scs (unsigned-reg)))
@@ -2197,6 +2198,33 @@
 	(inst fldd (make-ea :qword :base rbp-tn
 			    :disp (- (* (1+ offset) word-bytes))))))))
 
+(define-vop (make-double-float)
+  (:args (hi-bits :scs (signed-reg))
+	 (lo-bits :scs (unsigned-reg)))
+  (:results (res :scs (double-reg)))
+  (:temporary (:sc double-stack) temp)
+  (:temporary (:sc signed-reg) lo-temp)
+  (:temporary (:sc signed-reg) bits)
+  (:arg-types signed-num unsigned-num)
+  (:result-types double-float)
+  (:translate make-double-float)
+  (:policy :fast-safe)
+  (:vop-var vop)
+  (:generator 2
+    ;; Combine the high and low words into one big word, save to stack
+    ;; and load it back as a double-float.
+    (inst mov lo-temp lo-bits)
+    (inst shl lo-temp 32)
+    (inst shr lo-temp 32)
+    (inst mov bits hi-bits)
+    (inst shl bits 32)
+    (inst or bits lo-temp)
+    (let ((offset (+ 2 (tn-offset temp))))
+      (storew bits rbp-tn (- offset))
+      (with-empty-tn at fp-top(res)
+	(inst fldd (make-ea :qword :base rbp-tn
+			    :disp (- (* offset word-bytes))))))))
+
 #+long-float
 (define-vop (make-long-float)
   (:args (exp-bits :scs (signed-reg))