From ea08893ff3611bd70df40b47026ccd5cfcae4c85 Mon Sep 17 00:00:00 2001 From: rtoy <rtoy> Date: Tue, 15 Apr 2008 14:33:25 +0000 Subject: [PATCH] sparc/parms.lisp: o Add SINGLE-FLOAT-BYTES and DOUBLE-FLOAT-BYTES to indicate how many bytes are needed to hold a SINGLE-FLOAT and DOUBLE-FLOAT, respectively. sparc/array.lisp: o Use SINGLE-FLOAT-BYTES and DOUBLE-FLOAT-BYTES instead of random constants or incorrect uses of VM:WORD-BYTES in the float code. (VM:WORD-BYTES is the wrong value to use if we have a 64-bit words.) o Try to replace the constants in all the shift instructions used to compute the byte offset from an index. The shift is really the some other constant minus the number of tag bits used for the fixnum. This makes shift values a little easier to understand. --- compiler/sparc/array.lisp | 138 +++++++++++++++++++------------------- compiler/sparc/parms.lisp | 8 ++- 2 files changed, 75 insertions(+), 71 deletions(-) diff --git a/compiler/sparc/array.lisp b/compiler/sparc/array.lisp index 02b34cc86..68ed99e63 100644 --- a/compiler/sparc/array.lisp +++ b/compiler/sparc/array.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/array.lisp,v 1.33 2006/06/30 18:41:32 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/array.lisp,v 1.34 2008/04/15 14:33:25 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -426,7 +426,7 @@ (:result-types double-float) (:temporary (:scs (non-descriptor-reg)) offset) (:generator 7 - (inst slln offset index 1) + (inst slln offset index (- 3 fixnum-tag-bits)) (inst add offset (- (* vm:vector-data-offset vm:word-bytes) vm:other-pointer-type)) (inst lddf value object offset))) @@ -442,7 +442,7 @@ (:result-types double-float) (:temporary (:scs (non-descriptor-reg)) temp) (:generator 3 - (let ((offset (+ (* index 8) + (let ((offset (+ (* index double-float-bytes) (- (* vm:vector-data-offset vm:word-bytes) vm:other-pointer-type)))) (if (typep offset '(signed-byte 13)) @@ -463,7 +463,7 @@ (:result-types double-float) (:temporary (:scs (non-descriptor-reg)) offset) (:generator 20 - (inst slln offset index 1) + (inst slln offset index (- 3 fixnum-tag-bits)) (inst add offset (- (* vm:vector-data-offset vm:word-bytes) vm:other-pointer-type)) (inst stdf value object offset) @@ -484,7 +484,7 @@ (:result-types double-float) (:temporary (:scs (non-descriptor-reg)) temp) (:generator 10 - (let ((offset (+ (* index 8) + (let ((offset (+ (* index double-float-bytes) (- (* vm:vector-data-offset vm:word-bytes) vm:other-pointer-type)))) (if (typep offset '(signed-byte 13)) @@ -604,12 +604,12 @@ (:result-types complex-single-float) (:generator 5 (let ((real-tn (complex-single-reg-real-tn value))) - (inst slln offset index 1) + (inst slln offset index (- 3 fixnum-tag-bits)) (inst add offset (- (* vm:vector-data-offset vm:word-bytes) vm:other-pointer-type)) (inst ldf real-tn object offset)) (let ((imag-tn (complex-single-reg-imag-tn value))) - (inst add offset vm:word-bytes) + (inst add offset single-float-bytes) (inst ldf imag-tn object offset)))) (define-vop (data-vector-ref-c/simple-array-complex-single-float) @@ -624,18 +624,18 @@ (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) temp) (:result-types complex-single-float) (:generator 3 - (let ((offset (+ (* index 8) + (let ((offset (+ (* index (* 2 single-float-bytes)) (- (* vm:vector-data-offset vm:word-bytes) vm:other-pointer-type))) (real-tn (complex-single-reg-real-tn value)) (imag-tn (complex-single-reg-imag-tn value))) - (cond ((typep (+ offset 4) '(signed-byte 13)) + (cond ((typep (+ offset single-float-bytes) '(signed-byte 13)) (inst ldf real-tn object offset) - (inst ldf imag-tn object (+ offset 4))) + (inst ldf imag-tn object (+ offset single-float-bytes))) (t (inst li temp offset) (inst ldf real-tn object temp) - (inst add temp 4) + (inst add temp single-float-bytes) (inst ldf imag-tn object temp)))))) (define-vop (data-vector-set/simple-array-complex-single-float) @@ -653,7 +653,7 @@ (:generator 5 (let ((value-real (complex-single-reg-real-tn value)) (result-real (complex-single-reg-real-tn result))) - (inst slln offset index 1) + (inst slln offset index (- 3 fixnum-tag-bits)) (inst add offset (- (* vm:vector-data-offset vm:word-bytes) vm:other-pointer-type)) (inst stf value-real object offset) @@ -661,7 +661,7 @@ (inst fmovs result-real value-real))) (let ((value-imag (complex-single-reg-imag-tn value)) (result-imag (complex-single-reg-imag-tn result))) - (inst add offset vm:word-bytes) + (inst add offset single-float-bytes) (inst stf value-imag object offset) (unless (location= result-imag value-imag) (inst fmovs result-imag value-imag))))) @@ -680,20 +680,20 @@ (:result-types complex-single-float) (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) temp) (:generator 3 - (let ((offset (+ (* index 8) + (let ((offset (+ (* index (* 2 single-float-bytes)) (- (* vm:vector-data-offset vm:word-bytes) vm:other-pointer-type))) (value-real (complex-single-reg-real-tn value)) (result-real (complex-single-reg-real-tn result)) (value-imag (complex-single-reg-imag-tn value)) (result-imag (complex-single-reg-imag-tn result))) - (cond ((typep (+ offset 4) '(signed-byte 13)) + (cond ((typep (+ offset single-float-bytes) '(signed-byte 13)) (inst stf value-real object offset) - (inst stf value-imag object (+ offset 4))) + (inst stf value-imag object (+ offset single-float-bytes))) (t (inst li temp offset) (inst stf value-real object temp) - (inst add temp 4) + (inst add temp single-float-bytes) (inst stf value-imag object temp))) (unless (location= result-real value-real) (inst fmovs result-real value-real)) @@ -712,12 +712,12 @@ (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) offset) (:generator 7 (let ((real-tn (complex-double-reg-real-tn value))) - (inst slln offset index 2) + (inst slln offset index (- 4 fixnum-tag-bits)) (inst add offset (- (* vm:vector-data-offset vm:word-bytes) vm:other-pointer-type)) (inst lddf real-tn object offset)) (let ((imag-tn (complex-double-reg-imag-tn value))) - (inst add offset (* 2 vm:word-bytes)) + (inst add offset double-float-bytes) (inst lddf imag-tn object offset)))) (define-vop (data-vector-ref-c/simple-array-complex-double-float) @@ -731,18 +731,18 @@ (:result-types complex-double-float) (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) temp) (:generator 5 - (let ((offset (+ (* index 16) + (let ((offset (+ (* index (* 2 double-float-bytes)) (- (* vm:vector-data-offset vm:word-bytes) vm:other-pointer-type))) (real-tn (complex-double-reg-real-tn value)) (imag-tn (complex-double-reg-imag-tn value))) - (cond ((typep (+ offset 8) '(signed-byte 13)) + (cond ((typep (+ offset double-float-bytes) '(signed-byte 13)) (inst lddf real-tn object offset) - (inst lddf imag-tn object (+ offset 8))) + (inst lddf imag-tn object (+ offset double-float-bytes))) (t (inst li temp offset) (inst lddf real-tn object temp) - (inst add temp (* 2 vm:word-bytes)) + (inst add temp double-float-bytes) (inst lddf imag-tn object temp)))))) (define-vop (data-vector-set/simple-array-complex-double-float) @@ -760,7 +760,7 @@ (:generator 20 (let ((value-real (complex-double-reg-real-tn value)) (result-real (complex-double-reg-real-tn result))) - (inst slln offset index 2) + (inst slln offset index (- 4 fixnum-tag-bits)) (inst add offset (- (* vm:vector-data-offset vm:word-bytes) vm:other-pointer-type)) (inst stdf value-real object offset) @@ -768,7 +768,7 @@ (move-double-reg result-real value-real))) (let ((value-imag (complex-double-reg-imag-tn value)) (result-imag (complex-double-reg-imag-tn result))) - (inst add offset (* 2 vm:word-bytes)) + (inst add offset double-float-bytes) (inst stdf value-imag object offset) (unless (location= result-imag value-imag) (move-double-reg result-imag value-imag))))) @@ -791,20 +791,20 @@ (result-real (complex-double-reg-real-tn result)) (value-imag (complex-double-reg-imag-tn value)) (result-imag (complex-double-reg-imag-tn result)) - (offset (+ (* index 16) + (offset (+ (* index (* 2 double-float-bytes)) (- (* vm:vector-data-offset vm:word-bytes) vm:other-pointer-type)))) ;; There's a possible optimization here if the offset for the ;; real part fits in a signed-byte 13 but the imag part doesn't. ;; We don't do this because it can't happen with the current ;; values of vm:other-pointer-type and vm:vector-data-offset. - (cond ((typep (+ offset 8) '(signed-byte 13)) + (cond ((typep (+ offset double-float-bytes) '(signed-byte 13)) (inst stdf value-real object offset) - (inst stdf value-imag object (+ offset 8))) + (inst stdf value-imag object (+ offset double-float-bytes))) (t (inst li temp offset) (inst stdf value-real object temp) - (inst add temp 8) + (inst add temp double-float-bytes) (inst stdf value-imag object temp))) (unless (location= result-real value-real) (move-double-reg result-real value-real)) @@ -964,12 +964,12 @@ (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) offset) (:generator 7 (let ((hi-tn (double-double-reg-hi-tn value))) - (inst slln offset index 2) + (inst slln offset index (- 4 fixnum-tag-bits)) (inst add offset (- (* vm:vector-data-offset vm:word-bytes) vm:other-pointer-type)) (inst lddf hi-tn object offset)) (let ((lo-tn (double-double-reg-lo-tn value))) - (inst add offset (* 2 vm:word-bytes)) + (inst add offset double-float-bytes) (inst lddf lo-tn object offset)))) (define-vop (data-vector-ref-c/simple-array-double-double-float) @@ -983,18 +983,18 @@ (:result-types double-double-float) (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) temp) (:generator 5 - (let ((offset (+ (* index 16) + (let ((offset (+ (* index (* 2 double-float-bytes)) (- (* vm:vector-data-offset vm:word-bytes) vm:other-pointer-type))) (hi-tn (double-double-reg-hi-tn value)) (lo-tn (double-double-reg-lo-tn value))) - (cond ((typep (+ offset 8) '(signed-byte 13)) + (cond ((typep (+ offset double-float-bytes) '(signed-byte 13)) (inst lddf hi-tn object offset) - (inst lddf lo-tn object (+ offset 8))) + (inst lddf lo-tn object (+ offset double-float-bytes))) (t (inst li temp offset) (inst lddf hi-tn object temp) - (inst add temp (* 2 vm:word-bytes)) + (inst add temp double-float-bytes) (inst lddf lo-tn object temp)))))) (define-vop (data-vector-set/simple-array-double-double-float) @@ -1012,7 +1012,7 @@ (:generator 20 (let ((value-hi (double-double-reg-hi-tn value)) (result-hi (double-double-reg-hi-tn result))) - (inst slln offset index 2) + (inst slln offset index (- 4 fixnum-tag-bits)) (inst add offset (- (* vm:vector-data-offset vm:word-bytes) vm:other-pointer-type)) (inst stdf value-hi object offset) @@ -1020,7 +1020,7 @@ (move-double-reg result-hi value-hi))) (let ((value-lo (double-double-reg-lo-tn value)) (result-lo (double-double-reg-lo-tn result))) - (inst add offset (* 2 vm:word-bytes)) + (inst add offset double-float-bytes) (inst stdf value-lo object offset) (unless (location= result-lo value-lo) (move-double-reg result-lo value-lo))))) @@ -1043,20 +1043,20 @@ (result-hi (double-double-reg-hi-tn result)) (value-lo (double-double-reg-lo-tn value)) (result-lo (double-double-reg-lo-tn result)) - (offset (+ (* index 16) + (offset (+ (* index (* 2 double-float-bytes)) (- (* vm:vector-data-offset vm:word-bytes) vm:other-pointer-type)))) ;; There's a possible optimization here if the offset for the ;; real part fits in a signed-byte 13 but the imag part doesn't. ;; We don't do this because it can't happen with the current ;; values of vm:other-pointer-type and vm:vector-data-offset. - (cond ((typep (+ offset 8) '(signed-byte 13)) + (cond ((typep (+ offset double-float-bytes) '(signed-byte 13)) (inst stdf value-hi object offset) - (inst stdf value-lo object (+ offset 8))) + (inst stdf value-lo object (+ offset double-float-bytes))) (t (inst li temp offset) (inst stdf value-hi object temp) - (inst add temp 8) + (inst add temp double-float-bytes) (inst stdf value-lo object temp))) (unless (location= result-hi value-hi) (move-double-reg result-hi value-hi)) @@ -1075,18 +1075,18 @@ (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) offset) (:generator 7 (let ((real-tn (complex-double-double-reg-real-hi-tn value))) - (inst slln offset index 3) + (inst slln offset index (- 5 fixnum-tag-bits)) (inst add offset (- (* vm:vector-data-offset vm:word-bytes) vm:other-pointer-type)) (inst lddf real-tn object offset)) (let ((real-tn (complex-double-double-reg-real-lo-tn value))) - (inst add offset (* 2 vm:word-bytes)) + (inst add offset double-float-bytes) (inst lddf real-tn object offset)) (let ((imag-tn (complex-double-double-reg-imag-hi-tn value))) - (inst add offset (* 2 vm:word-bytes)) + (inst add offset double-float-bytes) (inst lddf imag-tn object offset)) (let ((imag-tn (complex-double-double-reg-imag-lo-tn value))) - (inst add offset (* 2 vm:word-bytes)) + (inst add offset double-float-bytes) (inst lddf imag-tn object offset)))) (define-vop (data-vector-ref-c/simple-array-complex-double-double-float) @@ -1100,26 +1100,26 @@ (:result-types complex-double-double-float) (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) temp) (:generator 5 - (let ((offset (+ (* index 16) + (let ((offset (+ (* index (* 2 double-float-bytes)) (- (* vm:vector-data-offset vm:word-bytes) vm:other-pointer-type))) (real-hi-tn (complex-double-double-reg-real-hi-tn value)) (imag-hi-tn (complex-double-double-reg-imag-hi-tn value)) (real-lo-tn (complex-double-double-reg-real-lo-tn value)) (imag-lo-tn (complex-double-double-reg-imag-lo-tn value))) - (cond ((typep (+ offset (* 6 vm:word-bytes)) '(signed-byte 13)) + (cond ((typep (+ offset (* 3 double-float-bytes)) '(signed-byte 13)) (inst lddf real-hi-tn object offset) - (inst lddf real-lo-tn object (+ offset (* 2 vm:word-bytes))) - (inst lddf imag-hi-tn object (+ offset (* 4 vm:word-bytes))) - (inst lddf imag-lo-tn object (+ offset (* 6 vm:word-bytes)))) + (inst lddf real-lo-tn object (+ offset double-float-bytes)) + (inst lddf imag-hi-tn object (+ offset (* 2 double-float-bytes))) + (inst lddf imag-lo-tn object (+ offset (* 3 double-float-bytes)))) (t (inst li temp offset) (inst lddf real-hi-tn object temp) - (inst add temp (* 2 vm:word-bytes)) + (inst add temp double-float-bytes) (inst lddf real-lo-tn object temp) - (inst add temp (* 2 vm:word-bytes)) + (inst add temp double-float-bytes) (inst lddf imag-hi-tn object temp) - (inst add temp (* 2 vm:word-bytes)) + (inst add temp double-float-bytes) (inst lddf imag-lo-tn object temp)))))) (define-vop (data-vector-set/simple-array-complex-double-double-float) @@ -1137,7 +1137,7 @@ (:generator 20 (let ((value-real (complex-double-double-reg-real-hi-tn value)) (result-real (complex-double-double-reg-real-hi-tn result))) - (inst slln offset index 3) + (inst slln offset index (- 5 fixnum-tag-bits)) (inst add offset (- (* vm:vector-data-offset vm:word-bytes) vm:other-pointer-type)) (inst stdf value-real object offset) @@ -1145,19 +1145,19 @@ (move-double-reg result-real value-real))) (let ((value-real (complex-double-double-reg-real-lo-tn value)) (result-real (complex-double-double-reg-real-lo-tn result))) - (inst add offset (* 2 vm:word-bytes)) + (inst add offset double-float-bytes) (inst stdf value-real object offset) (unless (location= result-real value-real) (move-double-reg result-real value-real))) (let ((value-imag (complex-double-double-reg-imag-hi-tn value)) (result-imag (complex-double-double-reg-imag-hi-tn result))) - (inst add offset (* 2 vm:word-bytes)) + (inst add offset double-float-bytes) (inst stdf value-imag object offset) (unless (location= result-imag value-imag) (move-double-reg result-imag value-imag))) (let ((value-imag (complex-double-double-reg-imag-lo-tn value)) (result-imag (complex-double-double-reg-imag-lo-tn result))) - (inst add offset (* 2 vm:word-bytes)) + (inst add offset double-float-bytes) (inst stdf value-imag object offset) (unless (location= result-imag value-imag) (move-double-reg result-imag value-imag))))) @@ -1180,20 +1180,20 @@ (result-real (complex-double-double-reg-real-hi-tn result)) (value-imag (complex-double-double-reg-imag-hi-tn value)) (result-imag (complex-double-double-reg-imag-hi-tn result)) - (offset (+ (* index 16) + (offset (+ (* index (* 2 double-float-bytes)) (- (* vm:vector-data-offset vm:word-bytes) - vm:other-pointer-type)))) + vm:other-pointer-type)))) ;; There's a possible optimization here if the offset for the ;; real part fits in a signed-byte 13 but the imag part doesn't. ;; We don't do this because it can't happen with the current ;; values of vm:other-pointer-type and vm:vector-data-offset. - (cond ((typep (+ offset 8) '(signed-byte 13)) + (cond ((typep (+ offset double-float-bytes) '(signed-byte 13)) (inst stdf value-real object offset) - (inst stdf value-imag object (+ offset 8))) + (inst stdf value-imag object (+ offset double-float-bytes))) (t (inst li temp offset) (inst stdf value-real object temp) - (inst add temp 8) + (inst add temp double-float-bytes) (inst stdf value-imag object temp))) (unless (location= result-real value-real) (move-double-reg result-real value-real)) @@ -1203,20 +1203,20 @@ (result-real (complex-double-double-reg-real-lo-tn result)) (value-imag (complex-double-double-reg-imag-lo-tn value)) (result-imag (complex-double-double-reg-imag-lo-tn result)) - (offset (+ (* index 16) + (offset (+ (* index (* 2 double-float-bytes)) (- (* vm:vector-data-offset vm:word-bytes) - vm:other-pointer-type)))) + vm:other-pointer-type)))) ;; There's a possible optimization here if the offset for the ;; real part fits in a signed-byte 13 but the imag part doesn't. ;; We don't do this because it can't happen with the current ;; values of vm:other-pointer-type and vm:vector-data-offset. - (cond ((typep (+ offset (* 6 vm:word-bytes)) '(signed-byte 13)) - (inst stdf value-real object (+ offset (* 4 vm:word-bytes))) - (inst stdf value-imag object (+ offset (* 6 vm:word-bytes)))) + (cond ((typep (+ offset (* 3 double-float-bytes)) '(signed-byte 13)) + (inst stdf value-real object (+ offset (* 2 double-float-bytes))) + (inst stdf value-imag object (+ offset (* 3 double-float-bytes)))) (t - (inst add temp 8) + (inst add temp double-float-bytes) (inst stdf value-real object temp) - (inst add temp 8) + (inst add temp double-float-bytes) (inst stdf value-imag object temp))) (unless (location= result-real value-real) (move-double-reg result-real value-real)) diff --git a/compiler/sparc/parms.lisp b/compiler/sparc/parms.lisp index 56d532aaa..9e883d903 100644 --- a/compiler/sparc/parms.lisp +++ b/compiler/sparc/parms.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/parms.lisp,v 1.53 2007/07/25 16:06:00 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/parms.lisp,v 1.54 2008/04/15 14:33:25 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -57,12 +57,14 @@ fixnum-tag-bits fixnum-tag-mask positive-fixnum-bits float-sign-shift - + + single-float-bytes single-float-bias single-float-exponent-byte single-float-significand-byte single-float-normal-exponent-min single-float-normal-exponent-max single-float-hidden-bit single-float-trapping-nan-bit single-float-digits + double-float-bytes double-float-bias double-float-exponent-byte double-float-significand-byte double-float-normal-exponent-min double-float-normal-exponent-max double-float-hidden-bit @@ -116,6 +118,7 @@ (defconstant float-sign-shift 31) +(defconstant single-float-bytes 4) ; Bytes to hold a single-float (defconstant single-float-bias 126) (defconstant single-float-exponent-byte (byte 8 23)) (defconstant single-float-significand-byte (byte 23 0)) @@ -124,6 +127,7 @@ (defconstant single-float-hidden-bit (ash 1 23)) (defconstant single-float-trapping-nan-bit (ash 1 22)) +(defconstant double-float-bytes 8) ; Bytes to hold a double-float (defconstant double-float-bias 1022) (defconstant double-float-exponent-byte (byte 11 20)) (defconstant double-float-significand-byte (byte 20 0)) -- GitLab