Index: /trunk/ccl/compiler/PPC/ppc2.lisp =================================================================== --- /trunk/ccl/compiler/PPC/ppc2.lisp (revision 5500) +++ /trunk/ccl/compiler/PPC/ppc2.lisp (revision 5501) @@ -1545,13 +1545,16 @@ -(defun ppc2-aset2 (seg target array i j new safe typename &optional dim0 dim1) - (with-ppc-local-vinsn-macros (seg target) +(defun ppc2-aset2 (seg vreg xfer array i j new safe type-keyword dim0 dim1) + (with-ppc-local-vinsn-macros (seg vreg xfer) (let* ((i-known-fixnum (acode-fixnum-form-p i)) (j-known-fixnum (acode-fixnum-form-p j)) (arch (backend-target-arch *target-backend*)) + (is-node (member type-keyword (arch::target-gvector-types arch))) + (constval (ppc2-constant-value-ok-for-type-keyword type-keyword new)) + (needs-memoization (and is-node (ppc2-acode-needs-memoization new))) (src) (unscaled-i) (unscaled-j) - (need-scale t) + (val-reg (ppc2-target-reg-for-aset vreg type-keyword)) (constidx (and dim0 dim1 i-known-fixnum j-known-fixnum @@ -1563,57 +1566,34 @@ (progn (if constidx - (multiple-value-setq (src target) - (ppc2-two-targeted-reg-forms seg array ($ ppc::arg_z) new target)) - (multiple-value-setq (src unscaled-i unscaled-j target) + (multiple-value-setq (src val-reg) + (ppc2-two-targeted-reg-forms seg array ($ ppc::temp0) new val-reg)) + (multiple-value-setq (src unscaled-i unscaled-j val-reg) (ppc2-four-untargeted-reg-forms seg - array ($ ppc::arg_x) - i ($ ppc::arg_y) - j ($ ppc::arg_z) - new target))) + array ($ ppc::temp0) + i ($ ppc::arg_x) + j ($ ppc::arg_y) + new val-reg))) (when safe (when (typep safe 'fixnum) - (! trap-unless-array-header src) - (! check-arrayH-rank src 2) - (! check-arrayH-flags src - (dpb safe target::arrayh.flags-cell-subtag-byte - (ash 1 $arh_simple_bit)))) + (! trap-unless-simple-array-2 + src + (dpb safe target::arrayH.flags-cell-subtag-byte + (ash 1 $arh_simple_bit)) + (nx-error-for-simple-2d-array-type type-keyword))) (unless i-known-fixnum (! trap-unless-fixnum unscaled-i)) (unless j-known-fixnum (! trap-unless-fixnum unscaled-j))) - (with-imm-temps () (dim1 idx-reg) - (unless constidx - (if safe - (! check-2d-bound dim1 unscaled-i unscaled-j src) - (! 2d-dim1 dim1 src)) - (! 2d-unscaled-index idx-reg src unscaled-i unscaled-j dim1)) - (with-node-temps () (v) - (let* ((bias (arch::target-misc-data-offset arch))) + (with-imm-target () dim1 + (let* ((idx-reg ($ ppc::arg_y))) + (unless constidx + (if safe + (! check-2d-bound dim1 unscaled-i unscaled-j src) + (! 2d-dim1 dim1 src)) + (! 2d-unscaled-index idx-reg dim1 unscaled-i unscaled-j)) + (let* ((v ($ ppc::arg_x))) (! array-data-vector-ref v src) - (multiple-value-bind (shift limit) - (case typename - (:double-float-vector - (setq bias (arch::target-misc-dfloat-offset arch)) - (values 3 (arch::target-max-64-bit-constant-index arch))) - (:single-float-vector - (values 2 (arch::target-max-32-bit-constant-index arch)))) - (when (and constidx (>= constidx limit)) - (ppc2-absolute-natural seg idx-reg nil (+ bias - (ash constidx shift))) - (setq constidx nil need-scale nil))) - (case typename - (:double-float-vector - (if constidx - (! misc-set-c-double-float target v constidx) - (progn - (when need-scale (! scale-64bit-misc-index idx-reg idx-reg)) - (! misc-set-double-float target v idx-reg)))) - (:single-float-vector - (if constidx - (! misc-set-c-single-float target v constidx) - (progn - (when need-scale (! scale-32bit-misc-index idx-reg idx-reg)) - (! misc-set-single-float target v idx-reg))))))))))) - target) + (ppc2-vset1 seg vreg xfer type-keyword v idx-reg constidx val-reg (ppc2-unboxed-reg-for-aset seg type-keyword val-reg safe constval) constval needs-memoization)))))))) + (defun ppc2-aref2 (seg vreg xfer array i j safe typekeyword &optional dim0 dim1) @@ -1661,45 +1641,4 @@ -(defun ppc2-natural-vset (seg vreg xfer vector index value safe) - (with-ppc-local-vinsn-macros (seg vreg xfer) - (let* ((index-known-fixnum (acode-fixnum-form-p index)) - (arch (backend-target-arch *target-backend*)) - (src nil) - (unscaled-idx nil)) - (with-imm-target () (target :natural) - (if (or safe (not index-known-fixnum)) - (multiple-value-setq (src unscaled-idx target) - (ppc2-three-untargeted-reg-forms seg vector ppc::arg_y index ppc::arg_z value (or vreg target))) - (multiple-value-setq (src target) - (ppc2-two-untargeted-reg-forms seg vector ppc::arg_y value (or vreg target)))) - (when safe - (with-imm-temps (target) () ; Don't use target in type/bounds check - (if (typep safe 'fixnum) - (! trap-unless-typecode= src safe)) - (unless index-known-fixnum - (! trap-unless-fixnum unscaled-idx)) - (! check-misc-bound unscaled-idx src))) - (target-arch-case - (:ppc32 - (if (and index-known-fixnum - (<= index-known-fixnum (arch::target-max-32-bit-constant-index arch))) - (! misc-set-c-u32 target src index-known-fixnum) - (with-imm-temps (target) (idx-reg) - (if index-known-fixnum - (ppc2-absolute-natural seg idx-reg nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 2))) - (! scale-32bit-misc-index idx-reg unscaled-idx)) - (! misc-set-u32 target src idx-reg)))) - (:ppc64 - (if (and index-known-fixnum - (<= index-known-fixnum (arch::target-max-64-bit-constant-index arch))) - (! misc-set-c-u64 target src index-known-fixnum) - (with-imm-temps (target) (idx-reg) - (if index-known-fixnum - (ppc2-absolute-natural seg idx-reg nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 3))) - (! scale-64bit-misc-index idx-reg unscaled-idx)) - (! misc-set-u64 target src idx-reg))))) - (<- target) ; should be a no-op in this case - (^))))) - (defun ppc2-constant-value-ok-for-type-keyword (type-keyword form) @@ -1728,5 +1667,5 @@ (if typep val)))) -(defun ppc2-vset (seg vreg xfer type-keyword vector index value safe) +(defun ppc2-target-reg-for-aset (vreg type-keyword) (let* ((arch (backend-target-arch *target-backend*)) (is-node (member type-keyword (arch::target-gvector-types arch))) @@ -1735,277 +1674,362 @@ (is-16-bit (member type-keyword (arch::target-16-bit-ivector-types arch))) (is-32-bit (member type-keyword (arch::target-32-bit-ivector-types arch))) - (is-64-bit (member type-keyword (arch::target-64-bit-ivector-types arch)))) - (if is-node - (ppc2-misc-node-set seg vreg xfer vector index value safe) - (let* ((vreg-class (if vreg (hard-regspec-class vreg))) - (vreg-mode - (if (and vreg-class (= vreg-class hard-reg-class-gpr)) - (get-regspec-mode vreg) - hard-reg-class-gpr-mode-invalid))) - (declare (fixnum vreg-class vreg-mode)) - (if (and (eq type-keyword :double-float-vector) - (or (null vreg) (eql vreg-class hard-reg-class-fpr))) - (ppc2-df-vset seg vreg xfer vector index value safe) - (if (and (eq type-keyword :single-float-vector) - (or (null vreg) (eql vreg-class hard-reg-class-fpr))) - (ppc2-sf-vset seg vreg xfer vector index value safe) - (if (target-arch-case - (:ppc32 (and (eq type-keyword :unsigned-32-bit-vector) - (or (null vreg) (eql vreg-mode hard-reg-class-gpr-mode-u32)))) - (:ppc64 (and (eq type-keyword :unsigned-64-bit-vector) - (or (null vreg) (eql vreg-mode hard-reg-class-gpr-mode-u64))))) - (ppc2-natural-vset seg vreg xfer vector index value safe) - (with-ppc-local-vinsn-macros (seg vreg xfer) - (let* ((index-known-fixnum (acode-fixnum-form-p index)) - (constval (ppc2-constant-value-ok-for-type-keyword type-keyword value)) - (need-val-reg (or vreg (not constval))) - (unscaled-idx nil) - (idx-reg nil) - (val-reg) - (src nil)) - (if (or safe (not index-known-fixnum)) - (if need-val-reg - (multiple-value-setq (src unscaled-idx val-reg) - (ppc2-three-untargeted-reg-forms seg vector ppc::arg_x index ppc::arg_y value ppc::arg_z)) - (multiple-value-setq (src unscaled-idx) - (ppc2-two-untargeted-reg-forms seg vector ppc::arg_y index ppc::arg_z))) - (if need-val-reg - (multiple-value-setq (src val-reg) - (ppc2-two-untargeted-reg-forms seg vector ppc::arg_y value ppc::arg_z)) - (setq src (ppc2-one-untargeted-reg-form seg vector ppc::arg_z)))) - (when safe - (if (typep safe 'fixnum) - (! trap-unless-typecode= src safe)) - (unless index-known-fixnum - (! trap-unless-fixnum unscaled-idx)) - (! check-misc-bound unscaled-idx src)) - (with-imm-temps () (temp) - (cond (is-32-bit - (if constval - (ppc2-lri seg temp - (if (typep constval 'single-float) - (ppc2-single-float-bits constval) - (if (characterp constval) - (char-code constval) - constval))) - (cond ((eq type-keyword :single-float-vector) - (when safe - (! trap-unless-single-float val-reg)) - (! single-float-bits temp val-reg)) - ((eq type-keyword :signed-32-bit-vector) - (! unbox-s32 temp val-reg)) - ((eq type-keyword :fixnum-vector) - (when safe - (! trap-unless-fixnum val-reg)) - (! fixnum->signed-natural temp val-reg)) - ((eq type-keyword :simple-string) - (! unbox-base-char temp val-reg)) - (t - (! unbox-u32 temp val-reg)))) - (if (and index-known-fixnum - (<= index-known-fixnum (arch::target-max-32-bit-constant-index arch))) - (! misc-set-c-u32 temp src index-known-fixnum) - (progn - (setq idx-reg (make-unwired-lreg (select-imm-temp :natural))) - (if index-known-fixnum - (ppc2-absolute-natural seg idx-reg nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 2))) - (! scale-32bit-misc-index idx-reg unscaled-idx)) - (! misc-set-u32 temp src idx-reg)))) - (is-8-bit - (if constval - (ppc2-lri seg temp (if (characterp constval) (char-code constval) constval)) - (if safe - (cond ((eq type-keyword :simple-string) - (! unbox-base-char temp val-reg)) - ((eq type-keyword :signed-8-bit-vector) - (! unbox-s8 temp val-reg)) - (t - (! unbox-u8 temp val-reg))) - (if (eq type-keyword :simple-string) - (! character->code temp val-reg) - (! fixnum->unsigned-natural temp val-reg)))) - (if (and index-known-fixnum - (<= index-known-fixnum (arch::target-max-8-bit-constant-index arch))) - (! misc-set-c-u8 temp src index-known-fixnum) - (progn - (setq idx-reg (make-unwired-lreg (select-imm-temp :natural))) - (if index-known-fixnum - (ppc2-absolute-natural seg idx-reg nil (+ (arch::target-misc-data-offset arch) index-known-fixnum)) - (! scale-8bit-misc-index idx-reg unscaled-idx)) - (! misc-set-u8 temp src idx-reg)))) - (is-16-bit - (if constval - (ppc2-lri seg temp (if (characterp constval) (char-code constval) constval)) - (if safe - (cond ((eq type-keyword :signed-16-bit-vector) - (! unbox-s16 temp val-reg)) - (t - (! unbox-u16 temp val-reg))) - (! fixnum->unsigned-natural temp val-reg))) - (if (and index-known-fixnum - (<= index-known-fixnum (arch::target-max-16-bit-constant-index arch))) - (! misc-set-c-u16 temp src index-known-fixnum) - (progn - (setq idx-reg (make-unwired-lreg (select-imm-temp :natural))) - (if index-known-fixnum - (ppc2-absolute-natural seg idx-reg nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 1))) - (! scale-16bit-misc-index idx-reg unscaled-idx)) - (! misc-set-u16 temp src idx-reg)))) - (is-64-bit - (ecase type-keyword - (:double-float-vector - (if safe - (! get-double? 0 val-reg) - (! get-double 0 val-reg)) - (if (and index-known-fixnum - (<= index-known-fixnum (arch::target-max-64-bit-constant-index arch))) - (! misc-set-c-double-float 0 src index-known-fixnum) - (progn - (setq idx-reg temp) - (if index-known-fixnum - (ppc2-absolute-natural seg idx-reg nil (+ (arch::target-misc-dfloat-offset arch) (ash index-known-fixnum 3))) - (! scale-64bit-misc-index idx-reg unscaled-idx)) - (! misc-set-double-float 0 src idx-reg)))) - ((:signed-64-bit-vector :fixnum-vector) - (with-imm-target (temp) (s64 :s64) - (if (eq type-keyword :fixnum-vector) - (progn - (when safe - (! trap-unless-fixnum val-reg)) - (! fixnum->signed-natural s64 val-reg)) - (! unbox-s64 s64 val-reg)) - (if (and index-known-fixnum - (<= index-known-fixnum (arch::target-max-64-bit-constant-index arch))) - (! misc-set-c-s64 s64 src index-known-fixnum) - (progn - (setq idx-reg temp) - (if index-known-fixnum - (ppc2-absolute-natural seg idx-reg nil (+ (arch::target-misc-dfloat-offset arch) (ash index-known-fixnum 3))) - (! scale-64bit-misc-index idx-reg unscaled-idx)) - (! misc-set-s64 s64 src idx-reg))))) - (:unsigned-64-bit-vector - (with-imm-target (temp) (u64 :u64) - (! unbox-u64 u64 val-reg) - (if (and index-known-fixnum - (<= index-known-fixnum (arch::target-max-64-bit-constant-index arch))) - (! misc-set-c-u64 u64 src index-known-fixnum) - (progn - (setq idx-reg temp) - (if index-known-fixnum - (ppc2-absolute-natural seg idx-reg nil (+ (arch::target-misc-dfloat-offset arch) (ash index-known-fixnum 3))) - (! scale-64bit-misc-index idx-reg unscaled-idx)) - (! misc-set-u64 u64 src idx-reg))))) - )) - (t - (unless is-1-bit - (nx-error "~& unsupported vector type: ~s" - type-keyword)) - ;; bit-vector case. - ;; It's easiest to do this when the bitnumber is - ;; known (and a little easier still - ;; if the value's known.) - (if (and index-known-fixnum (<= index-known-fixnum (arch::target-max-64-bit-constant-index arch))) - (let* ((word-index (ash index-known-fixnum -5)) - (bit-number (logand index-known-fixnum #x1f))) - (! misc-ref-c-u32 temp src word-index) - (if constval - (if (zerop constval) - (! set-constant-ppc-bit-to-0 temp temp bit-number) - (! set-constant-ppc-bit-to-1 temp temp bit-number)) - (with-imm-temps () (bitval) - (! unbox-bit bitval val-reg) - (! set-constant-ppc-bit-to-variable-value temp temp bitval bit-number))) - (! misc-set-c-u32 temp src word-index)) - ;; When the bit-number isn't known, we have to do one of the following: - ;; A) If the value's known: - ;; 1) generate a mask with a 1 in the "bitnum" bit and 0s elsewhere. - ;; 2) Grab the word out of the vector. - ;; 3) If the value's 0, do an ANDC with the mask and word, else an OR. - ;; B) When the value's not known: - ;; 1) Extract the value into PPC bit 0 of some register, trapping if value not a bit. - ;; 2) Shift the value right "bitnum" bits. - ;; 3) Generate a mask with a 1 in the "bitnum" bit and 0s elsewhere. - ;; 4) Reference the word, ANDC it with the mask, OR the shifted value in. - (with-imm-temps () (word-index bit-number) - (! scale-1bit-misc-index word-index bit-number unscaled-idx) - (if constval - (progn - (! lri temp #x80000000) - (! shift-right-variable-word bit-number temp bit-number) ; (A1) - (! misc-ref-u32 temp src word-index) ; (A2) - (if (zerop constval) ; (A3) - (! u32logandc2 temp temp bit-number) - (! u32logior temp temp bit-number))) - (with-imm-temps () (bitval) - (! unbox-bit-bit0 bitval val-reg) ; (B1) - (! shift-right-variable-word bitval bitval bit-number) ; (B2) - (! lri temp #x80000000) - (! shift-right-variable-word bit-number temp bit-number) ; (B3) - (! misc-ref-u32 temp src word-index) - (! u32logandc2 temp temp bit-number) ; clear bit-number'th bit - (! u32logior temp temp bitval))) ; (B4) - (! misc-set-u32 temp src word-index))))) - (when vreg (<- val-reg)))) - (^))))))))) - -;;; In this case, the destination (vreg) is either an FPR or null, so -;;; we can maybe avoid boxing the value. -(defun ppc2-df-vset (seg vreg xfer vector index value safe) + (is-64-bit (member type-keyword (arch::target-64-bit-ivector-types arch))) + (is-signed (member type-keyword '(:signed-8-bit-vector :signed-16-bit-vector :signed-32-bit-vector :fixnum-vector))) + (vreg-class (if vreg (hard-regspec-class vreg))) + (vreg-mode (if (or (eql vreg-class hard-reg-class-gpr) + (eql vreg-class hard-reg-class-fpr)) + (get-regspec-mode vreg))) + (next-imm-target (available-imm-temp *available-backend-imm-temps*)) + (next-fp-target (available-fp-temp *available-backend-fp-temps*)) + (acc (make-wired-lreg ppc::arg_z))) + (cond ((or is-node + is-1-bit + (eq type-keyword :simple-string) + (eq type-keyword :fixnum-vector) + (and (eql vreg-class hard-reg-class-gpr) + (eql vreg-mode hard-reg-class-gpr-mode-node))) + acc) + ;; If there's no vreg - if we're setting for effect only, and + ;; not for value - we can target an unboxed register directly. + ;; Usually. + ((null vreg) + (cond (is-64-bit + (if (eq type-keyword :double-float-vector) + (make-unwired-lreg next-fp-target :mode hard-reg-class-fpr-mode-double) + (make-unwired-lreg next-imm-target :mode (if is-signed hard-reg-class-gpr-mode-s64 hard-reg-class-gpr-mode-u64)))) + (is-32-bit + (if (eq type-keyword :single-float-vector) + (make-unwired-lreg next-fp-target :mode hard-reg-class-fpr-mode-single) + (make-unwired-lreg next-imm-target :mode (if is-signed hard-reg-class-gpr-mode-s32 hard-reg-class-gpr-mode-u32)))) + (is-16-bit + (make-unwired-lreg next-imm-target :mode (if is-signed hard-reg-class-gpr-mode-s16 hard-reg-class-gpr-mode-u16))) + (is-8-bit + (make-unwired-lreg next-imm-target :mode (if is-signed hard-reg-class-gpr-mode-s8 hard-reg-class-gpr-mode-u8))) + (t "Bug: can't determine operand size for ~s" type-keyword))) + ;; Vreg is non-null. We might be able to use it directly. + (t + (let* ((lreg (if vreg-mode + (make-unwired-lreg (lreg-value vreg))))) + (if + (cond + (is-64-bit + (if (eq type-keyword :double-float-vector) + (and (eql vreg-class hard-reg-class-fpr) + (eql vreg-mode hard-reg-class-fpr-mode-double)) + (if is-signed + (and (eql vreg-class hard-reg-class-gpr) + (eql vreg-mode hard-reg-class-gpr-mode-s64)) + (and (eql vreg-class hard-reg-class-gpr) + (eql vreg-mode hard-reg-class-gpr-mode-u64))))) + (is-32-bit + (if (eq type-keyword :single-float-vector) + (and (eql vreg-class hard-reg-class-fpr) + (eql vreg-mode hard-reg-class-fpr-mode-single)) + (if is-signed + (and (eql vreg-class hard-reg-class-gpr) + (or (eql vreg-mode hard-reg-class-gpr-mode-s32) + (eql vreg-mode hard-reg-class-gpr-mode-s64))) + (and (eql vreg-class hard-reg-class-gpr) + (or (eql vreg-mode hard-reg-class-gpr-mode-u32) + (eql vreg-mode hard-reg-class-gpr-mode-u64) + (eql vreg-mode hard-reg-class-gpr-mode-s64)))))) + (is-16-bit + (if is-signed + (and (eql vreg-class hard-reg-class-gpr) + (or (eql vreg-mode hard-reg-class-gpr-mode-s16) + (eql vreg-mode hard-reg-class-gpr-mode-s32) + (eql vreg-mode hard-reg-class-gpr-mode-s64))) + (and (eql vreg-class hard-reg-class-gpr) + (or (eql vreg-mode hard-reg-class-gpr-mode-u16) + (eql vreg-mode hard-reg-class-gpr-mode-u32) + (eql vreg-mode hard-reg-class-gpr-mode-u64) + (eql vreg-mode hard-reg-class-gpr-mode-s32) + (eql vreg-mode hard-reg-class-gpr-mode-s64))))) + (t + (if is-signed + (and (eql vreg-class hard-reg-class-gpr) + (or (eql vreg-mode hard-reg-class-gpr-mode-s8) + (eql vreg-mode hard-reg-class-gpr-mode-s16) + (eql vreg-mode hard-reg-class-gpr-mode-s32) + (eql vreg-mode hard-reg-class-gpr-mode-s64))) + (and (eql vreg-class hard-reg-class-gpr) + (or (eql vreg-mode hard-reg-class-gpr-mode-u8) + (eql vreg-mode hard-reg-class-gpr-mode-u16) + (eql vreg-mode hard-reg-class-gpr-mode-u32) + (eql vreg-mode hard-reg-class-gpr-mode-u64) + (eql vreg-mode hard-reg-class-gpr-mode-s16) + (eql vreg-mode hard-reg-class-gpr-mode-s32) + (eql vreg-mode hard-reg-class-gpr-mode-s64)))))) + lreg + acc)))))) + +(defun ppc2-unboxed-reg-for-aset (seg type-keyword result-reg safe constval) + (with-ppc-local-vinsn-macros (seg) + (let* ((arch (backend-target-arch *target-backend*)) + (is-node (member type-keyword (arch::target-gvector-types arch))) + (is-8-bit (member type-keyword (arch::target-8-bit-ivector-types arch))) + (is-16-bit (member type-keyword (arch::target-16-bit-ivector-types arch))) + (is-32-bit (member type-keyword (arch::target-32-bit-ivector-types arch))) + (is-64-bit (member type-keyword (arch::target-64-bit-ivector-types arch))) + (is-signed (member type-keyword '(:signed-8-bit-vector :signed-16-bit-vector :signed-32-bit-vector :fixnum-vector))) + (result-is-node-gpr (and (eql (hard-regspec-class result-reg) + hard-reg-class-gpr) + (eql (get-regspec-mode result-reg) + hard-reg-class-gpr-mode-node))) + (next-imm-target (available-imm-temp *available-backend-imm-temps*)) + (next-fp-target (available-fp-temp *available-backend-fp-temps*))) + (if (or is-node (not result-is-node-gpr)) + result-reg + (cond (is-64-bit + (if (eq type-keyword :double-float-vector) + (let* ((reg (make-unwired-lreg next-fp-target :mode hard-reg-class-fpr-mode-double))) + (if safe + (! get-double? reg result-reg) + (! get-double reg result-reg)) + reg) + (if is-signed + (let* ((reg (make-unwired-lreg next-imm-target :mode hard-reg-class-gpr-mode-s64))) + (if (eq type-keyword :fixnum-vector) + (progn + (when safe + (! trap-unless-fixnum result-reg)) + (! fixnum->signed-natural reg result-reg)) + (! unbox-s64 reg result-reg)) + reg) + (let* ((reg (make-unwired-lreg next-imm-target :mode hard-reg-class-gpr-mode-u64))) + (! unbox-u64 reg result-reg) + reg)))) + (is-32-bit + ;; Generally better to use a GPR for the :SINGLE-FLOAT-VECTOR + ;; case here. + (if is-signed + (let* ((reg (make-unwired-lreg next-imm-target :mode hard-reg-class-gpr-mode-s32))) + (if (eq type-keyword :fixnum-vector) + (progn + (when safe + (! trap-unless-fixnum result-reg)) + (! fixnum->signed-natural reg result-reg)) + (! unbox-s32 reg result-reg)) + reg) + (let* ((reg (make-unwired-lreg next-imm-target :mode hard-reg-class-gpr-mode-u32))) + (cond ((eq type-keyword :simple-string) + (if (characterp constval) + (ppc2-lri seg reg (char-code constval)) + (! unbox-base-char reg result-reg))) + ((eq type-keyword :single-float-vector) + (if (typep constval 'single-float) + (ppc2-lri seg reg (single-float-bits constval)) + (progn + (when safe + (! trap-unless-single-float result-reg)) + (! single-float-bits reg result-reg)))) + (t + (if (typep constval '(unsigned-byte 32)) + (ppc2-lri seg reg constval) + (! unbox-u32 reg result-reg)))) + reg))) + (is-16-bit + (if is-signed + (let* ((reg (make-unwired-lreg next-imm-target :mode hard-reg-class-gpr-mode-s16))) + (if (typep constval '(signed-byte 16)) + (ppc2-lri seg reg constval) + (! unbox-s16 reg result-reg)) + reg) + (let* ((reg (make-unwired-lreg next-imm-target :mode hard-reg-class-gpr-mode-u16))) + (if (typep constval '(unsigned-byte 16)) + (ppc2-lri seg reg constval) + (! unbox-u16 reg result-reg)) + reg))) + (is-8-bit + (if is-signed + (let* ((reg (make-unwired-lreg next-imm-target :mode hard-reg-class-gpr-mode-s8))) + (if (typep constval '(signed-byte 8)) + (ppc2-lri seg reg constval) + (! unbox-s8 reg result-reg)) + reg) + (let* ((reg (make-unwired-lreg next-imm-target :mode hard-reg-class-gpr-mode-u8))) + (if (typep constval '(unsigned-byte 8)) + (ppc2-lri seg reg constval) + (! unbox-u8 reg result-reg)) + reg))) + (t + (let* ((reg (make-unwired-lreg next-imm-target :mode hard-reg-class-gpr-mode-u8))) + (unless (typep constval 'bit) + (! unbox-bit-bit0 reg result-reg)) + reg))))))) + + +;;; "val-reg" might be boxed, if the vreg requires it to be. +(defun ppc2-vset1 (seg vreg xfer type-keyword src unscaled-idx index-known-fixnum val-reg unboxed-val-reg constval &optional (node-value-needs-memoization t)) (with-ppc-local-vinsn-macros (seg vreg xfer) - (let* ((index-known-fixnum (acode-fixnum-form-p index)) - (arch (backend-target-arch *target-backend*)) - (src nil) - (unscaled-idx nil)) - (with-fp-target () fp-val - (if (or safe (not index-known-fixnum)) - (multiple-value-setq (src unscaled-idx fp-val) - (ppc2-three-untargeted-reg-forms seg vector ppc::arg_y index ppc::arg_z value (or vreg fp-val))) - (multiple-value-setq (src fp-val) - (ppc2-two-untargeted-reg-forms seg vector ppc::arg_z value (or vreg fp-val)))) - (when safe - (if (typep safe 'fixnum) - (! trap-unless-typecode= src safe)) - (unless index-known-fixnum - (! trap-unless-fixnum unscaled-idx)) - (! check-misc-bound unscaled-idx src)) - (if (and index-known-fixnum - (<= index-known-fixnum (arch::target-max-64-bit-constant-index arch))) - (! misc-set-c-double-float fp-val src index-known-fixnum) - (with-imm-temps () (idx-reg) - (if index-known-fixnum - (ppc2-absolute-natural seg idx-reg nil (+ (arch::target-misc-dfloat-offset arch) (ash index-known-fixnum 3))) - (! scale-64bit-misc-index idx-reg unscaled-idx)) - (! misc-set-double-float fp-val src idx-reg))) - (<- fp-val) ; should be a no-op in this case - (^))))) - -(defun ppc2-sf-vset (seg vreg xfer vector index value safe) - (with-ppc-local-vinsn-macros (seg vreg xfer) - (let* ((index-known-fixnum (acode-fixnum-form-p index)) - (arch (backend-target-arch *target-backend*)) - (src nil) - (unscaled-idx nil)) - (with-fp-target () (fp-val :single-float) - (if (or safe (not index-known-fixnum)) - (multiple-value-setq (src unscaled-idx fp-val) - (ppc2-three-untargeted-reg-forms seg vector ppc::arg_y index ppc::arg_z value (or vreg fp-val))) - (multiple-value-setq (src fp-val) - (ppc2-two-untargeted-reg-forms seg vector ppc::arg_z value (or vreg fp-val)))) - (when safe - (if (typep safe 'fixnum) - (! trap-unless-typecode= src safe)) - (unless index-known-fixnum - (! trap-unless-fixnum unscaled-idx)) - (! check-misc-bound unscaled-idx src)) - (if (and index-known-fixnum - (<= index-known-fixnum (arch::target-max-32-bit-constant-index arch))) - (! misc-set-c-single-float fp-val src index-known-fixnum) - (with-imm-temps () (idx-reg) - (if index-known-fixnum - (ppc2-absolute-natural seg idx-reg nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 2))) - (! scale-32bit-misc-index idx-reg unscaled-idx)) - (! misc-set-single-float fp-val src idx-reg))) - (<- fp-val) ; should be a no-op in this case - (^))))) + (let* ((arch (backend-target-arch *target-backend*)) + (is-node (member type-keyword (arch::target-gvector-types arch))) + (is-1-bit (member type-keyword (arch::target-1-bit-ivector-types arch))) + (is-8-bit (member type-keyword (arch::target-8-bit-ivector-types arch))) + (is-16-bit (member type-keyword (arch::target-16-bit-ivector-types arch))) + (is-32-bit (member type-keyword (arch::target-32-bit-ivector-types arch))) + (is-64-bit (member type-keyword (arch::target-64-bit-ivector-types arch))) + (is-signed (member type-keyword '(:signed-8-bit-vector :signed-16-bit-vector :signed-32-bit-vector :fixnum-vector)))) + (cond ((and is-node node-value-needs-memoization) + (unless (and (eql (hard-regspec-value src) ppc::arg_x) + (eql (hard-regspec-value unscaled-idx) ppc::arg_y) + (eql (hard-regspec-value val-reg) ppc::arg_z)) + (nx-error "Bug: invalid register targeting for gvset: ~s" (list src unscaled-idx val-reg))) + (! call-subprim-3 val-reg (subprim-name->offset '.SPgvset) src unscaled-idx val-reg)) + (is-node + (if (and index-known-fixnum (<= index-known-fixnum + (target-word-size-case + (32 (arch::target-max-32-bit-constant-index arch)) + (64 (arch::target-max-64-bit-constant-index arch))))) + (! misc-set-c-node val-reg src index-known-fixnum) + (with-imm-target () scaled-idx + + (if index-known-fixnum + (ppc2-absolute-natural seg scaled-idx nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum *ppc2-target-node-shift*))) + (! scale-node-misc-index scaled-idx unscaled-idx)) + (! misc-set-node val-reg src scaled-idx)))) + (t + (with-imm-target (unboxed-val-reg) scaled-idx + (cond + (is-64-bit + (if (and index-known-fixnum + (<= index-known-fixnum + (arch::target-max-64-bit-constant-index arch))) + (if (eq type-keyword :double-float-vector) + (! misc-set-c-double-float unboxed-val-reg src index-known-fixnum) + (if is-signed + (! misc-set-c-s64 unboxed-val-reg src index-known-fixnum) + (! misc-set-c-u64 unboxed-val-reg src index-known-fixnum))) + (progn + (if index-known-fixnum + (ppc2-absolute-natural seg scaled-idx nil (+ (arch::target-misc-dfloat-offset arch) (ash index-known-fixnum 3))) + (! scale-64bit-misc-index scaled-idx unscaled-idx)) + (if (eq type-keyword :double-float-vector) + (! misc-set-double-float unboxed-val-reg src scaled-idx) + (if is-signed + (! misc-set-s64 unboxed-val-reg src scaled-idx) + (! misc-set-u64 unboxed-val-reg src scaled-idx)))))) + (is-32-bit + (if (and index-known-fixnum + (<= index-known-fixnum + (arch::target-max-32-bit-constant-index arch))) + (if (eq type-keyword :single-float-vector) + (if (eq (hard-regspec-class unboxed-val-reg) + hard-reg-class-fpr) + (! misc-set-c-single-float unboxed-val-reg src index-known-fixnum) + (! misc-set-c-u32 unboxed-val-reg src index-known-fixnum)) + (if is-signed + (! misc-set-c-s32 unboxed-val-reg src index-known-fixnum) + (! misc-set-c-u32 unboxed-val-reg src index-known-fixnum))) + (progn + (if index-known-fixnum + (ppc2-absolute-natural seg scaled-idx nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 2))) + (! scale-32bit-misc-index scaled-idx unscaled-idx)) + (if (and (eq type-keyword :single-float-vector) + (eql (hard-regspec-class unboxed-val-reg) + hard-reg-class-fpr)) + (! misc-set-single-float unboxed-val-reg src scaled-idx) + (if is-signed + (! misc-set-s32 unboxed-val-reg src scaled-idx) + (! misc-set-u32 unboxed-val-reg src scaled-idx)))))) + (is-16-bit + (if (and index-known-fixnum + (<= index-known-fixnum + (arch::target-max-16-bit-constant-index arch))) + (if is-signed + (! misc-set-c-s16 unboxed-val-reg src index-known-fixnum) + (! misc-set-c-u16 unboxed-val-reg src index-known-fixnum)) + (progn + (if index-known-fixnum + (ppc2-absolute-natural seg scaled-idx nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 1))) + (! scale-16bit-misc-index scaled-idx unscaled-idx)) + (if is-signed + (! misc-set-s16 unboxed-val-reg src scaled-idx) + (! misc-set-u16 unboxed-val-reg src scaled-idx))))) + (is-8-bit + (if (and index-known-fixnum + (<= index-known-fixnum + (arch::target-max-8-bit-constant-index arch))) + (if is-signed + (! misc-set-c-s8 unboxed-val-reg src index-known-fixnum) + (! misc-set-c-u8 unboxed-val-reg src index-known-fixnum)) + (progn + (if index-known-fixnum + (ppc2-absolute-natural seg scaled-idx nil (+ (arch::target-misc-data-offset arch) index-known-fixnum)) + (! scale-8bit-misc-index scaled-idx unscaled-idx)) + (if is-signed + (! misc-set-s8 unboxed-val-reg src scaled-idx) + (! misc-set-u8 unboxed-val-reg src scaled-idx))))) + (t + (unless is-1-bit + (nx-error "~& unsupported vector type: ~s" + type-keyword)) + (if (and index-known-fixnum (<= index-known-fixnum (arch::target-max-1-bit-constant-index arch))) + (with-imm-target (unboxed-val-reg) word + (let* ((word-index (ash index-known-fixnum -5)) + (bit-number (logand index-known-fixnum #x1f))) + (! misc-ref-c-u32 word src word-index) + (if constval + (if (zerop constval) + (! set-constant-ppc-bit-to-0 word word bit-number) + (! set-constant-ppc-bit-to-1 word word bit-number)) + (! set-constant-ppc-bit-to-variable-value word word unboxed-val-reg bit-number)) + (! misc-set-c-u32 word src word-index))) + (with-imm-temps (unboxed-val-reg) (word-index bit-number temp) + (! scale-1bit-misc-index word-index bit-number unscaled-idx) + (if constval + (progn + (! lri temp #x80000000) + (! shift-right-variable-word bit-number temp bit-number) + (! misc-ref-u32 temp src word-index) + (if (zerop constval) + (! u32logandc2 temp temp bit-number) + (! u32logior temp temp bit-number))) + (with-imm-temps () (bitval) + (! shift-right-variable-word bitval unboxed-val-reg bit-number) + (! lri temp #x80000000) + (! shift-right-variable-word bit-number temp bit-number) + (! misc-ref-u32 temp src word-index) + (! u32logandc2 temp temp bit-number) + (! u32logior temp temp bitval))) + (! misc-set-u32 temp src word-index)))))))) + (when (and vreg val-reg) (<- val-reg)) + (^)))) + + +(defun ppc2-vset (seg vreg xfer type-keyword vector index value safe) + (with-ppc-local-vinsn-macros (seg) + (let* ((arch (backend-target-arch *target-backend*)) + (is-node (member type-keyword (arch::target-gvector-types arch))) + (constval (ppc2-constant-value-ok-for-type-keyword type-keyword value)) + (needs-memoization (and is-node (ppc2-acode-needs-memoization value))) + (index-known-fixnum (acode-fixnum-form-p index))) + (let* ((src ($ ppc::arg_x)) + (unscaled-idx ($ ppc::arg_y)) + (result-reg ($ ppc::arg_z))) + (cond (needs-memoization + (ppc2-three-targeted-reg-forms seg + vector src + index unscaled-idx + value result-reg)) + (t + (setq result-reg (ppc2-target-reg-for-aset vreg type-keyword)) + (ppc2-three-targeted-reg-forms seg + vector src + index unscaled-idx + value result-reg))) + (when safe + (let* ((*available-backend-imm-temps* *available-backend-imm-temps*) + (value (if (eql (hard-regspec-class result-reg) + hard-reg-class-gpr) + (hard-regspec-value result-reg)))) + (when (and value (logbitp value *available-backend-imm-temps*)) + (setq *available-backend-imm-temps* (bitclr value *available-backend-imm-temps*))) + (if (typep safe 'fixnum) + (! trap-unless-typecode= src safe)) + (unless index-known-fixnum + (! trap-unless-fixnum unscaled-idx)) + (! check-misc-bound unscaled-idx src))) + (ppc2-vset1 seg vreg xfer type-keyword src unscaled-idx index-known-fixnum result-reg (ppc2-unboxed-reg-for-aset seg type-keyword result-reg safe constval) constval needs-memoization))))) @@ -2663,4 +2687,71 @@ (values adest bdest)))) + +(defun ppc2-four-targeted-reg-forms (seg aform areg bform breg cform creg dform dreg) + (unless (typep areg 'lreg) + (warn "~s is not an lreg (1/4)" areg)) + (unless (typep breg 'lreg) + (warn "~s is not an lreg (2/4)" breg)) + (unless (typep creg 'lreg) + (warn "~s is not an lreg (3/4)" creg)) + (unless (typep dreg 'lreg) + (warn "~s is not an lreg (4/4)" dreg)) + (let* ((atriv (or (null aform) + (and (ppc2-trivial-p bform) + (ppc2-trivial-p cform) + (ppc2-trivial-p dform)))) + (btriv (or (null bform) + (and (ppc2-trivial-p cform) + (ppc2-trivial-p dform)))) + (ctriv (or (null cform) + (ppc2-trivial-p dform))) + + (aconst (and (not atriv) + (or (ppc-side-effect-free-form-p aform) + (let ((avar (ppc2-lexical-reference-p aform))) + (and avar + (ppc2-var-not-set-by-form-p avar bform) + (ppc2-var-not-set-by-form-p avar cform) + (ppc2-var-not-set-by-form-p avar dform)))))) + (bconst (and (not btriv) + (or (ppc-side-effect-free-form-p bform) + (let ((bvar (ppc2-lexical-reference-p bform))) + (and bvar + (ppc2-var-not-set-by-form-p bvar cform) + (ppc2-var-not-set-by-form-p bvar dform)))))) + (cconst (and (not ctriv) + (or (ppc-side-effect-free-form-p cform) + (let ((cvar (ppc2-lexical-reference-p cform))) + (and cvar + (ppc2-var-not-set-by-form-p cvar dform)))))) + (apushed nil) + (bpushed nil) + (cpushed nil)) + (if (and aform (not aconst)) + (if atriv + (ppc2-one-targeted-reg-form seg aform areg) + (setq apushed (ppc2-push-register seg (ppc2-one-untargeted-reg-form seg aform (ppc2-acc-reg-for areg)))))) + (if (and bform (not bconst)) + (if btriv + (ppc2-one-targeted-reg-form seg bform breg) + (setq bpushed (ppc2-push-register seg (ppc2-one-untargeted-reg-form seg bform (ppc2-acc-reg-for breg)))))) + (if (and cform (not cconst)) + (if ctriv + (ppc2-one-targeted-reg-form seg cform creg) + (setq cpushed (ppc2-push-register seg (ppc2-one-untargeted-reg-form seg cform (ppc2-acc-reg-for creg)))))) + (ppc2-one-targeted-reg-form seg dform dreg) + (unless ctriv + (if cconst + (ppc2-one-targeted-reg-form seg cform creg) + (ppc2-elide-pushes seg cpushed (ppc2-pop-register seg creg)))) + (unless btriv + (if bconst + (ppc2-one-targeted-reg-form seg bform breg) + (ppc2-elide-pushes seg bpushed (ppc2-pop-register seg breg)))) + (unless atriv + (if aconst + (ppc2-one-targeted-reg-form seg aform areg) + (ppc2-elide-pushes seg apushed (ppc2-pop-register seg areg)))) + (values areg breg creg dreg))) (defun ppc2-three-targeted-reg-forms (seg aform areg bform breg cform creg) @@ -4149,47 +4240,5 @@ -(defun ppc2-misc-node-set (seg vreg xfer miscobj index value safe) - (with-ppc-local-vinsn-macros (seg vreg xfer) - (let* ((memoize (ppc2-acode-needs-memoization value))) - (if memoize - (multiple-value-bind (src unscaled-idx val-reg) - (ppc2-three-targeted-reg-forms seg miscobj ($ ppc::arg_x) index ($ ppc::arg_y) value ($ ppc::arg_z)) - (when safe - (if (typep safe 'fixnum) - (! trap-unless-typecode= src safe)) - (! trap-unless-fixnum unscaled-idx) - (! check-misc-bound unscaled-idx src)) - (! call-subprim-3 val-reg (subprim-name->offset '.SPgvset) src unscaled-idx val-reg) - (<- val-reg) - (^)) - ;; no memoization needed - (let* ((index-known-fixnum (acode-fixnum-form-p index)) - (arch (backend-target-arch *target-backend*)) - (src ) - (unscaled-idx ) - (val-reg )) - (if (or safe (not index-known-fixnum)) - (multiple-value-setq (src unscaled-idx val-reg) - (ppc2-three-untargeted-reg-forms seg miscobj ppc::arg_x index ppc::arg_y value ppc::arg_z)) - (multiple-value-setq (src val-reg) - (ppc2-two-untargeted-reg-forms seg miscobj ppc::arg_y value ppc::arg_z))) - (when safe - (if (typep safe 'fixnum) - (! trap-unless-typecode= src safe)) - (unless index-known-fixnum - (! trap-unless-fixnum unscaled-idx)) - (! check-misc-bound unscaled-idx src)) - (if (and index-known-fixnum (<= index-known-fixnum - (target-word-size-case - (32 (arch::target-max-32-bit-constant-index arch)) - (64 (arch::target-max-64-bit-constant-index arch))))) - (! misc-set-c-node val-reg src index-known-fixnum) - (let* ((idx-reg ppc::imm0)) - (if index-known-fixnum - (ppc2-absolute-natural seg idx-reg nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum *ppc2-target-node-shift*))) - (! scale-node-misc-index idx-reg unscaled-idx)) - (! misc-set-node val-reg src idx-reg))) - (<- val-reg) - (^)))))) + @@ -5316,8 +5365,8 @@ (defppc2 ppc2-%svset %svset (seg vreg xfer vector index value) - (ppc2-misc-node-set seg vreg xfer vector index value nil)) + (ppc2-vset seg vreg xfer :simple-vector vector index value nil)) (defppc2 ppc2-svset svset (seg vreg xfer vector index value) - (ppc2-misc-node-set seg vreg xfer vector index value (nx-lookup-target-uvector-subtag :simple-vector))) + (ppc2-vset seg vreg xfer :simple-vector vector index value (nx-lookup-target-uvector-subtag :simple-vector))) (defppc2 ppc2-typed-form typed-form (seg vreg xfer typespec form) @@ -5513,5 +5562,5 @@ (defppc2 ppc2-struct-set struct-set (seg vreg xfer struct offset value) - (ppc2-misc-node-set seg vreg xfer struct offset value (unless *ppc2-reckless* (nx-lookup-target-uvector-subtag :struct)))) + (ppc2-vset seg vreg xfer :struct struct offset value (unless *ppc2-reckless* (nx-lookup-target-uvector-subtag :struct)))) (defppc2 ppc2-istruct-typep istruct-typep (seg vreg xfer cc form type) @@ -7399,24 +7448,48 @@ (ppc2-fixed-call-builtin seg vreg xfer nil (subprim-name->offset '.SParef2))))) ) -(defppc2 ppc2-%aset2 aset2 (seg vreg xfer typename arr i j new &optional dim0 dim1) +(defppc2 ppc2-%aset2 simple-typed-aset2 (seg vreg xfer typename arr i j new &optional dim0 dim1) (let* ((type-keyword (ppc2-immediate-operand typename)) - (fixtype (nx-lookup-target-uvector-subtag type-keyword)) + (fixtype (nx-lookup-target-uvector-subtag type-keyword )) (safe (unless *ppc2-reckless* fixtype)) (dim0 (acode-fixnum-form-p dim0)) (dim1 (acode-fixnum-form-p dim1))) - (cond ((eq type-keyword :double-float-vector ) - (with-fp-target () (target :double-float) - (<- (ppc2-aset2 seg target arr i j new safe typename dim0 dim1)) - (^))) - ((eq type-keyword :single-float-vector) - (with-fp-target () (target :single-float) - (<- (ppc2-aset2 seg target arr i j new safe typename dim0 dim1)) - (^))) + (ppc2-aset2 seg vreg xfer arr i j new safe type-keyword dim0 dim1)) +) + +(defppc2 ppc2-general-aset2 general-aset2 (seg vreg xfer arr i j new) + (let* ((atype0 (acode-form-type arr t)) + (ctype (if atype0 (specifier-type atype0))) + (atype (if (array-ctype-p ctype) ctype)) + (keyword (and atype + (= 2 (length (array-ctype-dimensions atype))) + (not (array-ctype-complexp atype)) + (funcall + (arch::target-array-type-name-from-ctype-function + (backend-target-arch *target-backend*)) + atype)))) + (cond (keyword + (let* ((dims (array-ctype-dimensions atype)) + (dim0 (car dims)) + (dim1 (cadr dims))) + (ppc2-aset2 seg + vreg + xfer + arr + i + j + new + (unless *ppc2-reckless* + (nx-lookup-target-uvector-subtag keyword )) + keyword + (if (typep dim0 'fixnum) dim0) + (if (typep dim1 'fixnum) dim1)))) (t - (ppc2-form seg vreg xfer - (make-acode (%nx1-operator call) - (make-acode (%nx1-operator immediate) '%aset2) - (list (list arr) - (list new j i)))))))) + (ppc2-four-targeted-reg-forms seg + arr ($ ppc::temp0) + i ($ ppc::arg_x) + j ($ ppc::arg_y) + new ($ ppc::arg_z)) + (ppc2-fixed-call-builtin seg vreg xfer nil (subprim-name->offset '.SPaset2)))))) + (defppc2 ppc2-%typed-uvref %typed-uvref (seg vreg xfer subtag uvector index) @@ -7442,8 +7515,11 @@ (if type-keyword (ppc2-vset seg vreg xfer type-keyword uvector index newval (unless *ppc2-reckless* (nx-lookup-target-uvector-subtag type-keyword))) - (progn ; Could always do a four-targeted-reg-forms ... - (ppc2-vpush-register seg (ppc2-one-untargeted-reg-form seg subtag ppc::arg_z)) - (ppc2-three-targeted-reg-forms seg uvector ($ ppc::arg_x) index ($ ppc::arg_y) newval ($ ppc::arg_z)) - (ppc2-vpop-register seg ($ ppc::temp0)) + (progn + (ppc2-four-targeted-reg-forms seg + subtag ($ ppc::temp0) + uvector ($ ppc::arg_x) + index ($ ppc::arg_y) + newval ($ ppc::arg_z)) + (! subtag-misc-set) (when vreg (<- ($ ppc::arg_z))) @@ -8478,14 +8554,14 @@ (defppc2 ppc2-global-setq global-setq (seg vreg xfer sym val) - (ppc2-misc-node-set seg - vreg - xfer - (make-acode (%nx1-operator immediate) sym) - (make-acode (%nx1-operator fixnum) - (target-arch-case - (:ppc32 ppc32::symbol.vcell-cell) - (:ppc64 ppc64::symbol.vcell-cell))) - val - nil)) + (ppc2-vset seg + vreg + xfer + :symbol + (make-acode (%nx1-operator immediate) sym) + (make-acode (%nx1-operator fixnum) + (target-arch-case (:ppc32 ppc32::symbol.vcell-cell) + (:ppc64 ppc64::symbol.vcell-cell))) + val + nil)) (defppc2 ppc2-%current-frame-ptr %current-frame-ptr (seg vreg xfer)