X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fppc%2Farray.lisp;h=16b4f0614c29270ea1d6a10b792a2d69d882fd9d;hb=d604a358d8e5eb5587989e0a4f1d31dbe6ac5ffe;hp=a00f0adfde33b70e418b41b569a8bdc1f81859f1;hpb=fc999187f3f80dfcf170348df676386b8403e261;p=sbcl.git diff --git a/src/compiler/ppc/array.lisp b/src/compiler/ppc/array.lisp index a00f0ad..16b4f06 100644 --- a/src/compiler/ppc/array.lisp +++ b/src/compiler/ppc/array.lisp @@ -18,7 +18,7 @@ (: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 (:sc non-descriptor-reg :offset nl3-offset) pa-flag) @@ -27,51 +27,39 @@ (:generator 0 (pseudo-atomic (pa-flag) (inst ori header alloc-tn other-pointer-lowtag) - (inst addi ndescr rank (* (1+ array-dimensions-offset) sb!vm:n-word-bytes)) + (inst addi ndescr rank (* (1+ array-dimensions-offset) n-word-bytes)) (inst clrrwi ndescr ndescr n-lowtag-bits) (inst add alloc-tn alloc-tn ndescr) - (inst addi ndescr rank (fixnumize (1- sb!vm:array-dimensions-offset))) - (inst slwi ndescr ndescr sb!vm:n-widetag-bits) + (inst addi ndescr rank (fixnumize (1- array-dimensions-offset))) + (inst slwi ndescr ndescr n-widetag-bits) (inst or ndescr ndescr type) (inst srwi ndescr ndescr 2) - (storew ndescr header 0 sb!vm:other-pointer-lowtag)) + (storew ndescr header 0 other-pointer-lowtag)) (move result header))) ;;;; Additional accessors and setters for the array header. - -(defknown sb!impl::%array-dimension (t fixnum) fixnum - (flushable)) -(defknown sb!impl::%set-array-dimension (t fixnum fixnum) fixnum - ()) - (define-vop (%array-dimension word-index-ref) - (:translate sb!impl::%array-dimension) + (:translate sb!kernel:%array-dimension) (:policy :fast-safe) - (:variant sb!vm:array-dimensions-offset sb!vm:other-pointer-lowtag)) + (:variant array-dimensions-offset other-pointer-lowtag)) (define-vop (%set-array-dimension word-index-set) - (:translate sb!impl::%set-array-dimension) + (:translate sb!kernel:%set-array-dimension) (:policy :fast-safe) - (:variant sb!vm:array-dimensions-offset sb!vm:other-pointer-lowtag)) - - - -(defknown sb!impl::%array-rank (t) fixnum (flushable)) + (:variant array-dimensions-offset other-pointer-lowtag)) (define-vop (array-rank-vop) - (:translate sb!impl::%array-rank) + (:translate sb!kernel:%array-rank) (:policy :fast-safe) (:args (x :scs (descriptor-reg))) (:temporary (:scs (non-descriptor-reg)) temp) (:results (res :scs (any-reg descriptor-reg))) (:generator 6 - (loadw temp x 0 sb!vm:other-pointer-lowtag) - (inst srawi temp temp sb!vm:n-widetag-bits) - (inst subi temp temp (1- sb!vm:array-dimensions-offset)) + (loadw temp x 0 other-pointer-lowtag) + (inst srawi temp temp n-widetag-bits) + (inst subi temp temp (1- array-dimensions-offset)) (inst slwi res temp 2))) - - ;;;; Bounds checking routine. @@ -80,14 +68,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 cmplw index bound) (inst bge error) (move result index)))) @@ -103,29 +91,31 @@ (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 sb!vm:vector-data-offset sb!vm:other-pointer-lowtag) + (:variant vector-data-offset other-pointer-lowtag) (:translate data-vector-ref) (:arg-types ,type positive-fixnum) (: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 sb!vm:vector-data-offset sb!vm:other-pointer-lowtag) + (: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) - (def-data-vector-frobs simple-array-unsigned-byte-7 byte-index positive-fixnum unsigned-reg) (def-data-vector-frobs simple-array-unsigned-byte-8 byte-index @@ -138,7 +128,7 @@ unsigned-num unsigned-reg) (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 positive-fixnum any-reg) (def-data-vector-frobs simple-array-signed-byte-30 word-index @@ -149,181 +139,181 @@ ;;; Integer vectors whos elements are smaller than a byte. I.e. bit, 2-bit, ;;; and 4-bit vectors. -;;; +;;; (macrolet ((def-small-data-vector-frobs (type bits) - (let* ((elements-per-word (floor sb!vm:n-word-bits bits)) - (bit-shift (1- (integer-length elements-per-word)))) + (let* ((elements-per-word (floor n-word-bits bits)) + (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 srwi temp index ,bit-shift) - (inst slwi temp temp 2) - (inst addi temp temp (- (* sb!vm:vector-data-offset sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag)) - (inst lwzx result object temp) - (inst andi. temp index ,(1- elements-per-word)) - (inst xori temp temp ,(1- elements-per-word)) - ,@(unless (= bits 1) - `((inst slwi temp temp ,(1- (integer-length bits))))) - (inst srw result result temp) - (inst andi. result result ,(1- (ash 1 bits))) - (inst slwi 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 srwi temp index ,bit-shift) + (inst slwi temp temp 2) + (inst addi temp temp (- (* vector-data-offset n-word-bytes) + other-pointer-lowtag)) + (inst lwzx result object temp) + (inst andi. temp index ,(1- elements-per-word)) + (inst xori temp temp ,(1- elements-per-word)) + ,@(unless (= bits 1) + `((inst slwi temp temp ,(1- (integer-length bits))))) + (inst srw result result temp) + (inst andi. result result ,(1- (ash 1 bits))) + (inst slwi 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) - (floor index ,elements-per-word) - (setf extra (logxor extra (1- ,elements-per-word))) - (let ((offset (- (* (+ word sb!vm:vector-data-offset) - sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag))) - (cond ((typep offset '(signed-byte 16)) - (inst lwz result object offset)) - (t - (inst lr temp offset) - (inst lwzx result object temp)))) - (unless (zerop extra) - (inst srwi result result (* ,bits extra))) - (unless (= extra ,(1- elements-per-word)) - (inst andi. result result ,(1- (ash 1 bits))))))) + (: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 16)) + (inst lwz result object offset)) + (t + (inst lr temp offset) + (inst lwzx result object temp)))) + (unless (zerop extra) + (inst srwi result result (* ,bits extra))) + (unless (= extra ,(1- elements-per-word)) + (inst andi. result 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 srwi offset index ,bit-shift) - (inst slwi offset offset 2) - (inst addi offset offset (- (* sb!vm:vector-data-offset sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag)) - (inst lwzx old object offset) - (inst andi. shift index ,(1- elements-per-word)) - (inst xori shift shift ,(1- elements-per-word)) - ,@(unless (= bits 1) - `((inst slwi shift shift ,(1- (integer-length bits))))) - (unless (and (sc-is value immediate) - (= (tn-value value) ,(1- (ash 1 bits)))) - (inst lr temp ,(1- (ash 1 bits))) - (inst slw temp temp shift) - (inst not temp temp) - (inst and old old temp)) - (unless (sc-is value zero) - (sc-case value - (immediate - (inst lr temp (logand (tn-value value) ,(1- (ash 1 bits))))) - (unsigned-reg - (inst andi. temp value ,(1- (ash 1 bits))))) - (inst slw temp temp shift) - (inst or old old temp)) - (inst stwx old object offset) - (sc-case value - (immediate - (inst lr 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 srwi offset index ,bit-shift) + (inst slwi offset offset 2) + (inst addi offset offset (- (* vector-data-offset n-word-bytes) + other-pointer-lowtag)) + (inst lwzx old object offset) + (inst andi. shift index ,(1- elements-per-word)) + (inst xori shift shift ,(1- elements-per-word)) + ,@(unless (= bits 1) + `((inst slwi shift shift ,(1- (integer-length bits))))) + (unless (and (sc-is value immediate) + (= (tn-value value) ,(1- (ash 1 bits)))) + (inst lr temp ,(1- (ash 1 bits))) + (inst slw temp temp shift) + (inst not temp temp) + (inst and old old temp)) + (unless (sc-is value zero) + (sc-case value + (immediate + (inst lr temp (logand (tn-value value) ,(1- (ash 1 bits))))) + (unsigned-reg + (inst andi. temp value ,(1- (ash 1 bits))))) + (inst slw temp temp shift) + (inst or old old temp)) + (inst stwx old object offset) + (sc-case value + (immediate + (inst lr 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 sb!vm:vector-data-offset) sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag))) - (cond ((typep offset '(signed-byte 16)) - (inst lwz old object offset)) - (t - (inst lr offset-reg offset) - (inst lwzx old object offset-reg))) - (unless (and (sc-is value immediate) - (= (tn-value value) ,(1- (ash 1 bits)))) - (cond ((zerop extra) - (inst slwi old old ,bits) - (inst srwi old old ,bits)) - (t - (inst lr temp - (lognot (ash ,(1- (ash 1 bits)) - (* (logxor extra - ,(1- elements-per-word)) - ,bits)))) - (inst and old 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 '(unsigned-byte 16)) - (inst ori old old value)) - (t - (inst lr temp value) - (inst or old old temp))))) - (unsigned-reg - (inst slwi temp value - (* (logxor extra ,(1- elements-per-word)) ,bits)) - (inst or old old temp))) - (if (typep offset '(signed-byte 16)) - (inst stw old object offset) - (inst stwx old object offset-reg))) - (sc-case value - (immediate - (inst lr 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 16)) + (inst lwz old object offset)) + (t + (inst lr offset-reg offset) + (inst lwzx old object offset-reg))) + (unless (and (sc-is value immediate) + (= (tn-value value) ,(1- (ash 1 bits)))) + (cond ((zerop extra) + (inst slwi old old ,bits) + (inst srwi old old ,bits)) + (t + (inst lr temp + (lognot (ash ,(1- (ash 1 bits)) + (* (logxor extra + ,(1- elements-per-word)) + ,bits)))) + (inst and old 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 '(unsigned-byte 16)) + (inst ori old old value)) + (t + (inst lr temp value) + (inst or old old temp))))) + (unsigned-reg + (inst slwi temp value + (* (logxor extra ,(1- elements-per-word)) ,bits)) + (inst or old old temp))) + (if (typep offset '(signed-byte 16)) + (inst stw old object offset) + (inst stwx old object offset-reg))) + (sc-case value + (immediate + (inst lr 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) (def-small-data-vector-frobs simple-array-unsigned-byte-4 4)) ;;; And the float variants. -;;; +;;; (define-vop (data-vector-ref/simple-array-single-float) (:note "inline array access") (: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 addi offset index (- (* sb!vm:vector-data-offset sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag)) + (inst addi offset index (- (* vector-data-offset n-word-bytes) + other-pointer-lowtag)) (inst lfsx value object offset))) @@ -332,16 +322,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 addi offset index - (- (* sb!vm:vector-data-offset sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag)) + (- (* vector-data-offset n-word-bytes) + other-pointer-lowtag)) (inst stfsx value object offset) (unless (location= result value) (inst frsp result value)))) @@ -351,15 +341,15 @@ (: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) (:temporary (:scs (non-descriptor-reg)) offset) (:generator 7 (inst slwi offset index 1) - (inst addi offset offset (- (* sb!vm:vector-data-offset sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag)) + (inst addi offset offset (- (* vector-data-offset n-word-bytes) + other-pointer-lowtag)) (inst lfdx value object offset))) (define-vop (data-vector-set/simple-array-double-float) @@ -367,16 +357,16 @@ (: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) (:temporary (:scs (non-descriptor-reg)) offset) (:generator 20 (inst slwi offset index 1) - (inst addi offset offset (- (* sb!vm:vector-data-offset sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag)) + (inst addi offset offset (- (* vector-data-offset n-word-bytes) + other-pointer-lowtag)) (inst stfdx value object offset) (unless (location= result value) (inst fmr result value)))) @@ -389,7 +379,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-complex-single-float positive-fixnum) (:results (value :scs (complex-single-reg))) (:temporary (:scs (non-descriptor-reg) :from (:argument 1)) offset) @@ -397,11 +387,11 @@ (:generator 5 (let ((real-tn (complex-single-reg-real-tn value))) (inst slwi offset index 1) - (inst addi offset offset (- (* sb!vm:vector-data-offset sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag)) + (inst addi offset offset (- (* vector-data-offset n-word-bytes) + other-pointer-lowtag)) (inst lfsx real-tn object offset)) (let ((imag-tn (complex-single-reg-imag-tn value))) - (inst addi offset offset sb!vm:n-word-bytes) + (inst addi offset offset n-word-bytes) (inst lfsx imag-tn object offset)))) (define-vop (data-vector-set/simple-array-complex-single-float) @@ -409,28 +399,28 @@ (:translate data-vector-set) (:policy :fast-safe) (:args (object :scs (descriptor-reg)) - (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 slwi offset index 1) - (inst addi offset offset (- (* sb!vm:vector-data-offset sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag)) + (inst addi offset offset (- (* vector-data-offset n-word-bytes) + other-pointer-lowtag)) (inst stfsx value-real object offset) (unless (location= result-real value-real) - (inst frsp result-real value-real))) + (inst frsp result-real value-real))) (let ((value-imag (complex-single-reg-imag-tn value)) - (result-imag (complex-single-reg-imag-tn result))) - (inst addi offset offset sb!vm:n-word-bytes) + (result-imag (complex-single-reg-imag-tn result))) + (inst addi offset offset n-word-bytes) (inst stfsx value-imag object offset) (unless (location= result-imag value-imag) - (inst frsp result-imag value-imag))))) + (inst frsp result-imag value-imag))))) (define-vop (data-vector-ref/simple-array-complex-double-float) @@ -438,7 +428,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-double-float positive-fixnum) (:results (value :scs (complex-double-reg))) (:result-types complex-double-float) @@ -446,11 +436,11 @@ (:generator 7 (let ((real-tn (complex-double-reg-real-tn value))) (inst slwi offset index 2) - (inst addi offset offset (- (* sb!vm:vector-data-offset sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag)) + (inst addi offset offset (- (* vector-data-offset n-word-bytes) + other-pointer-lowtag)) (inst lfdx real-tn object offset)) (let ((imag-tn (complex-double-reg-imag-tn value))) - (inst addi offset offset (* 2 sb!vm:n-word-bytes)) + (inst addi offset offset (* 2 n-word-bytes)) (inst lfdx imag-tn object offset)))) (define-vop (data-vector-set/simple-array-complex-double-float) @@ -458,28 +448,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 slwi offset index 2) - (inst addi offset offset (- (* sb!vm:vector-data-offset sb!vm:n-word-bytes) - sb!vm:other-pointer-lowtag)) + (inst addi offset offset (- (* vector-data-offset n-word-bytes) + other-pointer-lowtag)) (inst stfdx value-real object offset) (unless (location= result-real value-real) - (inst fmr result-real value-real))) + (inst fmr result-real value-real))) (let ((value-imag (complex-double-reg-imag-tn value)) - (result-imag (complex-double-reg-imag-tn result))) - (inst addi offset offset (* 2 sb!vm:n-word-bytes)) + (result-imag (complex-double-reg-imag-tn result))) + (inst addi offset offset (* 2 n-word-bytes)) (inst stfdx value-imag object offset) (unless (location= result-imag value-imag) - (inst fmr result-imag value-imag))))) + (inst fmr result-imag value-imag))))) ;;; These VOPs are used for implementing float slots in structures (whose raw @@ -487,66 +477,80 @@ ;;; (define-vop (raw-ref-single data-vector-ref/simple-array-single-float) (:translate %raw-ref-single) - (:arg-types simple-array-unsigned-byte-32 positive-fixnum)) + (: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 simple-array-unsigned-byte-32 positive-fixnum single-float)) + (: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 simple-array-unsigned-byte-32 positive-fixnum)) + (: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 simple-array-unsigned-byte-32 positive-fixnum double-float)) + (:arg-types sb!c::raw-vector positive-fixnum double-float)) (define-vop (raw-ref-complex-single - data-vector-ref/simple-array-complex-single-float) + data-vector-ref/simple-array-complex-single-float) (:translate %raw-ref-complex-single) - (:arg-types simple-array-unsigned-byte-32 positive-fixnum)) + (:arg-types sb!c::raw-vector positive-fixnum)) ;;; (define-vop (raw-set-complex-single - data-vector-set/simple-array-complex-single-float) + data-vector-set/simple-array-complex-single-float) (:translate %raw-set-complex-single) - (:arg-types simple-array-unsigned-byte-32 positive-fixnum - complex-single-float)) + (: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) + data-vector-ref/simple-array-complex-double-float) (:translate %raw-ref-complex-double) - (:arg-types simple-array-unsigned-byte-32 positive-fixnum)) + (:arg-types sb!c::raw-vector positive-fixnum)) ;;; (define-vop (raw-set-complex-double - data-vector-set/simple-array-complex-double-float) + data-vector-set/simple-array-complex-double-float) (:translate %raw-set-complex-double) - (:arg-types simple-array-unsigned-byte-32 positive-fixnum - complex-double-float)) + (:arg-types sb!c::raw-vector positive-fixnum complex-double-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) (:results (value :scs (unsigned-reg))) (:result-types unsigned-num) - (:variant 0 sb!vm:other-pointer-lowtag)) + (:variant 0 other-pointer-lowtag)) (define-vop (set-raw-bits word-index-set) (:note "setf raw-bits VOP") (:translate %set-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 * positive-fixnum unsigned-num) (:results (result :scs (unsigned-reg))) (:result-types unsigned-num) - (:variant 0 sb!vm:other-pointer-lowtag)) + (:variant 0 other-pointer-lowtag)) +(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 vector-data-offset other-pointer-lowtag)) +(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))) + (:arg-types * positive-fixnum unsigned-num) + (:results (result :scs (unsigned-reg))) + (:result-types unsigned-num) + (:variant vector-data-offset other-pointer-lowtag)) ;;;; Misc. Array VOPs. @@ -567,7 +571,7 @@ (define-vop (data-vector-ref/simple-array-signed-byte-8 signed-byte-index-ref) (:note "inline array access") - (:variant sb!vm:vector-data-offset sb!vm:other-pointer-lowtag) + (:variant vector-data-offset other-pointer-lowtag) (:translate data-vector-ref) (:arg-types simple-array-signed-byte-8 positive-fixnum) (:results (value :scs (signed-reg))) @@ -575,19 +579,19 @@ (define-vop (data-vector-set/simple-array-signed-byte-8 byte-index-set) (:note "inline array store") - (:variant sb!vm:vector-data-offset sb!vm:other-pointer-lowtag) + (:variant vector-data-offset other-pointer-lowtag) (: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 sb!vm:vector-data-offset sb!vm:other-pointer-lowtag) + (:variant vector-data-offset other-pointer-lowtag) (:translate data-vector-ref) (:arg-types simple-array-signed-byte-16 positive-fixnum) (:results (value :scs (signed-reg))) @@ -595,12 +599,12 @@ (define-vop (data-vector-set/simple-array-signed-byte-16 halfword-index-set) (:note "inline array store") - (:variant sb!vm:vector-data-offset sb!vm:other-pointer-lowtag) + (:variant vector-data-offset other-pointer-lowtag) (: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))