Index: /trunk/ccl/compiler/PPC/ppc2.lisp =================================================================== --- /trunk/ccl/compiler/PPC/ppc2.lisp (revision 370) +++ /trunk/ccl/compiler/PPC/ppc2.lisp (revision 371) @@ -26,4 +26,8 @@ (defconstant ppc2-debug-vinsns-bit 1) (defconstant ppc2-debug-lcells-bit 2) +(defparameter *ppc2-target-lcell-size* 0) +(defparameter *ppc2-target-node-size* 0) + + @@ -50,5 +54,5 @@ (unless ,template-temp (warn "VINSN \"~A\" not defined" ,template-name-var)) - `(%emit-vinsn ,',segvar (load-time-value (get-vinsn-template-cell ',,template-name-var (backend-p2-vinsn-templates *target-backend*))) (backend-p2-vinsn-templates *target-backend*) ,@,args-var)))) + `(%emit-vinsn ,',segvar ',,template-name-var (backend-p2-vinsn-templates *target-backend*) ,@,args-var)))) (macrolet ((<- (,retvreg-var) `(ppc2-copy-register ,',segvar ,',vreg-var ,,retvreg-var)) @@ -195,5 +199,5 @@ (defun ppc2-reserve-vstack-lcells (n) - (dotimes (i n) (ppc2-new-vstack-lcell :reserved 4 0 nil))) + (dotimes (i n) (ppc2-new-vstack-lcell :reserved *ppc2-target-lcell-size* 0 nil))) (defun ppc2-vstack-mark-top () @@ -370,4 +374,6 @@ (*ppc2-vstack* 0) (*ppc2-cstack* 0) + (*ppc2-target-lcell-size* (backend-target-lisp-node-size *target-backend*)) + (*ppc2-target-node-size* *ppc2-target-lcell-size*) (*ppc2-all-lcells* ()) (*ppc2-top-vstack-lcell* nil) @@ -672,6 +678,6 @@ (! save-nvrs (- 32 n)))) (dotimes (i n) - (ppc2-new-vstack-lcell :regsave 4 0 (- ppc::save0 i))) - (incf *ppc2-vstack* (the fixnum (* n 4))) + (ppc2-new-vstack-lcell :regsave *ppc2-target-lcell-size* 0 (- ppc::save0 i))) + (incf *ppc2-vstack* (the fixnum (* n *ppc2-target-node-size*))) (setq *ppc2-register-restore-ea* *ppc2-vstack* *ppc2-register-restore-count* n))) @@ -716,5 +722,5 @@ (ppc2-init-regvar seg arg reg (ppc2-vloc-ea vloc)) (ppc2-bind-var seg arg vloc lcell)) - (setq vloc (%i+ vloc 4))))) + (setq vloc (%i+ vloc *ppc2-target-node-size*))))) (dolist (arg req) (if (memq arg passed-in-regs) @@ -724,5 +730,5 @@ (ppc2-init-regvar seg arg reg (ppc2-vloc-ea vloc)) (ppc2-bind-var seg arg vloc lcell)) - (setq vloc (%i+ vloc 4))))) + (setq vloc (%i+ vloc *ppc2-target-node-size*))))) (when opt (if (ppc2-hard-opt-p opt) @@ -736,8 +742,8 @@ (ppc2-init-regvar seg var reg (ppc2-vloc-ea vloc)) (ppc2-bind-var seg var vloc lcell)) - (setq vloc (+ vloc 4))))))) + (setq vloc (+ vloc *ppc2-target-node-size*))))))) (when keys (apply #'ppc2-init-keys seg vloc lcells keys) - (setq vloc (+ vloc (%ilsl 3 nkeys)) + (setq vloc (+ vloc (* 2 *ppc2-target-node-size* nkeys)) lcells (nthcdr (+ nkeys nkeys) lcells))) (when rest @@ -758,5 +764,5 @@ (ppc2-init-regvar seg rest reg (ppc2-vloc-ea vloc)) (ppc2-bind-var seg rest vloc (pop lcells))) - (setq vloc (+ vloc 4))))) + (setq vloc (+ vloc *ppc2-target-node-size*))))) (ppc2-seq-bind seg (%car auxen) (%cadr auxen))) @@ -789,6 +795,6 @@ (ppc2-init-regvar seg spvar reg (ppc2-vloc-ea spvloc)) (ppc2-bind-var seg spvar spvloc splcell)))) - (setq vloc (%i+ vloc 4)) - (if spvloc (setq spvloc (%i+ spvloc 4)))))) + (setq vloc (%i+ vloc *ppc2-target-node-size*)) + (if spvloc (setq spvloc (%i+ spvloc *ppc2-target-node-size*)))))) (defun ppc2-init-keys (seg vloc lcells allow-others keyvars keysupp keyinits keykeys) @@ -859,7 +865,7 @@ (destructuring-bind (&optional zvar yvar xvar &rest stack-args) revargs (let* ((nstackargs (length stack-args))) - (ppc2-set-vstack (ash nstackargs 2)) + (ppc2-set-vstack (* nstackargs *ppc2-target-node-size*)) (dotimes (i nstackargs) - (ppc2-new-vstack-lcell :reserved 4 0 nil)) + (ppc2-new-vstack-lcell :reserved *ppc2-target-lcell-size* 0 nil)) (if (>= nargs 3) (push (ppc2-vpush-arg-register seg ($ ppc::arg_x) xvar) reg-vars)) @@ -1301,5 +1307,5 @@ (! trap-unless-typecode= src safe)) (unless index-known-fixnum - (! trap-unless-tag= unscaled-idx ppc32::tag-fixnum)) + (! trap-unless-fixnum unscaled-idx)) (! check-misc-bound unscaled-idx src)) (if (<= subtag ppc32::max-32-bit-ivector-subtag) @@ -1307,5 +1313,5 @@ (cond ((= subtag ppc32::subtag-single-float-vector) (! misc-ref-c-single-float 0 src index-known-fixnum) - (! single->heap target 0)) + (! single->node target 0)) (t (with-imm-temps () (temp) @@ -1321,5 +1327,5 @@ (cond ((= subtag ppc32::subtag-single-float-vector) (! misc-ref-single-float 0 src idx-reg) - (! single->heap target 0)) + (! single->node target 0)) (t (with-imm-temps (idx-reg) (temp) @@ -1401,5 +1407,5 @@ (! trap-unless-typecode= src safe)) (unless index-known-fixnum - (! trap-unless-tag= unscaled-idx ppc32::tag-fixnum)) + (! trap-unless-fixnum unscaled-idx)) (! check-misc-bound unscaled-idx src)) (if (and index-known-fixnum (<= index-known-fixnum ppc32::max-64-bit-constant-index)) @@ -1445,7 +1451,7 @@ (ash 1 $arh_simple_bit)))) (unless i-known-fixnum - (! trap-unless-tag= unscaled-i ppc32::tag-fixnum)) + (! trap-unless-fixnum unscaled-i)) (unless j-known-fixnum - (! trap-unless-tag= unscaled-j ppc32::tag-fixnum))) + (! trap-unless-fixnum unscaled-j))) (with-imm-temps () (dim1 idx-reg) (unless constidx @@ -1513,7 +1519,7 @@ (ash 1 $arh_simple_bit)))) (unless i-known-fixnum - (! trap-unless-tag= unscaled-i ppc32::tag-fixnum)) + (! trap-unless-fixnum unscaled-i)) (unless j-known-fixnum - (! trap-unless-tag= unscaled-j ppc32::tag-fixnum))) + (! trap-unless-fixnum unscaled-j))) (with-imm-temps () (dim1 idx-reg) (unless constidx @@ -1566,5 +1572,5 @@ (! trap-unless-typecode= src safe)) (unless index-known-fixnum - (! trap-unless-tag= unscaled-idx ppc32::tag-fixnum)) + (! trap-unless-fixnum unscaled-idx)) (! check-misc-bound unscaled-idx src)) (if (and index-known-fixnum (<= index-known-fixnum ppc32::max-32-bit-constant-index)) @@ -1591,5 +1597,5 @@ (! trap-unless-typecode= src safe)) (unless index-known-fixnum - (! trap-unless-tag= unscaled-idx ppc32::tag-fixnum)) + (! trap-unless-fixnum unscaled-idx)) (! check-misc-bound unscaled-idx src)) (if (and index-known-fixnum (<= index-known-fixnum ppc32::max-32-bit-constant-index)) @@ -1618,5 +1624,5 @@ (! trap-unless-typecode= src safe)) (unless index-known-fixnum - (! trap-unless-tag= unscaled-idx ppc32::tag-fixnum)) + (! trap-unless-fixnum unscaled-idx)) (! check-misc-bound unscaled-idx src))) (if (and index-known-fixnum @@ -1705,5 +1711,5 @@ (! trap-unless-typecode= src safe)) (unless index-known-fixnum - (! trap-unless-tag= unscaled-idx ppc32::tag-fixnum)) + (! trap-unless-fixnum unscaled-idx)) (! check-misc-bound unscaled-idx src)) (with-imm-temps () (temp) @@ -1854,5 +1860,5 @@ (! trap-unless-typecode= src safe)) (unless index-known-fixnum - (! trap-unless-tag= unscaled-idx ppc32::tag-fixnum)) + (! trap-unless-fixnum unscaled-idx)) (! check-misc-bound unscaled-idx src)) (if (and index-known-fixnum @@ -1882,5 +1888,5 @@ (! trap-unless-typecode= src safe)) (unless index-known-fixnum - (! trap-unless-tag= unscaled-idx ppc32::tag-fixnum)) + (! trap-unless-fixnum unscaled-idx)) (! check-misc-bound unscaled-idx src)) (if (and index-known-fixnum @@ -2940,6 +2946,6 @@ (prog1 (! vpush-register src) - (ppc2-new-vstack-lcell (or why :node) 4 (or attr 0) info) - (ppc2-adjust-vstack +4)))) + (ppc2-new-vstack-lcell (or why :node) *ppc2-target-lcell-size* (or attr 0) info) + (ppc2-adjust-vstack *ppc2-target-node-size*)))) (defun ppc2-vpush-register-arg (seg src) @@ -2952,5 +2958,5 @@ (! vpop-register dest) (setq *ppc2-top-vstack-lcell* (lcell-parent *ppc2-top-vstack-lcell*)) - (ppc2-adjust-vstack -4)))) + (ppc2-adjust-vstack (- *ppc2-target-node-size*))))) (defun ppc2-copy-register (seg dest src) @@ -3100,5 +3106,5 @@ (! double->heap dest src)) (#.hard-reg-class-fpr-mode-single - (! single->heap dest src))))) + (! single->node dest src))))) (if (and src-fpr dest-fpr) (unless (eql dest-fpr src-fpr) @@ -3363,8 +3369,8 @@ (! svar-bind))) (ppc2-open-undo $undospecial) - (ppc2-new-vstack-lcell :special-value 4 0 sym) - (ppc2-new-vstack-lcell :special 4 (ash 1 $vbitspecial) sym) - (ppc2-new-vstack-lcell :special-link 4 0 sym) - (ppc2-adjust-vstack 12)))) + (ppc2-new-vstack-lcell :special-value *ppc2-target-lcell-size* 0 sym) + (ppc2-new-vstack-lcell :special *ppc2-target-lcell-size* (ash 1 $vbitspecial) sym) + (ppc2-new-vstack-lcell :special-link *ppc2-target-lcell-size* 0 sym) + (ppc2-adjust-vstack (* 3 *ppc2-target-node-size*))))) ; Store the contents of EA - which denotes either a vframe location @@ -3857,5 +3863,5 @@ (let* ((src (ppc2-one-untargeted-reg-form seg listform ppc::arg_z))) (when safe - (! trap-unless-tag= src ppc32::tag-list)) + (! trap-unless-list src)) (if vreg (ensuring-node-target (target vreg) @@ -3883,5 +3889,5 @@ (! trap-unless-typecode= src safe)) (unless index-known-fixnum - (! trap-unless-tag= unscaled-idx ppc32::tag-fixnum)) + (! trap-unless-fixnum unscaled-idx)) (! check-misc-bound unscaled-idx src)) (when vreg @@ -3912,5 +3918,5 @@ (! trap-unless-typecode= src safe)) (unless index-known-fixnum - (! trap-unless-tag= unscaled-idx ppc32::tag-fixnum)) + (! trap-unless-fixnum unscaled-idx)) (! check-misc-bound unscaled-idx src)) (if (and index-known-fixnum (<= index-known-fixnum ppc32::max-32-bit-constant-index)) @@ -4805,5 +4811,5 @@ (declare (fixnum flags nkeys nprev)) (dotimes (i (the fixnum (+ nkeys nkeys))) - (ppc2-new-vstack-lcell :reserved 4 0 nil)) + (ppc2-new-vstack-lcell :reserved *ppc2-target-lcell-size* 0 nil)) (! misc-ref-c-node ppc::temp3 ppc::nfn (1+ (backend-immediate-index keyvect))) (ppc2-lwi seg ppc::imm2 (ash flags ppc32::fixnumshift)) @@ -4866,5 +4872,5 @@ (! save-lisp-context-offset-ool nbytes-vpushed))) (ppc2-set-vstack nbytes-vpushed) - (setq optsupvloc (- *ppc2-vstack* (ash num-opt 2))))))) + (setq optsupvloc (- *ppc2-vstack* (* num-opt *ppc2-target-node-size*))))))) ;; Caller's context is saved; *ppc2-vstack* is valid. Might still have method-var ;; to worry about. @@ -5297,5 +5303,5 @@ (defppc2 ppc2-uvsize uvsize (seg vreg xfer v) (let* ((misc-reg (ppc2-one-untargeted-reg-form seg v ppc::arg_z))) - (unless *ppc2-reckless* (! trap-unless-tag= misc-reg ppc32::tag-misc)) + (unless *ppc2-reckless* (! trap-unless-uvector misc-reg)) (if vreg (ensuring-node-target (target vreg) @@ -5321,5 +5327,5 @@ (defppc2 ppc2-endp endp (seg vreg xfer cc form) (let* ((formreg (ppc2-one-untargeted-reg-form seg form ppc::arg_z))) - (! trap-unless-tag= formreg ppc32::tag-list) + (! trap-unless-list formreg) (multiple-value-bind (cr-bit true-p) (acode-condition-to-ppc-cr-bit cc) (ppc2-compare-register-to-nil seg vreg xfer formreg cr-bit true-p)))) @@ -5865,5 +5871,5 @@ (let* ((nreg (ppc2-one-untargeted-reg-form seg n ppc::arg_z))) (unless (acode-fixnum-form-p n) - (! trap-unless-tag= nreg ppc32::tag-fixnum)) + (! trap-unless-fixnum nreg)) (ppc2-vpush-register seg nreg)) (ppc2-multiple-value-body seg form) ; sets nargs @@ -6058,12 +6064,5 @@ (multiple-value-bind (r1 r2) (ppc2-two-untargeted-reg-forms seg f0 r1 f1 r2) (if (= (hard-regspec-class vreg) hard-reg-class-fpr) - (let* ((vreg-val (hard-regspec-value vreg))) - (declare (fixnum vreg-val)) - (if (or (= vreg-val (hard-regspec-value r1)) - (= vreg-val (hard-regspec-value r2))) - (with-fp-target (r1 r2) (result :double-float) - (! ,vinsn result r1 r2) - (<- result)) - (! ,vinsn vreg r1 r2))) + (! ,vinsn vreg r1 r2) (with-fp-target (r1 r2) (result :double-float) (! ,vinsn result r1 r2) @@ -6082,12 +6081,5 @@ (multiple-value-bind (r1 r2) (ppc2-two-untargeted-reg-forms seg f0 r1 f1 r2) (if (= (hard-regspec-class vreg) hard-reg-class-fpr) - (let* ((vreg-val (hard-regspec-value vreg))) - (declare (fixnum vreg-val)) - (if (or (= vreg-val (hard-regspec-value r1)) - (= vreg-val (hard-regspec-value r2))) - (with-fp-target (r1 r2) (result :single-float) - (! ,vinsn result r1 r2) - (<- result)) - (! ,vinsn vreg r1 r2))) + (! ,vinsn vreg r1 r2) (with-fp-target (r1 r2) (result :single-float) (! ,vinsn result r1 r2) @@ -7780,6 +7772,6 @@ (old-stack (ppc2-encode-stack))) (ecase (backend-name *target-backend*) - (:linuxppc (! alloc-eabi-c-frame 0)) - (:darwinppc (! alloc-c-frame 0))) + (:linuxppc32 (! alloc-eabi-c-frame 0)) + (:darwinppc32 (! alloc-c-frame 0))) (ppc2-open-undo $undo-ppc-c-frame) (ppc2-undo-body seg vreg xfer body old-stack))