diff --git a/code/kernel.lisp b/code/kernel.lisp index 7d46004bc82cf01c468d5b8ffa30bd4b5e956c0f..ad4e52eb299b103b0106ca1f24cfda382ff4f4eb 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 7d2d1ef2a95d3da3917f6888cb5da072830fc997..87e4c50a350ab86e1db4e92a3ac8de5714011ba2 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 9436f3d03eef56662eaf4c0ce156bbac3baccbe6..b4be76979e09d2a655966a1e7b0503b2253b5cdd 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: