From 560a3e9621c3aae1a306367be4b3a77b4b7844dc Mon Sep 17 00:00:00 2001
From: rtoy <rtoy>
Date: Sun, 19 Jun 2005 02:48:08 +0000
Subject: [PATCH] Add a new VOP for DOUBLE-FLOAT-BITS, like on sparc.  A
 micro-optimization.

---
 code/kernel.lisp         |  6 +++---
 compiler/float-tran.lisp |  4 ++--
 compiler/ppc/float.lisp  | 33 ++++++++++++++++++++++++++++++++-
 3 files changed, 37 insertions(+), 6 deletions(-)

diff --git a/code/kernel.lisp b/code/kernel.lisp
index 7d46004bc..ad4e52eb2 100644
--- a/code/kernel.lisp
+++ b/code/kernel.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/kernel.lisp,v 1.14 2003/07/15 13:46:58 emarsden Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/kernel.lisp,v 1.15 2005/06/19 02:48:08 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -153,10 +153,10 @@
 #+long-float
 (defun long-float-low-bits (x) (long-float-low-bits x))
 
-#+sparc
+#+(or sparc ppc)
 (defun double-float-bits (x) (double-float-bits x))
 
-#-sparc
+#-(or sparc ppc)
 (defun double-float-bits (x)
   (values (double-float-high-bits x) (double-float-low-bits x)))
 
diff --git a/compiler/float-tran.lisp b/compiler/float-tran.lisp
index 7d2d1ef2a..87e4c50a3 100644
--- a/compiler/float-tran.lisp
+++ b/compiler/float-tran.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/float-tran.lisp,v 1.102 2005/04/29 13:35:46 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/float-tran.lisp,v 1.103 2005/06/19 02:48:08 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -221,7 +221,7 @@
 (defknown double-float-low-bits (double-float) (unsigned-byte 32)
   (movable foldable flushable))
 
-#+sparc
+#+(or sparc ppc)
 (defknown double-float-bits (double-float)
   (values (signed-byte 32) (unsigned-byte 32))
   (movable foldable flushable))
diff --git a/compiler/ppc/float.lisp b/compiler/ppc/float.lisp
index 9436f3d03..b4be76979 100644
--- a/compiler/ppc/float.lisp
+++ b/compiler/ppc/float.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/float.lisp,v 1.3 2004/07/25 18:15:52 pmai Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/float.lisp,v 1.4 2005/06/19 02:48:08 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -671,6 +671,37 @@
        (loadw lo-bits float (1+ vm:double-float-value-slot)
 	      vm:other-pointer-type)))))
 
+(define-vop (double-float-bits)
+  (:args (float :scs (double-reg descriptor-reg)
+		:load-if (not (sc-is float double-stack))))
+  (:results (hi-bits :scs (signed-reg))
+	    (lo-bits :scs (unsigned-reg)))
+  (:temporary (:scs (double-stack)) stack-temp)
+  (:arg-types double-float)
+  (:result-types signed-num unsigned-num)
+  (:translate kernel::double-float-bits)
+  (:policy :fast-safe)
+  (:vop-var vop)
+  (:generator 5
+    (sc-case float
+      (double-reg
+       (inst stfd float (current-nfp-tn vop)
+	     (* (tn-offset stack-temp) vm:word-bytes))
+       (inst lwz hi-bits (current-nfp-tn vop)
+	     (* (tn-offset stack-temp) vm:word-bytes))
+       (inst lwz lo-bits (current-nfp-tn vop)
+	     (* (1+ (tn-offset stack-temp)) vm:word-bytes)))
+      (double-stack
+       (inst lwz hi-bits (current-nfp-tn vop)
+	     (* (tn-offset float) vm:word-bytes))
+       (inst lwz lo-bits (current-nfp-tn vop)
+	     (* (1+ (tn-offset float)) vm:word-bytes)))
+      (descriptor-reg
+       (loadw hi-bits float vm:double-float-value-slot
+	      vm:other-pointer-type)
+       (loadw lo-bits float (1+ vm:double-float-value-slot)
+	      vm:other-pointer-type)))))
+
 
 ;;;; Float mode hackery:
 
-- 
GitLab