From 4880908b4f2552f16c709008b34c05546a994819 Mon Sep 17 00:00:00 2001 From: toy <toy> Date: Wed, 2 Jul 2003 21:45:34 +0000 Subject: [PATCH] Define DOUBLE-FLOAT-BITS function and VOP for sparc to return the bits of a double-float in multiple-values. This is better than calling double-float-high/low-bits which causes 2 stores to the stack to be done. --- code/exports.lisp | 6 ++++-- code/kernel.lisp | 9 ++++++++- compiler/float-tran.lisp | 8 +++++++- compiler/sparc/float.lisp | 33 ++++++++++++++++++++++++++++++++- 4 files changed, 51 insertions(+), 5 deletions(-) diff --git a/code/exports.lisp b/code/exports.lisp index 6aafd0fbd..1c9ced22b 100644 --- a/code/exports.lisp +++ b/code/exports.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/exports.lisp,v 1.217 2003/06/26 13:27:42 toy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/exports.lisp,v 1.218 2003/07/02 21:45:33 toy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1885,7 +1885,9 @@ "DATA-VECTOR-REF" "DATA-VECTOR-SET" "DECODE-DOUBLE-FLOAT" "DECODE-LONG-FLOAT" "DECODE-SINGLE-FLOAT" "DESCEND-INTO" "DIVISION-BY-ZERO-ERROR" - "DOUBLE-FLOAT-EXPONENT" "DOUBLE-FLOAT-HIGH-BITS" + "DOUBLE-FLOAT-EXPONENT" + #+sparc "DOUBLE-FLOAT-BITS" + "DOUBLE-FLOAT-HIGH-BITS" "DOUBLE-FLOAT-LOW-BITS" "DOUBLE-FLOAT-P" "FLOAT-WAIT" "DYNAMIC-SPACE-FREE-POINTER" "ERROR-NUMBER-OR-LOSE" "FILENAME" "FLOAT-DIGITS" "FLOAT-EXPONENT" "FLOAT-FORMAT-DIGITS" diff --git a/code/kernel.lisp b/code/kernel.lisp index 71e1eba13..a286ea270 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.12 1998/03/21 08:11:58 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/kernel.lisp,v 1.13 2003/07/02 21:45:33 toy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -152,3 +152,10 @@ (defun long-float-mid-bits (x) (long-float-mid-bits x)) #+long-float (defun long-float-low-bits (x) (long-float-low-bits x)) + +#+sparc +(defun double-float-bits (x) (double-float-bits x)) + +#-sparc +(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 64ddee487..d63f30f2e 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.88 2003/04/23 20:05:05 toy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/float-tran.lisp,v 1.89 2003/07/02 21:45:33 toy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -222,6 +222,12 @@ (defknown double-float-low-bits (double-float) (unsigned-byte 32) (movable foldable flushable)) +#+sparc +(defknown double-float-bits (double-float) + (values (signed-byte 32) (unsigned-byte 32)) + (movable foldable flushable)) + + (deftransform float-sign ((float &optional float2) (single-float &optional single-float) *) (if float2 diff --git a/compiler/sparc/float.lisp b/compiler/sparc/float.lisp index faca965fc..11898b67d 100644 --- a/compiler/sparc/float.lisp +++ b/compiler/sparc/float.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/sparc/float.lisp,v 1.38 2003/04/01 21:22:20 toy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/float.lisp,v 1.39 2003/07/02 21:45:34 toy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1179,6 +1179,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 stdf float (current-nfp-tn vop) + (* (tn-offset stack-temp) vm:word-bytes)) + (inst ld hi-bits (current-nfp-tn vop) + (* (tn-offset stack-temp) vm:word-bytes)) + (inst ld lo-bits (current-nfp-tn vop) + (* (1+ (tn-offset stack-temp)) vm:word-bytes))) + (double-stack + (inst ld hi-bits (current-nfp-tn vop) + (* (tn-offset stack-temp) vm:word-bytes)) + (inst ld 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))))) + #+long-float (define-vop (long-float-exp-bits) (:args (float :scs (long-reg descriptor-reg) -- GitLab