X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fppc%2Farray.lisp;h=37cf6ea16841d7d352af936b3253c7301b6e3781;hb=5745b5a5b2e3b967bf3876b4306f31b3c78495fa;hp=8239a8f0822c1894a3cc6c8381789728374d9e3d;hpb=cab2c71bb1bb8a575d9eebdae335e731daa64183;p=sbcl.git diff --git a/src/compiler/ppc/array.lisp b/src/compiler/ppc/array.lisp index 8239a8f..37cf6ea 100644 --- a/src/compiler/ppc/array.lisp +++ b/src/compiler/ppc/array.lisp @@ -1,6 +1,14 @@ -;;; -;;; Written by William Lott -;;; +;;;; array operations for the PPC VM + +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; This software is derived from the CMU CL system, which was +;;;; written at Carnegie Mellon University and released into the +;;;; public domain. The software is in the public domain and is +;;;; provided with absolutely no warranty. See the COPYING and CREDITS +;;;; files for more information. + (in-package "SB!VM") @@ -10,60 +18,52 @@ (: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) sb!vm: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) - (inst addi ndescr rank (fixnumize (1- sb!vm:array-dimensions-offset))) - (inst slwi ndescr ndescr sb!vm:n-widetag-bits) + (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) - (storew ndescr header 0 sb!vm:other-pointer-lowtag)) + (inst srwi ndescr ndescr n-fixnum-tag-bits) + (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)) - (inst slwi res temp 2))) - - + (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 n-fixnum-tag-bits))) ;;;; Bounds checking routine. @@ -72,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)))) @@ -94,227 +94,235 @@ (macrolet ((def-data-vector-frobs (type variant element-type &rest scs) `(progn - (define-vop (,(intern (concatenate 'simple-string - "DATA-VECTOR-REF/" - (string type))) - ,(intern (concatenate 'simple-string - (string variant) - "-REF"))) + (define-vop (,(symbolicate "DATA-VECTOR-REF/" (string type)) + ,(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 (,(intern (concatenate 'simple-string - "DATA-VECTOR-SET/" - (string type))) - ,(intern (concatenate 'simple-string - (string variant) - "-SET"))) + (define-vop (,(symbolicate "DATA-VECTOR-SET/" (string type)) + ,(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-string byte-index - base-char base-char-reg) + (def-data-vector-frobs simple-base-string byte-index + 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 positive-fixnum unsigned-reg) + (def-data-vector-frobs simple-array-unsigned-byte-15 halfword-index + positive-fixnum unsigned-reg) (def-data-vector-frobs simple-array-unsigned-byte-16 halfword-index positive-fixnum unsigned-reg) + (def-data-vector-frobs simple-array-unsigned-byte-31 word-index + 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 tagged-num any-reg) (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 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 + ;; 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 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 - (logxor (* extra ,bits) ,(1- elements-per-word)))) - (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 + ;; 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 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 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 (- (* 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))) @@ -323,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 - (- (* 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)))) @@ -342,15 +350,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) @@ -358,16 +366,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)))) @@ -380,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,11 +396,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) @@ -400,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 (- (* 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) @@ -429,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,11 +445,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) @@ -449,95 +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 (- (* 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 -;;; data is an unsigned-32 vector. -;;; -(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)) -;;; -(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)) -;;; -(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)) -;;; -(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)) - -(define-vop (raw-ref-complex-single - data-vector-ref/simple-array-complex-single-float) - (:translate %raw-ref-complex-single) - (:arg-types simple-array-unsigned-byte-32 positive-fixnum)) -;;; -(define-vop (raw-set-complex-single - 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)) -;;; -(define-vop (raw-ref-complex-double - data-vector-ref/simple-array-complex-double-float) - (:translate %raw-ref-complex-double) - (:arg-types simple-array-unsigned-byte-32 positive-fixnum)) -;;; -(define-vop (raw-set-complex-double - 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)) - - ;;; 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 sb!vm: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 sb!vm:other-pointer-lowtag)) - - + (:variant vector-data-offset other-pointer-lowtag)) ;;;; Misc. Array VOPs. @@ -558,7 +522,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))) @@ -566,19 +530,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))) @@ -586,12 +550,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))