X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fppc%2Farray.lisp;h=37cf6ea16841d7d352af936b3253c7301b6e3781;hb=5745b5a5b2e3b967bf3876b4306f31b3c78495fa;hp=6eaef08fff924495691f730cef830d3e943e70d6;hpb=bf27595fb567015495b7131707cc85af361567fe;p=sbcl.git diff --git a/src/compiler/ppc/array.lisp b/src/compiler/ppc/array.lisp index 6eaef08..37cf6ea 100644 --- a/src/compiler/ppc/array.lisp +++ b/src/compiler/ppc/array.lisp @@ -18,22 +18,26 @@ (: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) (:temporary (:scs (non-descriptor-reg)) ndescr) + (:temporary (:scs (non-descriptor-reg)) gc-temp) + #!-gencgc (:ignore gc-temp) (:results (result :scs (descriptor-reg))) (:generator 0 (pseudo-atomic (pa-flag) - (inst ori header alloc-tn other-pointer-lowtag) - (inst addi ndescr rank (* (1+ array-dimensions-offset) n-word-bytes)) + (inst addi ndescr rank (+ (* (1+ array-dimensions-offset) n-word-bytes) + lowtag-mask)) (inst clrrwi ndescr ndescr n-lowtag-bits) - (inst add alloc-tn alloc-tn ndescr) + (allocation header ndescr other-pointer-lowtag + :temp-tn gc-temp + :flag-tn pa-flag) (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) + (inst srwi ndescr ndescr n-fixnum-tag-bits) (storew ndescr header 0 other-pointer-lowtag)) (move result header))) @@ -59,7 +63,7 @@ (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))) + (inst slwi res temp n-fixnum-tag-bits))) ;;;; Bounds checking routine. @@ -68,14 +72,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))) + (let ((error (generate-error-code vop 'invalid-array-index-error + array bound index))) (inst cmplw index bound) (inst bge error) (move result index)))) @@ -91,7 +95,7 @@ (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) @@ -99,14 +103,14 @@ (: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 @@ -128,7 +132,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 @@ -136,184 +140,189 @@ (def-data-vector-frobs simple-array-signed-byte-32 word-index signed-num signed-reg)) +#!+compare-and-swap-vops +(define-vop (%compare-and-swap-svref word-index-cas) + (:note "inline array compare-and-swap") + (:policy :fast-safe) + (:variant vector-data-offset other-pointer-lowtag) + (:translate %compare-and-swap-svref) + (:arg-types simple-vector positive-fixnum * *)) ;;; 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 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 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))) + (: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 + ;; temp = (index >> bit-shift) << 2) + (inst rlwinm temp index ,(- 32 (- bit-shift 2)) ,(- bit-shift 2) 29) + (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 n-fixnum-tag-bits))) (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 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))))))) + (: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 (- (* 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))))) + (: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 + ;; offset = (index >> bit-shift) << 2) + (inst rlwinm offset index ,(- 32 (- bit-shift 2)) ,(- bit-shift 2) 29) + (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 andc 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 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)))))))))) + (: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 clrlwi 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 (- (* vector-data-offset n-word-bytes) - other-pointer-lowtag)) + other-pointer-lowtag)) (inst lfsx value object offset))) @@ -322,16 +331,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 - (- (* vector-data-offset n-word-bytes) - 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)))) @@ -341,7 +350,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) @@ -349,7 +358,7 @@ (:generator 7 (inst slwi offset index 1) (inst addi offset offset (- (* vector-data-offset n-word-bytes) - other-pointer-lowtag)) + other-pointer-lowtag)) (inst lfdx value object offset))) (define-vop (data-vector-set/simple-array-double-float) @@ -357,8 +366,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) @@ -366,7 +375,7 @@ (:generator 20 (inst slwi offset index 1) (inst addi offset offset (- (* vector-data-offset n-word-bytes) - other-pointer-lowtag)) + other-pointer-lowtag)) (inst stfdx value object offset) (unless (location= result value) (inst fmr result value)))) @@ -379,7 +388,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) @@ -388,7 +397,7 @@ (let ((real-tn (complex-single-reg-real-tn value))) (inst slwi offset index 1) (inst addi offset offset (- (* vector-data-offset n-word-bytes) - other-pointer-lowtag)) + other-pointer-lowtag)) (inst lfsx real-tn object offset)) (let ((imag-tn (complex-single-reg-imag-tn value))) (inst addi offset offset n-word-bytes) @@ -399,28 +408,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 (- (* vector-data-offset n-word-bytes) - other-pointer-lowtag)) + 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))) + (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) @@ -428,7 +437,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) @@ -437,7 +446,7 @@ (let ((real-tn (complex-double-reg-real-tn value))) (inst slwi offset index 2) (inst addi offset offset (- (* vector-data-offset n-word-bytes) - other-pointer-lowtag)) + other-pointer-lowtag)) (inst lfdx real-tn object offset)) (let ((imag-tn (complex-double-reg-imag-tn value))) (inst addi offset offset (* 2 n-word-bytes)) @@ -448,93 +457,51 @@ (: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 (- (* vector-data-offset n-word-bytes) - other-pointer-lowtag)) + 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))) + (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 -;;; 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)) - -(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)) - - ;;; 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 * positive-fixnum unsigned-num) (:results (result :scs (unsigned-reg))) (:result-types unsigned-num) - (:variant 0 other-pointer-lowtag)) - - + (:variant vector-data-offset other-pointer-lowtag)) ;;;; Misc. Array VOPs. @@ -567,13 +534,13 @@ (: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) @@ -587,8 +554,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))