X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fsparc%2Farray.lisp;h=b39f0b19c0bf8a20cca89e673d1eabdca91eef6a;hb=06cc46735ebc73618995281f26fcce096c1110f6;hp=c326c33e812d4cbb639672193ddb5951947916d8;hpb=83764e089aec9f082ce7c038f45ff8883d9ca957;p=sbcl.git diff --git a/src/compiler/sparc/array.lisp b/src/compiler/sparc/array.lisp index c326c33..b39f0b1 100644 --- a/src/compiler/sparc/array.lisp +++ b/src/compiler/sparc/array.lisp @@ -12,22 +12,22 @@ (in-package "SB!VM") ;;;; allocator for the array header. - (define-vop (make-array-header) (:translate make-array-header) (:policy :fast-safe) (:args (type :scs (any-reg)) - (rank :scs (any-reg))) + (rank :scs (any-reg))) (:arg-types tagged-num tagged-num) (:temporary (:scs (descriptor-reg) :to (:result 0) :target result) header) (:temporary (:scs (non-descriptor-reg)) ndescr) + (:temporary (:scs (non-descriptor-reg)) gencgc-temp) (:results (result :scs (descriptor-reg))) (:generator 0 (pseudo-atomic () - (inst or header alloc-tn other-pointer-lowtag) - (inst add ndescr rank (* (1+ array-dimensions-offset) n-word-bytes)) - (inst andn ndescr 4) - (inst add alloc-tn ndescr) + (inst add ndescr rank (+ (* (1+ array-dimensions-offset) n-word-bytes) + lowtag-mask)) + (inst andn ndescr lowtag-mask) + (allocation header ndescr other-pointer-lowtag :temp-tn gencgc-temp) (inst add ndescr rank (fixnumize (1- array-dimensions-offset))) (inst sll ndescr ndescr n-widetag-bits) (inst or ndescr ndescr type) @@ -36,7 +36,6 @@ (inst srl ndescr ndescr n-fixnum-tag-bits) (storew ndescr header 0 other-pointer-lowtag)) (move result header))) - ;;;; Additional accessors and setters for the array header. (define-vop (%array-dimension word-index-ref) @@ -66,14 +65,14 @@ (:translate %check-bound) (:policy :fast-safe) (:args (array :scs (descriptor-reg)) - (bound :scs (any-reg descriptor-reg)) - (index :scs (any-reg descriptor-reg) :target result)) + (bound :scs (any-reg descriptor-reg)) + (index :scs (any-reg descriptor-reg) :target result)) (:results (result :scs (any-reg descriptor-reg))) (:vop-var vop) (:save-p :compute-only) (:generator 5 (let ((error (generate-error-code vop invalid-array-index-error - array bound index))) + array bound index))) (inst cmp index bound) (inst b :geu error) (inst nop) @@ -84,11 +83,10 @@ ;;; Variants built on top of word-index-ref, etc. I.e. those vectors whos ;;; elements are represented in integer registers and are built out of ;;; 8, 16, or 32 bit elements. - (macrolet ((def-data-vector-frobs (type variant element-type &rest scs) `(progn (define-vop (,(symbolicate "DATA-VECTOR-REF/" (string type)) - ,(symbolicate (string variant) "-REF")) + ,(symbolicate (string variant) "-REF")) (:note "inline array access") (:variant vector-data-offset other-pointer-lowtag) (:translate data-vector-ref) @@ -96,19 +94,22 @@ (:results (value :scs ,scs)) (:result-types ,element-type)) (define-vop (,(symbolicate "DATA-VECTOR-SET/" (string type)) - ,(symbolicate (string variant) "-SET")) + ,(symbolicate (string variant) "-SET")) (:note "inline array store") (:variant vector-data-offset other-pointer-lowtag) (:translate data-vector-set) (:arg-types ,type positive-fixnum ,element-type) (:args (object :scs (descriptor-reg)) - (index :scs (any-reg zero immediate)) - (value :scs ,scs)) + (index :scs (any-reg zero immediate)) + (value :scs ,scs)) (:results (result :scs ,scs)) (:result-types ,element-type))))) (def-data-vector-frobs simple-base-string byte-index - base-char base-char-reg) + character character-reg) + #!+sb-unicode + (def-data-vector-frobs simple-character-string word-index + character character-reg) (def-data-vector-frobs simple-vector word-index * descriptor-reg any-reg) @@ -125,9 +126,9 @@ (def-data-vector-frobs simple-array-unsigned-byte-32 word-index unsigned-num unsigned-reg) - (def-data-vector-frobs simple-array-unsigned-byte-29 word-index + (def-data-vector-frobs simple-array-unsigned-fixnum word-index positive-fixnum any-reg) - (def-data-vector-frobs simple-array-signed-byte-30 word-index + (def-data-vector-frobs simple-array-fixnum word-index tagged-num any-reg) (def-data-vector-frobs simple-array-signed-byte-32 word-index signed-num signed-reg)) @@ -136,155 +137,155 @@ ;;; and 4-bit vectors. (macrolet ((def-small-data-vector-frobs (type bits) (let* ((elements-per-word (floor n-word-bits bits)) - (bit-shift (1- (integer-length elements-per-word)))) + (bit-shift (1- (integer-length elements-per-word)))) `(progn (define-vop (,(symbolicate "DATA-VECTOR-REF/" type)) - (:note "inline array access") - (:translate data-vector-ref) - (:policy :fast-safe) - (:args (object :scs (descriptor-reg)) - (index :scs (unsigned-reg))) - (:arg-types ,type positive-fixnum) - (:results (value :scs (any-reg))) - (:result-types positive-fixnum) - (:temporary (:scs (non-descriptor-reg) :to (:result 0)) temp result) - (:generator 20 - (inst srl temp index ,bit-shift) - (inst sll temp n-fixnum-tag-bits) - (inst add temp (- (* vector-data-offset n-word-bytes) - other-pointer-lowtag)) - (inst ld result object temp) - (inst and temp index ,(1- elements-per-word)) - (inst xor temp ,(1- elements-per-word)) - ,@(unless (= bits 1) - `((inst sll temp ,(1- (integer-length bits))))) - (inst srl result temp) - (inst and result ,(1- (ash 1 bits))) - (inst sll value result 2))) + (:note "inline array access") + (:translate data-vector-ref) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg)) + (index :scs (unsigned-reg))) + (:arg-types ,type positive-fixnum) + (:results (value :scs (any-reg))) + (:result-types positive-fixnum) + (:temporary (:scs (non-descriptor-reg) :to (:result 0)) temp result) + (:generator 20 + (inst srl temp index ,bit-shift) + (inst sll temp n-fixnum-tag-bits) + (inst add temp (- (* vector-data-offset n-word-bytes) + other-pointer-lowtag)) + (inst ld result object temp) + (inst and temp index ,(1- elements-per-word)) + (inst xor temp ,(1- elements-per-word)) + ,@(unless (= bits 1) + `((inst sll temp ,(1- (integer-length bits))))) + (inst srl result temp) + (inst and result ,(1- (ash 1 bits))) + (inst sll value result 2))) (define-vop (,(symbolicate "DATA-VECTOR-REF-C/" type)) - (:translate data-vector-ref) - (:policy :fast-safe) - (:args (object :scs (descriptor-reg))) - (:arg-types ,type (:constant index)) - (:info index) - (:results (result :scs (unsigned-reg))) - (:result-types positive-fixnum) - (:temporary (:scs (non-descriptor-reg)) temp) - (:generator 15 - (multiple-value-bind (word extra) + (:translate data-vector-ref) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg))) + (:arg-types ,type (:constant index)) + (:info index) + (:results (result :scs (unsigned-reg))) + (:result-types positive-fixnum) + (:temporary (:scs (non-descriptor-reg)) temp) + (:generator 15 + (multiple-value-bind (word extra) (floor index ,elements-per-word) - (setf extra (logxor extra (1- ,elements-per-word))) - (let ((offset (- (* (+ word vector-data-offset) n-word-bytes) - other-pointer-lowtag))) - (cond ((typep offset '(signed-byte 13)) - (inst ld result object offset)) - (t - (inst li temp offset) - (inst ld result object temp)))) - (unless (zerop extra) - (inst srl result (* extra ,bits))) - (unless (= extra ,(1- elements-per-word)) - (inst and result ,(1- (ash 1 bits))))))) + (setf extra (logxor extra (1- ,elements-per-word))) + (let ((offset (- (* (+ word vector-data-offset) n-word-bytes) + other-pointer-lowtag))) + (cond ((typep offset '(signed-byte 13)) + (inst ld result object offset)) + (t + (inst li temp offset) + (inst ld result object temp)))) + (unless (zerop extra) + (inst srl result (* extra ,bits))) + (unless (= extra ,(1- elements-per-word)) + (inst and result ,(1- (ash 1 bits))))))) (define-vop (,(symbolicate "DATA-VECTOR-SET/" type)) - (:note "inline array store") - (:translate data-vector-set) - (:policy :fast-safe) - (:args (object :scs (descriptor-reg)) - (index :scs (unsigned-reg) :target shift) - (value :scs (unsigned-reg zero immediate) :target result)) - (:arg-types ,type positive-fixnum positive-fixnum) - (:results (result :scs (unsigned-reg))) - (:result-types positive-fixnum) - (:temporary (:scs (non-descriptor-reg)) temp old offset) - (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) shift) - (:generator 25 - (inst srl offset index ,bit-shift) - (inst sll offset n-fixnum-tag-bits) - (inst add offset (- (* vector-data-offset n-word-bytes) - other-pointer-lowtag)) - (inst ld old object offset) - (inst and shift index ,(1- elements-per-word)) - (inst xor shift ,(1- elements-per-word)) - ,@(unless (= bits 1) - `((inst sll shift ,(1- (integer-length bits))))) - (unless (and (sc-is value immediate) - (= (tn-value value) ,(1- (ash 1 bits)))) - (inst li temp ,(1- (ash 1 bits))) - (inst sll temp shift) - (inst not temp) - (inst and old temp)) - (unless (sc-is value zero) - (sc-case value - (immediate - (inst li temp (logand (tn-value value) ,(1- (ash 1 bits))))) - (unsigned-reg - (inst and temp value ,(1- (ash 1 bits))))) - (inst sll temp shift) - (inst or old temp)) - (inst st old object offset) - (sc-case value - (immediate - (inst li result (tn-value value))) - (t - (move result value))))) + (:note "inline array store") + (:translate data-vector-set) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg)) + (index :scs (unsigned-reg) :target shift) + (value :scs (unsigned-reg zero immediate) :target result)) + (:arg-types ,type positive-fixnum positive-fixnum) + (:results (result :scs (unsigned-reg))) + (:result-types positive-fixnum) + (:temporary (:scs (non-descriptor-reg)) temp old offset) + (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) shift) + (:generator 25 + (inst srl offset index ,bit-shift) + (inst sll offset n-fixnum-tag-bits) + (inst add offset (- (* vector-data-offset n-word-bytes) + other-pointer-lowtag)) + (inst ld old object offset) + (inst and shift index ,(1- elements-per-word)) + (inst xor shift ,(1- elements-per-word)) + ,@(unless (= bits 1) + `((inst sll shift ,(1- (integer-length bits))))) + (unless (and (sc-is value immediate) + (= (tn-value value) ,(1- (ash 1 bits)))) + (inst li temp ,(1- (ash 1 bits))) + (inst sll temp shift) + (inst not temp) + (inst and old temp)) + (unless (sc-is value zero) + (sc-case value + (immediate + (inst li temp (logand (tn-value value) ,(1- (ash 1 bits))))) + (unsigned-reg + (inst and temp value ,(1- (ash 1 bits))))) + (inst sll temp shift) + (inst or old temp)) + (inst st old object offset) + (sc-case value + (immediate + (inst li result (tn-value value))) + (t + (move result value))))) (define-vop (,(symbolicate "DATA-VECTOR-SET-C/" type)) - (:translate data-vector-set) - (:policy :fast-safe) - (:args (object :scs (descriptor-reg)) - (value :scs (unsigned-reg zero immediate) :target result)) - (:arg-types ,type - (:constant index) - positive-fixnum) - (:info index) - (:results (result :scs (unsigned-reg))) - (:result-types positive-fixnum) - (:temporary (:scs (non-descriptor-reg)) offset-reg temp old) - (:generator 20 - (multiple-value-bind (word extra) (floor index ,elements-per-word) - (let ((offset (- (* (+ word vector-data-offset) n-word-bytes) - other-pointer-lowtag))) - (cond ((typep offset '(signed-byte 13)) - (inst ld old object offset)) - (t - (inst li offset-reg offset) - (inst ld old object offset-reg))) - (unless (and (sc-is value immediate) - (= (tn-value value) ,(1- (ash 1 bits)))) - (cond ((zerop extra) - (inst sll old ,bits) - (inst srl old ,bits)) - (t - (inst li temp - (lognot (ash ,(1- (ash 1 bits)) - (* (logxor extra - ,(1- elements-per-word)) - ,bits)))) - (inst and old temp)))) - (sc-case value - (zero) - (immediate - (let ((value (ash (logand (tn-value value) - ,(1- (ash 1 bits))) - (* (logxor extra - ,(1- elements-per-word)) - ,bits)))) - (cond ((typep value '(signed-byte 13)) - (inst or old value)) - (t - (inst li temp value) - (inst or old temp))))) - (unsigned-reg - (inst sll temp value - (* (logxor extra ,(1- elements-per-word)) ,bits)) - (inst or old temp))) - (if (typep offset '(signed-byte 13)) - (inst st old object offset) - (inst st old object offset-reg))) - (sc-case value - (immediate - (inst li result (tn-value value))) - (t - (move result value)))))))))) + (:translate data-vector-set) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg)) + (value :scs (unsigned-reg zero immediate) :target result)) + (:arg-types ,type + (:constant index) + positive-fixnum) + (:info index) + (:results (result :scs (unsigned-reg))) + (:result-types positive-fixnum) + (:temporary (:scs (non-descriptor-reg)) offset-reg temp old) + (:generator 20 + (multiple-value-bind (word extra) (floor index ,elements-per-word) + (let ((offset (- (* (+ word vector-data-offset) n-word-bytes) + other-pointer-lowtag))) + (cond ((typep offset '(signed-byte 13)) + (inst ld old object offset)) + (t + (inst li offset-reg offset) + (inst ld old object offset-reg))) + (unless (and (sc-is value immediate) + (= (tn-value value) ,(1- (ash 1 bits)))) + (cond ((zerop extra) + (inst sll old ,bits) + (inst srl old ,bits)) + (t + (inst li temp + (lognot (ash ,(1- (ash 1 bits)) + (* (logxor extra + ,(1- elements-per-word)) + ,bits)))) + (inst and old temp)))) + (sc-case value + (zero) + (immediate + (let ((value (ash (logand (tn-value value) + ,(1- (ash 1 bits))) + (* (logxor extra + ,(1- elements-per-word)) + ,bits)))) + (cond ((typep value '(signed-byte 13)) + (inst or old value)) + (t + (inst li temp value) + (inst or old temp))))) + (unsigned-reg + (inst sll temp value + (* (logxor extra ,(1- elements-per-word)) ,bits)) + (inst or old temp))) + (if (typep offset '(signed-byte 13)) + (inst st old object offset) + (inst st old object offset-reg))) + (sc-case value + (immediate + (inst li result (tn-value value))) + (t + (move result value)))))))))) (def-small-data-vector-frobs simple-bit-vector 1) (def-small-data-vector-frobs simple-array-unsigned-byte-2 2) @@ -296,14 +297,14 @@ (:translate data-vector-ref) (:policy :fast-safe) (:args (object :scs (descriptor-reg)) - (index :scs (any-reg))) + (index :scs (any-reg))) (:arg-types simple-array-single-float positive-fixnum) (:results (value :scs (single-reg))) (:temporary (:scs (non-descriptor-reg)) offset) (:result-types single-float) (:generator 5 (inst add offset index (- (* vector-data-offset n-word-bytes) - other-pointer-lowtag)) + other-pointer-lowtag)) (inst ldf value object offset))) @@ -312,16 +313,16 @@ (:translate data-vector-set) (:policy :fast-safe) (:args (object :scs (descriptor-reg)) - (index :scs (any-reg)) - (value :scs (single-reg) :target result)) + (index :scs (any-reg)) + (value :scs (single-reg) :target result)) (:arg-types simple-array-single-float positive-fixnum single-float) (:results (result :scs (single-reg))) (:result-types single-float) (:temporary (:scs (non-descriptor-reg)) offset) (:generator 5 (inst add offset index - (- (* vector-data-offset n-word-bytes) - other-pointer-lowtag)) + (- (* vector-data-offset n-word-bytes) + other-pointer-lowtag)) (inst stf value object offset) (unless (location= result value) (inst fmovs result value)))) @@ -331,7 +332,7 @@ (:translate data-vector-ref) (:policy :fast-safe) (:args (object :scs (descriptor-reg)) - (index :scs (any-reg))) + (index :scs (any-reg))) (:arg-types simple-array-double-float positive-fixnum) (:results (value :scs (double-reg))) (:result-types double-float) @@ -339,7 +340,7 @@ (:generator 7 (inst sll offset index 1) (inst add offset (- (* vector-data-offset n-word-bytes) - other-pointer-lowtag)) + other-pointer-lowtag)) (inst lddf value object offset))) (define-vop (data-vector-set/simple-array-double-float) @@ -347,8 +348,8 @@ (:translate data-vector-set) (:policy :fast-safe) (:args (object :scs (descriptor-reg)) - (index :scs (any-reg)) - (value :scs (double-reg) :target result)) + (index :scs (any-reg)) + (value :scs (double-reg) :target result)) (:arg-types simple-array-double-float positive-fixnum double-float) (:results (result :scs (double-reg))) (:result-types double-float) @@ -356,7 +357,7 @@ (:generator 20 (inst sll offset index 1) (inst add offset (- (* vector-data-offset n-word-bytes) - other-pointer-lowtag)) + other-pointer-lowtag)) (inst stdf value object offset) (unless (location= result value) (move-double-reg result value)))) @@ -367,7 +368,7 @@ (:translate data-vector-ref) (:policy :fast-safe) (:args (object :scs (descriptor-reg)) - (index :scs (any-reg))) + (index :scs (any-reg))) (:arg-types simple-array-long-float positive-fixnum) (:results (value :scs (long-reg))) (:result-types long-float) @@ -375,7 +376,7 @@ (:generator 7 (inst sll offset index 2) (inst add offset (- (* vector-data-offset n-word-bytes) - other-pointer-lowtag)) + other-pointer-lowtag)) (load-long-reg value object offset nil))) #!+long-float @@ -384,8 +385,8 @@ (:translate data-vector-set) (:policy :fast-safe) (:args (object :scs (descriptor-reg)) - (index :scs (any-reg)) - (value :scs (long-reg) :target result)) + (index :scs (any-reg)) + (value :scs (long-reg) :target result)) (:arg-types simple-array-long-float positive-fixnum long-float) (:results (result :scs (long-reg))) (:result-types long-float) @@ -393,7 +394,7 @@ (:generator 20 (inst sll offset index 2) (inst add offset (- (* vector-data-offset n-word-bytes) - other-pointer-lowtag)) + other-pointer-lowtag)) (store-long-reg value object offset nil) (unless (location= result value) (move-long-reg result value)))) @@ -429,14 +430,14 @@ (:translate data-vector-set) (:arg-types simple-array-signed-byte-8 positive-fixnum tagged-num) (:args (object :scs (descriptor-reg)) - (index :scs (any-reg zero immediate)) - (value :scs (signed-reg))) + (index :scs (any-reg zero immediate)) + (value :scs (signed-reg))) (:results (result :scs (signed-reg))) (:result-types tagged-num)) (define-vop (data-vector-ref/simple-array-signed-byte-16 - signed-halfword-index-ref) + signed-halfword-index-ref) (:note "inline array access") (:variant vector-data-offset other-pointer-lowtag) (:translate data-vector-ref) @@ -450,8 +451,8 @@ (:translate data-vector-set) (:arg-types simple-array-signed-byte-16 positive-fixnum tagged-num) (:args (object :scs (descriptor-reg)) - (index :scs (any-reg zero immediate)) - (value :scs (signed-reg))) + (index :scs (any-reg zero immediate)) + (value :scs (signed-reg))) (:results (result :scs (signed-reg))) (:result-types tagged-num)) @@ -463,7 +464,7 @@ (:translate data-vector-ref) (:policy :fast-safe) (:args (object :scs (descriptor-reg) :to :result) - (index :scs (any-reg))) + (index :scs (any-reg))) (:arg-types simple-array-complex-single-float positive-fixnum) (:results (value :scs (complex-single-reg))) (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) offset) @@ -472,7 +473,7 @@ (let ((real-tn (complex-single-reg-real-tn value))) (inst sll offset index 1) (inst add offset (- (* vector-data-offset n-word-bytes) - other-pointer-lowtag)) + other-pointer-lowtag)) (inst ldf real-tn object offset)) (let ((imag-tn (complex-single-reg-imag-tn value))) (inst add offset n-word-bytes) @@ -483,35 +484,35 @@ (:translate data-vector-set) (:policy :fast-safe) (:args (object :scs (descriptor-reg) :to :result) - (index :scs (any-reg)) - (value :scs (complex-single-reg) :target result)) + (index :scs (any-reg)) + (value :scs (complex-single-reg) :target result)) (:arg-types simple-array-complex-single-float positive-fixnum - complex-single-float) + complex-single-float) (:results (result :scs (complex-single-reg))) (:result-types complex-single-float) (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) offset) (:generator 5 (let ((value-real (complex-single-reg-real-tn value)) - (result-real (complex-single-reg-real-tn result))) + (result-real (complex-single-reg-real-tn result))) (inst sll offset index 1) (inst add offset (- (* vector-data-offset n-word-bytes) - other-pointer-lowtag)) + other-pointer-lowtag)) (inst stf value-real object offset) (unless (location= result-real value-real) - (inst fmovs result-real value-real))) + (inst fmovs result-real value-real))) (let ((value-imag (complex-single-reg-imag-tn value)) - (result-imag (complex-single-reg-imag-tn result))) + (result-imag (complex-single-reg-imag-tn result))) (inst add offset n-word-bytes) (inst stf value-imag object offset) (unless (location= result-imag value-imag) - (inst fmovs result-imag value-imag))))) + (inst fmovs result-imag value-imag))))) (define-vop (data-vector-ref/simple-array-complex-double-float) (:note "inline array access") (:translate data-vector-ref) (:policy :fast-safe) (:args (object :scs (descriptor-reg) :to :result) - (index :scs (any-reg))) + (index :scs (any-reg))) (:arg-types simple-array-complex-double-float positive-fixnum) (:results (value :scs (complex-double-reg))) (:result-types complex-double-float) @@ -520,7 +521,7 @@ (let ((real-tn (complex-double-reg-real-tn value))) (inst sll offset index 2) (inst add offset (- (* vector-data-offset n-word-bytes) - other-pointer-lowtag)) + other-pointer-lowtag)) (inst lddf real-tn object offset)) (let ((imag-tn (complex-double-reg-imag-tn value))) (inst add offset (* 2 n-word-bytes)) @@ -531,28 +532,28 @@ (:translate data-vector-set) (:policy :fast-safe) (:args (object :scs (descriptor-reg) :to :result) - (index :scs (any-reg)) - (value :scs (complex-double-reg) :target result)) + (index :scs (any-reg)) + (value :scs (complex-double-reg) :target result)) (:arg-types simple-array-complex-double-float positive-fixnum - complex-double-float) + complex-double-float) (:results (result :scs (complex-double-reg))) (:result-types complex-double-float) (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) offset) (:generator 20 (let ((value-real (complex-double-reg-real-tn value)) - (result-real (complex-double-reg-real-tn result))) + (result-real (complex-double-reg-real-tn result))) (inst sll offset index 2) (inst add offset (- (* vector-data-offset n-word-bytes) - other-pointer-lowtag)) + other-pointer-lowtag)) (inst stdf value-real object offset) (unless (location= result-real value-real) - (move-double-reg result-real value-real))) + (move-double-reg result-real value-real))) (let ((value-imag (complex-double-reg-imag-tn value)) - (result-imag (complex-double-reg-imag-tn result))) + (result-imag (complex-double-reg-imag-tn result))) (inst add offset (* 2 n-word-bytes)) (inst stdf value-imag object offset) (unless (location= result-imag value-imag) - (move-double-reg result-imag value-imag))))) + (move-double-reg result-imag value-imag))))) #!+long-float (define-vop (data-vector-ref/simple-array-complex-long-float) @@ -560,7 +561,7 @@ (:translate data-vector-ref) (:policy :fast-safe) (:args (object :scs (descriptor-reg) :to :result) - (index :scs (any-reg))) + (index :scs (any-reg))) (:arg-types simple-array-complex-long-float positive-fixnum) (:results (value :scs (complex-long-reg))) (:result-types complex-long-float) @@ -569,7 +570,7 @@ (let ((real-tn (complex-long-reg-real-tn value))) (inst sll offset index 3) (inst add offset (- (* vector-data-offset n-word-bytes) - other-pointer-lowtag)) + other-pointer-lowtag)) (load-long-reg real-tn object offset nil)) (let ((imag-tn (complex-long-reg-imag-tn value))) (inst add offset (* 4 n-word-bytes)) @@ -581,110 +582,46 @@ (:translate data-vector-set) (:policy :fast-safe) (:args (object :scs (descriptor-reg) :to :result) - (index :scs (any-reg)) - (value :scs (complex-long-reg) :target result)) + (index :scs (any-reg)) + (value :scs (complex-long-reg) :target result)) (:arg-types simple-array-complex-long-float positive-fixnum - complex-long-float) + complex-long-float) (:results (result :scs (complex-long-reg))) (:result-types complex-long-float) (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) offset) (:generator 20 (let ((value-real (complex-long-reg-real-tn value)) - (result-real (complex-long-reg-real-tn result))) + (result-real (complex-long-reg-real-tn result))) (inst sll offset index 3) (inst add offset (- (* vector-data-offset n-word-bytes) - other-pointer-lowtag)) + other-pointer-lowtag)) (store-long-reg value-real object offset nil) (unless (location= result-real value-real) - (move-long-reg result-real value-real))) + (move-long-reg result-real value-real))) (let ((value-imag (complex-long-reg-imag-tn value)) - (result-imag (complex-long-reg-imag-tn result))) + (result-imag (complex-long-reg-imag-tn result))) (inst add offset (* 4 n-word-bytes)) (store-long-reg value-imag object offset nil) (unless (location= result-imag value-imag) - (move-long-reg result-imag value-imag))))) + (move-long-reg result-imag value-imag))))) -;;; These VOPs are used for implementing float slots in structures (whose raw -;;; data is an unsigned-32 vector. -;;; -(define-vop (raw-ref-single data-vector-ref/simple-array-single-float) - (:translate %raw-ref-single) - (:arg-types sb!c::raw-vector positive-fixnum)) -;;; -(define-vop (raw-set-single data-vector-set/simple-array-single-float) - (:translate %raw-set-single) - (:arg-types sb!c::raw-vector positive-fixnum single-float)) -;;; -(define-vop (raw-ref-double data-vector-ref/simple-array-double-float) - (:translate %raw-ref-double) - (:arg-types sb!c::raw-vector positive-fixnum)) -;;; -(define-vop (raw-set-double data-vector-set/simple-array-double-float) - (:translate %raw-set-double) - (:arg-types sb!c::raw-vector positive-fixnum double-float)) -;;; -#!+long-float -(define-vop (raw-ref-long data-vector-ref/simple-array-long-float) - (:translate %raw-ref-long) - (:arg-types sb!c::raw-vector positive-fixnum)) -;;; -#!+long-float -(define-vop (raw-set-double data-vector-set/simple-array-long-float) - (:translate %raw-set-long) - (:arg-types sb!c::raw-vector positive-fixnum long-float)) - -(define-vop (raw-ref-complex-single - data-vector-ref/simple-array-complex-single-float) - (:translate %raw-ref-complex-single) - (:arg-types sb!c::raw-vector positive-fixnum)) -;;; -(define-vop (raw-set-complex-single - data-vector-set/simple-array-complex-single-float) - (:translate %raw-set-complex-single) - (:arg-types sb!c::raw-vector positive-fixnum complex-single-float)) -;;; -(define-vop (raw-ref-complex-double - data-vector-ref/simple-array-complex-double-float) - (:translate %raw-ref-complex-double) - (:arg-types sb!c::raw-vector positive-fixnum)) -;;; -(define-vop (raw-set-complex-double - data-vector-set/simple-array-complex-double-float) - (:translate %raw-set-complex-double) - (:arg-types sb!c::raw-vector positive-fixnum complex-double-float)) -;;; -#!+long-float -(define-vop (raw-ref-complex-long - data-vector-ref/simple-array-complex-long-float) - (:translate %raw-ref-complex-long) - (:arg-types sb!c::raw-vector positive-fixnum)) -;;; -#!+long-float -(define-vop (raw-set-complex-long - data-vector-set/simple-array-complex-long-float) - (:translate %raw-set-complex-long) - (:arg-types sb!c::raw-vector positive-fixnum complex-long-float)) - - ;;; These vops are useful for accessing the bits of a vector irrespective of ;;; what type of vector it is. -;;; - -(define-vop (raw-bits word-index-ref) - (:note "raw-bits VOP") - (:translate %raw-bits) +(define-vop (vector-raw-bits word-index-ref) + (:note "vector-raw-bits VOP") + (:translate %vector-raw-bits) (:results (value :scs (unsigned-reg))) (:result-types unsigned-num) - (:variant 0 other-pointer-lowtag)) + (:variant vector-data-offset other-pointer-lowtag)) -(define-vop (set-raw-bits word-index-set) - (:note "setf raw-bits VOP") - (:translate %set-raw-bits) +(define-vop (set-vector-raw-bits word-index-set) + (:note "setf vector-raw-bits VOP") + (:translate %set-vector-raw-bits) (:args (object :scs (descriptor-reg)) - (index :scs (any-reg zero immediate)) - (value :scs (unsigned-reg))) + (index :scs (any-reg zero immediate)) + (value :scs (unsigned-reg))) (:arg-types * tagged-num unsigned-num) (:results (result :scs (unsigned-reg))) (:result-types unsigned-num) - (:variant 0 other-pointer-lowtag)) + (:variant vector-data-offset other-pointer-lowtag))