Changeset 11392


Ignore:
Timestamp:
Nov 18, 2008, 8:24:19 PM (11 years ago)
Author:
gb
Message:

Propagate some expression-evaluation/register-targeting changes
form the x86 backend here.

Start using some parts of the new (nx2) layer.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/compiler/PPC/ppc2.lisp

    r11383 r11392  
    177177
    178178(defvar *ppc2-result-reg* ppc::arg_z)
     179
     180(defvar *ppc2-nvrs* `(,ppc::save0 ,ppc::save1 ,ppc::save2 ,ppc::save3
     181                      ,ppc::save4 ,ppc::save5 ,ppc::save6 ,ppc::save7))
    179182
    180183
     
    657660
    658661
    659 (defun %ppc2-bigger-cdr-than (x y)
    660   (declare (cons x y))
    661   (> (the fixnum (cdr x)) (the fixnum (cdr y))))
    662 
    663 ;;; Return an unordered list of "varsets": each var in a varset can be
    664 ;;; assigned a register and all vars in a varset can be assigned the
    665 ;;; same register (e.g., no scope conflicts.)
    666 
    667 (defun ppc2-partition-vars (vars)
    668   (labels ((var-weight (var)
    669              (let* ((bits (nx-var-bits var)))
    670                (declare (fixnum bits))
    671                (if (eql 0 (logand bits (logior
    672                                         (ash 1 $vbitpuntable)
    673                                         (ash -1 $vbitspecial)
    674                                         (ash 1 $vbitnoreg))))
    675                  (if (eql (logior (ash 1 $vbitclosed) (ash 1 $vbitsetq))
    676                           (logand bits (logior (ash 1 $vbitclosed) (ash 1 $vbitsetq))))
    677                    0
    678                    (%i+ (%ilogand $vrefmask bits) (%ilsr 8 (%ilogand $vsetqmask bits))))
    679                  0)))
    680            (sum-weights (varlist)
    681              (let ((sum 0))
    682                (dolist (v varlist sum) (incf sum (var-weight v)))))
    683            (vars-disjoint-p (v1 v2)
    684              (if (eq v1 v2)
    685                nil
    686                (if (memq v1 (var-binding-info v2))
    687                  nil
    688                  (if (memq v2 (var-binding-info v1))
    689                    nil
    690                    t)))))
    691     (setq vars (%sort-list-no-key
    692                 ;(delete-if #'(lambda (v) (eql (var-weight v) 0)) vars)
    693                 (do* ((handle (cons nil vars))
    694                       (splice handle))
    695                      ((null (cdr splice)) (cdr handle))                 
    696                   (declare (dynamic-extent handle) (type cons handle splice))
    697                   (if (eql 0 (var-weight (%car (cdr splice))))
    698                     (rplacd splice (%cdr (cdr splice)))
    699                     (setq splice (cdr splice))))
    700                 #'(lambda (v1 v2) (%i> (var-weight v1) (var-weight v2)))))
    701     ; This isn't optimal.  It partitions all register-allocatable variables into sets such that
    702     ; 1) no variable is a member of more than one set and
    703     ; 2) all variables in a given set are disjoint from each other
    704     ; A set might have exactly one member.
    705     ; If a register is allocated for any member of a set, it's allocated for all members of that
    706     ; set.
    707     (let* ((varsets nil))
    708       (do* ((all vars (cdr all)))
    709            ((null all))
    710         (let* ((var (car all)))
    711           (when (dolist (already varsets t)
    712                   (when (memq var (car already)) (return)))
    713             (let* ((varset (cons var nil)))
    714               (dolist (v (cdr all))
    715                 (when (dolist (already varsets t)
    716                         (when (memq v (car already)) (return)))
    717                   (when (dolist (d varset t)
    718                           (unless (vars-disjoint-p v d) (return)))
    719                     (push v varset))))
    720               (let* ((weight (sum-weights varset)))
    721                 (declare (fixnum weight))
    722                 (if (>= weight 3)
    723                   (push (cons (nreverse varset) weight) varsets)))))))
    724       varsets)))
    725 
    726 ;;; Maybe globally allocate registers to symbols naming functions & variables,
    727 ;;; and to simple lexical variables.
    728 (defun ppc2-allocate-global-registers (fcells vcells all-vars no-regs)
    729   (if no-regs
    730     (progn
    731       (dolist (c fcells) (%rplacd c nil))
    732       (dolist (c vcells) (%rplacd c nil))
    733       (values 0 nil))
    734     (let* ((maybe (ppc2-partition-vars all-vars)))
    735       (dolist (c fcells)
    736         (if (>= (the fixnum (cdr c)) 3) (push c maybe)))
    737       (dolist (c vcells)
    738         (if (>= (the fixnum (cdr c)) 3) (push c maybe)))
    739       (do* ((things (%sort-list-no-key maybe #'%ppc2-bigger-cdr-than) (cdr things))
    740             (n 0 (1+ n))
    741             (regno ppc::save0 (1- regno))
    742             (constant-alist ()))
    743            ((or (null things) (= n $numppcsaveregs))
    744             (dolist (cell fcells) (%rplacd cell nil))
    745             (dolist (cell vcells) (%rplacd cell nil))
    746             (values n constant-alist))
    747         (declare (list things)
    748                  (fixnum n regno))
    749         (let* ((thing (car things)))
    750           (if (or (memq thing fcells)
    751                   (memq thing vcells))
    752             (push (cons thing regno) constant-alist)
    753             (dolist (var (car thing))
    754               (nx-set-var-bits var
    755                                (%ilogior (%ilogand (%ilognot $vrefmask) (nx-var-bits var))
    756                                  regno
    757                                  (%ilsl $vbitreg 1))))))))))
     662
     663
     664
    758665         
    759666   
     
    805712      (ppc2-set-var-ea seg arg (var-ea arg))
    806713      (let* ((lcell (pop lcells)))
    807         (if (setq reg (ppc2-assign-register-var arg))
    808           (ppc2-init-regvar seg arg reg (ppc2-vloc-ea vloc))
     714        (if (setq reg (nx2-assign-register-var arg))
     715          (progn
     716            (break "Inherited var in NVR: ~s/~s" arg (var-name arg))
     717            (ppc2-init-regvar seg arg reg (ppc2-vloc-ea vloc)))
    809718          (ppc2-bind-var seg arg vloc lcell))
    810719        (setq vloc (%i+ vloc *ppc2-target-node-size*)))))
     
    813722      (ppc2-set-var-ea seg arg (var-ea arg))
    814723      (let* ((lcell (pop lcells)))
    815         (if (setq reg (ppc2-assign-register-var arg))
     724        (if (setq reg (nx2-assign-register-var arg))
    816725          (ppc2-init-regvar seg arg reg (ppc2-vloc-ea vloc))
    817726          (ppc2-bind-var seg arg vloc lcell))
     
    826735          (ppc2-set-var-ea seg var (var-ea var))
    827736          (let* ((lcell (pop lcells)))
    828             (if (setq reg (ppc2-assign-register-var var))
     737            (if (setq reg (nx2-assign-register-var var))
    829738              (ppc2-init-regvar seg var reg (ppc2-vloc-ea vloc))
    830739              (ppc2-bind-var seg var vloc lcell))
     
    833742    (if lexpr
    834743      (progn
    835         (if (setq reg (ppc2-assign-register-var rest))
     744        (if (setq reg (nx2-assign-register-var rest))
    836745          (progn
    837746            (ppc2-load-lexpr-address seg reg)
     
    844753              (ppc2-bind-var seg rest loc *ppc2-top-vstack-lcell*)))))
    845754      (let* ((rvloc (+ vloc (* 2 *ppc2-target-node-size* nkeys))))
    846         (if (setq reg (ppc2-assign-register-var rest))
     755        (if (setq reg (nx2-assign-register-var rest))
    847756          (ppc2-init-regvar seg rest reg (ppc2-vloc-ea rvloc))
    848757          (ppc2-bind-var seg rest rvloc (pop lcells))))))
     
    858767             (lcell (pop lcells))
    859768             (splcell (pop splcells))
    860              (reg (ppc2-assign-register-var var))
     769             (reg (nx2-assign-register-var var))
    861770             (sp-reg ($ ppc::arg_z))
    862771             (regloadedlabel (if reg (backend-get-next-label))))
     
    876785          (ppc2-bind-var seg var vloc lcell))
    877786        (when spvar
    878           (if (setq reg (ppc2-assign-register-var spvar))
     787          (if (setq reg (nx2-assign-register-var spvar))
    879788            (ppc2-init-regvar seg spvar reg (ppc2-vloc-ea spvloc))
    880789            (ppc2-bind-var seg spvar spvloc splcell))))
     
    888797      (let* ((spvar (pop keysupp))
    889798             (initform (pop keyinits))
    890              (reg (ppc2-assign-register-var var))
     799             (reg (nx2-assign-register-var var))
    891800             (regloadedlabel (if reg (backend-get-next-label)))
    892801             (var-lcell (pop lcells))
     
    909818          (ppc2-bind-var seg var vloc var-lcell))
    910819        (when spvar
    911           (if (setq reg (ppc2-assign-register-var spvar))
     820          (if (setq reg (nx2-assign-register-var spvar))
    912821            (ppc2-init-regvar seg spvar reg (ppc2-vloc-ea sploc))
    913822            (ppc2-bind-var seg spvar sploc sp-lcell))))
     
    918827(defun ppc2-vpush-arg-register (seg reg var)
    919828  (when var
    920     (let* ((bits (nx-var-bits var)))
    921       (declare (fixnum bits))
    922       (if (logbitp $vbitreg bits)
    923         var
    924         (progn
    925           (ppc2-vpush-register seg reg :reserved)
    926           nil)))))
     829    (if (var-nvr var)
     830      var
     831      (progn
     832        (ppc2-vpush-register seg reg :reserved)
     833        nil))))
    927834
    928835
     
    12481155    (with-ppc-local-vinsn-macros (seg)
    12491156      (! set-nargs n))))
    1250 
    1251 (defun ppc2-assign-register-var (v)
    1252   (let ((bits (nx-var-bits v)))
    1253     (when (%ilogbitp $vbitreg bits)
    1254       (%ilogand bits $vrefmask))))
    12551157
    12561158(defun ppc2-single-float-bits (the-sf)
     
    22712173                                              value result-reg))
    22722174              (t
    2273                (setq result-reg (ppc2-target-reg-for-aset vreg type-keyword))
    2274                (ppc2-three-targeted-reg-forms seg
     2175               (multiple-value-setq (src unscaled-idx result-reg)
     2176                 (ppc2-three-untargeted-reg-forms seg
    22752177                                              vector src
    22762178                                              index unscaled-idx
    2277                                               value result-reg)))
     2179                                              value (ppc2-target-reg-for-aset vreg type-keyword)))))
    22782180        (when safe
    22792181          (let* ((*available-backend-imm-temps* *available-backend-imm-temps*)
     
    28562758(defun ppc2-acc-reg-for (reg)
    28572759  (with-ppc-local-vinsn-macros (seg)
    2858     (let* ((class (hard-regspec-class reg))
    2859            (mode (get-regspec-mode reg)))
    2860       (declare (fixnum class mode))
    2861       (cond ((= class hard-reg-class-fpr)
    2862              (make-wired-lreg ppc::fp1 :class class :mode mode))
    2863             ((= class hard-reg-class-gpr)
    2864              (if (= mode hard-reg-class-gpr-mode-node)
    2865                ($ ppc::arg_z)
    2866                (make-wired-lreg ppc::imm0 :mode mode)))
    2867             (t (compiler-bug "Unknown register class for reg ~s" reg))))))
     2760    (if (and (eql (hard-regspec-class reg) hard-reg-class-gpr)
     2761             (eql (get-regspec-mode reg) hard-reg-class-gpr-mode-node))
     2762      ($ ppc::arg_z)
     2763      reg)))
    28682764
    28692765;;; The compiler often generates superfluous pushes & pops.  Try to
     
    38593755              (progn
    38603756                (let* ((vloc *ppc2-vstack*)
    3861                        (reg (let* ((r (ppc2-assign-register-var var)))
     3757                       (reg (let* ((r (nx2-assign-register-var var)))
    38623758                              (if r ($ r)))))
    38633759                  (if (ppc2-load-ea-p val)
     
    49584854(defun ppc2-bind-structured-var (seg var vloc lcell &optional context)
    49594855  (if (not (ppc2-structured-var-p var))
    4960     (let* ((reg (ppc2-assign-register-var var)))
     4856    (let* ((reg (nx2-assign-register-var var)))
    49614857      (if reg
    49624858        (ppc2-init-regvar seg var reg (ppc2-vloc-ea vloc))
     
    53665262              (setq no-regs (%ilogbitp $fbitnoregs fbits)))
    53675263        (multiple-value-setq (pregs reglocatives)
    5368           (ppc2-allocate-global-registers *ppc2-fcells* *ppc2-vcells* (afunc-all-vars afunc) no-regs))
     5264          (nx2-allocate-global-registers *ppc2-fcells* *ppc2-vcells* (afunc-all-vars afunc) inherited-vars (unless no-regs *ppc2-nvrs*)))
    53695265        (@ (backend-get-next-label)) ; generic self-reference label, should be label #1
    53705266        (when keys ;; Ensure keyvect is the first immediate
     
    55075403              (let* ((var (car vars)))
    55085404                (when var
    5509                   (let* ((reg (ppc2-assign-register-var var)))
     5405                  (let* ((reg (nx2-assign-register-var var)))
    55105406                    (ppc2-copy-register seg reg arg-reg-num)
    55115407                    (setf (var-ea var) reg))))))
     
    69116807        (dolist (var vars)
    69126808          (let* ((lcell (pop lcells))
    6913                  (reg (ppc2-assign-register-var var)))
     6809                 (reg (nx2-assign-register-var var)))
    69146810            (if reg
    69156811              (ppc2-init-regvar seg var reg (ppc2-vloc-ea vloc))
     
    74527348        (setq val (%car valcopy))
    74537349        (cond ((or (%ilogbitp $vbitspecial (setq bits (nx-var-bits var)))
    7454                    (and (%ilogbitp $vbitreg bits)
     7350                   (and (var-nvr var)
    74557351                        (dolist (val (%cdr valcopy))
    74567352                          (unless (ppc2-trivial-p val) (return t)))))
Note: See TracChangeset for help on using the changeset viewer.