Changeset 371
- Timestamp:
- Jan 24, 2004, 3:27:19 PM (21 years ago)
- File:
-
- 1 edited
-
trunk/ccl/compiler/PPC/ppc2.lisp (modified) (38 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/ccl/compiler/PPC/ppc2.lisp
r348 r371 26 26 (defconstant ppc2-debug-vinsns-bit 1) 27 27 (defconstant ppc2-debug-lcells-bit 2) 28 (defparameter *ppc2-target-lcell-size* 0) 29 (defparameter *ppc2-target-node-size* 0) 30 31 28 32 29 33 … … 50 54 (unless ,template-temp 51 55 (warn "VINSN \"~A\" not defined" ,template-name-var)) 52 `(%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))))56 `(%emit-vinsn ,',segvar ',,template-name-var (backend-p2-vinsn-templates *target-backend*) ,@,args-var)))) 53 57 (macrolet ((<- (,retvreg-var) 54 58 `(ppc2-copy-register ,',segvar ,',vreg-var ,,retvreg-var)) … … 195 199 196 200 (defun ppc2-reserve-vstack-lcells (n) 197 (dotimes (i n) (ppc2-new-vstack-lcell :reserved 40 nil)))201 (dotimes (i n) (ppc2-new-vstack-lcell :reserved *ppc2-target-lcell-size* 0 nil))) 198 202 199 203 (defun ppc2-vstack-mark-top () … … 370 374 (*ppc2-vstack* 0) 371 375 (*ppc2-cstack* 0) 376 (*ppc2-target-lcell-size* (backend-target-lisp-node-size *target-backend*)) 377 (*ppc2-target-node-size* *ppc2-target-lcell-size*) 372 378 (*ppc2-all-lcells* ()) 373 379 (*ppc2-top-vstack-lcell* nil) … … 672 678 (! save-nvrs (- 32 n)))) 673 679 (dotimes (i n) 674 (ppc2-new-vstack-lcell :regsave 40 (- ppc::save0 i)))675 (incf *ppc2-vstack* (the fixnum (* n 4)))680 (ppc2-new-vstack-lcell :regsave *ppc2-target-lcell-size* 0 (- ppc::save0 i))) 681 (incf *ppc2-vstack* (the fixnum (* n *ppc2-target-node-size*))) 676 682 (setq *ppc2-register-restore-ea* *ppc2-vstack* 677 683 *ppc2-register-restore-count* n))) … … 716 722 (ppc2-init-regvar seg arg reg (ppc2-vloc-ea vloc)) 717 723 (ppc2-bind-var seg arg vloc lcell)) 718 (setq vloc (%i+ vloc 4)))))724 (setq vloc (%i+ vloc *ppc2-target-node-size*))))) 719 725 (dolist (arg req) 720 726 (if (memq arg passed-in-regs) … … 724 730 (ppc2-init-regvar seg arg reg (ppc2-vloc-ea vloc)) 725 731 (ppc2-bind-var seg arg vloc lcell)) 726 (setq vloc (%i+ vloc 4)))))732 (setq vloc (%i+ vloc *ppc2-target-node-size*))))) 727 733 (when opt 728 734 (if (ppc2-hard-opt-p opt) … … 736 742 (ppc2-init-regvar seg var reg (ppc2-vloc-ea vloc)) 737 743 (ppc2-bind-var seg var vloc lcell)) 738 (setq vloc (+ vloc 4)))))))744 (setq vloc (+ vloc *ppc2-target-node-size*))))))) 739 745 (when keys 740 746 (apply #'ppc2-init-keys seg vloc lcells keys) 741 (setq vloc (+ vloc ( %ilsl 3nkeys))747 (setq vloc (+ vloc (* 2 *ppc2-target-node-size* nkeys)) 742 748 lcells (nthcdr (+ nkeys nkeys) lcells))) 743 749 (when rest … … 758 764 (ppc2-init-regvar seg rest reg (ppc2-vloc-ea vloc)) 759 765 (ppc2-bind-var seg rest vloc (pop lcells))) 760 (setq vloc (+ vloc 4)))))766 (setq vloc (+ vloc *ppc2-target-node-size*))))) 761 767 (ppc2-seq-bind seg (%car auxen) (%cadr auxen))) 762 768 … … 789 795 (ppc2-init-regvar seg spvar reg (ppc2-vloc-ea spvloc)) 790 796 (ppc2-bind-var seg spvar spvloc splcell)))) 791 (setq vloc (%i+ vloc 4))792 (if spvloc (setq spvloc (%i+ spvloc 4))))))797 (setq vloc (%i+ vloc *ppc2-target-node-size*)) 798 (if spvloc (setq spvloc (%i+ spvloc *ppc2-target-node-size*)))))) 793 799 794 800 (defun ppc2-init-keys (seg vloc lcells allow-others keyvars keysupp keyinits keykeys) … … 859 865 (destructuring-bind (&optional zvar yvar xvar &rest stack-args) revargs 860 866 (let* ((nstackargs (length stack-args))) 861 (ppc2-set-vstack ( ash nstackargs 2))867 (ppc2-set-vstack (* nstackargs *ppc2-target-node-size*)) 862 868 (dotimes (i nstackargs) 863 (ppc2-new-vstack-lcell :reserved 40 nil))869 (ppc2-new-vstack-lcell :reserved *ppc2-target-lcell-size* 0 nil)) 864 870 (if (>= nargs 3) 865 871 (push (ppc2-vpush-arg-register seg ($ ppc::arg_x) xvar) reg-vars)) … … 1301 1307 (! trap-unless-typecode= src safe)) 1302 1308 (unless index-known-fixnum 1303 (! trap-unless- tag= unscaled-idx ppc32::tag-fixnum))1309 (! trap-unless-fixnum unscaled-idx)) 1304 1310 (! check-misc-bound unscaled-idx src)) 1305 1311 (if (<= subtag ppc32::max-32-bit-ivector-subtag) … … 1307 1313 (cond ((= subtag ppc32::subtag-single-float-vector) 1308 1314 (! misc-ref-c-single-float 0 src index-known-fixnum) 1309 (! single-> heaptarget 0))1315 (! single->node target 0)) 1310 1316 (t 1311 1317 (with-imm-temps () (temp) … … 1321 1327 (cond ((= subtag ppc32::subtag-single-float-vector) 1322 1328 (! misc-ref-single-float 0 src idx-reg) 1323 (! single-> heaptarget 0))1329 (! single->node target 0)) 1324 1330 (t (with-imm-temps 1325 1331 (idx-reg) (temp) … … 1401 1407 (! trap-unless-typecode= src safe)) 1402 1408 (unless index-known-fixnum 1403 (! trap-unless- tag= unscaled-idx ppc32::tag-fixnum))1409 (! trap-unless-fixnum unscaled-idx)) 1404 1410 (! check-misc-bound unscaled-idx src)) 1405 1411 (if (and index-known-fixnum (<= index-known-fixnum ppc32::max-64-bit-constant-index)) … … 1445 1451 (ash 1 $arh_simple_bit)))) 1446 1452 (unless i-known-fixnum 1447 (! trap-unless- tag= unscaled-i ppc32::tag-fixnum))1453 (! trap-unless-fixnum unscaled-i)) 1448 1454 (unless j-known-fixnum 1449 (! trap-unless- tag= unscaled-j ppc32::tag-fixnum)))1455 (! trap-unless-fixnum unscaled-j))) 1450 1456 (with-imm-temps () (dim1 idx-reg) 1451 1457 (unless constidx … … 1513 1519 (ash 1 $arh_simple_bit)))) 1514 1520 (unless i-known-fixnum 1515 (! trap-unless- tag= unscaled-i ppc32::tag-fixnum))1521 (! trap-unless-fixnum unscaled-i)) 1516 1522 (unless j-known-fixnum 1517 (! trap-unless- tag= unscaled-j ppc32::tag-fixnum)))1523 (! trap-unless-fixnum unscaled-j))) 1518 1524 (with-imm-temps () (dim1 idx-reg) 1519 1525 (unless constidx … … 1566 1572 (! trap-unless-typecode= src safe)) 1567 1573 (unless index-known-fixnum 1568 (! trap-unless- tag= unscaled-idx ppc32::tag-fixnum))1574 (! trap-unless-fixnum unscaled-idx)) 1569 1575 (! check-misc-bound unscaled-idx src)) 1570 1576 (if (and index-known-fixnum (<= index-known-fixnum ppc32::max-32-bit-constant-index)) … … 1591 1597 (! trap-unless-typecode= src safe)) 1592 1598 (unless index-known-fixnum 1593 (! trap-unless- tag= unscaled-idx ppc32::tag-fixnum))1599 (! trap-unless-fixnum unscaled-idx)) 1594 1600 (! check-misc-bound unscaled-idx src)) 1595 1601 (if (and index-known-fixnum (<= index-known-fixnum ppc32::max-32-bit-constant-index)) … … 1618 1624 (! trap-unless-typecode= src safe)) 1619 1625 (unless index-known-fixnum 1620 (! trap-unless- tag= unscaled-idx ppc32::tag-fixnum))1626 (! trap-unless-fixnum unscaled-idx)) 1621 1627 (! check-misc-bound unscaled-idx src))) 1622 1628 (if (and index-known-fixnum … … 1705 1711 (! trap-unless-typecode= src safe)) 1706 1712 (unless index-known-fixnum 1707 (! trap-unless- tag= unscaled-idx ppc32::tag-fixnum))1713 (! trap-unless-fixnum unscaled-idx)) 1708 1714 (! check-misc-bound unscaled-idx src)) 1709 1715 (with-imm-temps () (temp) … … 1854 1860 (! trap-unless-typecode= src safe)) 1855 1861 (unless index-known-fixnum 1856 (! trap-unless- tag= unscaled-idx ppc32::tag-fixnum))1862 (! trap-unless-fixnum unscaled-idx)) 1857 1863 (! check-misc-bound unscaled-idx src)) 1858 1864 (if (and index-known-fixnum … … 1882 1888 (! trap-unless-typecode= src safe)) 1883 1889 (unless index-known-fixnum 1884 (! trap-unless- tag= unscaled-idx ppc32::tag-fixnum))1890 (! trap-unless-fixnum unscaled-idx)) 1885 1891 (! check-misc-bound unscaled-idx src)) 1886 1892 (if (and index-known-fixnum … … 2940 2946 (prog1 2941 2947 (! vpush-register src) 2942 (ppc2-new-vstack-lcell (or why :node) 4(or attr 0) info)2943 (ppc2-adjust-vstack +4))))2948 (ppc2-new-vstack-lcell (or why :node) *ppc2-target-lcell-size* (or attr 0) info) 2949 (ppc2-adjust-vstack *ppc2-target-node-size*)))) 2944 2950 2945 2951 (defun ppc2-vpush-register-arg (seg src) … … 2952 2958 (! vpop-register dest) 2953 2959 (setq *ppc2-top-vstack-lcell* (lcell-parent *ppc2-top-vstack-lcell*)) 2954 (ppc2-adjust-vstack -4))))2960 (ppc2-adjust-vstack (- *ppc2-target-node-size*))))) 2955 2961 2956 2962 (defun ppc2-copy-register (seg dest src) … … 3100 3106 (! double->heap dest src)) 3101 3107 (#.hard-reg-class-fpr-mode-single 3102 (! single-> heapdest src)))))3108 (! single->node dest src))))) 3103 3109 (if (and src-fpr dest-fpr) 3104 3110 (unless (eql dest-fpr src-fpr) … … 3363 3369 (! svar-bind))) 3364 3370 (ppc2-open-undo $undospecial) 3365 (ppc2-new-vstack-lcell :special-value 40 sym)3366 (ppc2-new-vstack-lcell :special 4(ash 1 $vbitspecial) sym)3367 (ppc2-new-vstack-lcell :special-link 40 sym)3368 (ppc2-adjust-vstack 12))))3371 (ppc2-new-vstack-lcell :special-value *ppc2-target-lcell-size* 0 sym) 3372 (ppc2-new-vstack-lcell :special *ppc2-target-lcell-size* (ash 1 $vbitspecial) sym) 3373 (ppc2-new-vstack-lcell :special-link *ppc2-target-lcell-size* 0 sym) 3374 (ppc2-adjust-vstack (* 3 *ppc2-target-node-size*))))) 3369 3375 3370 3376 ; Store the contents of EA - which denotes either a vframe location … … 3857 3863 (let* ((src (ppc2-one-untargeted-reg-form seg listform ppc::arg_z))) 3858 3864 (when safe 3859 (! trap-unless- tag= src ppc32::tag-list))3865 (! trap-unless-list src)) 3860 3866 (if vreg 3861 3867 (ensuring-node-target (target vreg) … … 3883 3889 (! trap-unless-typecode= src safe)) 3884 3890 (unless index-known-fixnum 3885 (! trap-unless- tag= unscaled-idx ppc32::tag-fixnum))3891 (! trap-unless-fixnum unscaled-idx)) 3886 3892 (! check-misc-bound unscaled-idx src)) 3887 3893 (when vreg … … 3912 3918 (! trap-unless-typecode= src safe)) 3913 3919 (unless index-known-fixnum 3914 (! trap-unless- tag= unscaled-idx ppc32::tag-fixnum))3920 (! trap-unless-fixnum unscaled-idx)) 3915 3921 (! check-misc-bound unscaled-idx src)) 3916 3922 (if (and index-known-fixnum (<= index-known-fixnum ppc32::max-32-bit-constant-index)) … … 4805 4811 (declare (fixnum flags nkeys nprev)) 4806 4812 (dotimes (i (the fixnum (+ nkeys nkeys))) 4807 (ppc2-new-vstack-lcell :reserved 40 nil))4813 (ppc2-new-vstack-lcell :reserved *ppc2-target-lcell-size* 0 nil)) 4808 4814 (! misc-ref-c-node ppc::temp3 ppc::nfn (1+ (backend-immediate-index keyvect))) 4809 4815 (ppc2-lwi seg ppc::imm2 (ash flags ppc32::fixnumshift)) … … 4866 4872 (! save-lisp-context-offset-ool nbytes-vpushed))) 4867 4873 (ppc2-set-vstack nbytes-vpushed) 4868 (setq optsupvloc (- *ppc2-vstack* ( ash num-opt 2)))))))4874 (setq optsupvloc (- *ppc2-vstack* (* num-opt *ppc2-target-node-size*))))))) 4869 4875 ;; Caller's context is saved; *ppc2-vstack* is valid. Might still have method-var 4870 4876 ;; to worry about. … … 5297 5303 (defppc2 ppc2-uvsize uvsize (seg vreg xfer v) 5298 5304 (let* ((misc-reg (ppc2-one-untargeted-reg-form seg v ppc::arg_z))) 5299 (unless *ppc2-reckless* (! trap-unless- tag= misc-reg ppc32::tag-misc))5305 (unless *ppc2-reckless* (! trap-unless-uvector misc-reg)) 5300 5306 (if vreg 5301 5307 (ensuring-node-target (target vreg) … … 5321 5327 (defppc2 ppc2-endp endp (seg vreg xfer cc form) 5322 5328 (let* ((formreg (ppc2-one-untargeted-reg-form seg form ppc::arg_z))) 5323 (! trap-unless- tag= formreg ppc32::tag-list)5329 (! trap-unless-list formreg) 5324 5330 (multiple-value-bind (cr-bit true-p) (acode-condition-to-ppc-cr-bit cc) 5325 5331 (ppc2-compare-register-to-nil seg vreg xfer formreg cr-bit true-p)))) … … 5865 5871 (let* ((nreg (ppc2-one-untargeted-reg-form seg n ppc::arg_z))) 5866 5872 (unless (acode-fixnum-form-p n) 5867 (! trap-unless- tag= nreg ppc32::tag-fixnum))5873 (! trap-unless-fixnum nreg)) 5868 5874 (ppc2-vpush-register seg nreg)) 5869 5875 (ppc2-multiple-value-body seg form) ; sets nargs … … 6058 6064 (multiple-value-bind (r1 r2) (ppc2-two-untargeted-reg-forms seg f0 r1 f1 r2) 6059 6065 (if (= (hard-regspec-class vreg) hard-reg-class-fpr) 6060 (let* ((vreg-val (hard-regspec-value vreg))) 6061 (declare (fixnum vreg-val)) 6062 (if (or (= vreg-val (hard-regspec-value r1)) 6063 (= vreg-val (hard-regspec-value r2))) 6064 (with-fp-target (r1 r2) (result :double-float) 6065 (! ,vinsn result r1 r2) 6066 (<- result)) 6067 (! ,vinsn vreg r1 r2))) 6066 (! ,vinsn vreg r1 r2) 6068 6067 (with-fp-target (r1 r2) (result :double-float) 6069 6068 (! ,vinsn result r1 r2) … … 6082 6081 (multiple-value-bind (r1 r2) (ppc2-two-untargeted-reg-forms seg f0 r1 f1 r2) 6083 6082 (if (= (hard-regspec-class vreg) hard-reg-class-fpr) 6084 (let* ((vreg-val (hard-regspec-value vreg))) 6085 (declare (fixnum vreg-val)) 6086 (if (or (= vreg-val (hard-regspec-value r1)) 6087 (= vreg-val (hard-regspec-value r2))) 6088 (with-fp-target (r1 r2) (result :single-float) 6089 (! ,vinsn result r1 r2) 6090 (<- result)) 6091 (! ,vinsn vreg r1 r2))) 6083 (! ,vinsn vreg r1 r2) 6092 6084 (with-fp-target (r1 r2) (result :single-float) 6093 6085 (! ,vinsn result r1 r2) … … 7780 7772 (old-stack (ppc2-encode-stack))) 7781 7773 (ecase (backend-name *target-backend*) 7782 (:linuxppc (! alloc-eabi-c-frame 0))7783 (:darwinppc (! alloc-c-frame 0)))7774 (:linuxppc32 (! alloc-eabi-c-frame 0)) 7775 (:darwinppc32 (! alloc-c-frame 0))) 7784 7776 (ppc2-open-undo $undo-ppc-c-frame) 7785 7777 (ppc2-undo-body seg vreg xfer body old-stack))
Note:
See TracChangeset
for help on using the changeset viewer.
