diff --git a/compiler/sparc/array.lisp b/compiler/sparc/array.lisp index 02b34cc863d26337a9fcdebb7ce3da965a628668..68ed99e6346662e20e43e1a97bdfbc06a32701e4 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 56d532aaa37baa1de09e0fb5ca83d5f590ed6f30..9e883d90356179173ef6613f5a3e3ab7596a1310 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))