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