Changeset 15037


Ignore:
Timestamp:
Oct 24, 2011, 11:03:57 AM (8 years ago)
Author:
gb
Message:

Replace (NX2-ALLOCATE-GLOBAL-REGISTERS ,@several-afunc-slot-values)
with a variant that takes an afunc as an argument, change callers.

NX2-ACODE-CALL-P returns true if an acode form looks like some kind
of function call.

Location:
trunk/source/compiler
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/compiler/ARM/arm2.lisp

    r15016 r15037  
    54125412        (multiple-value-setq (pregs reglocatives)
    54135413         
    5414           (nx2-allocate-global-registers *arm2-fcells* *arm2-vcells* (afunc-all-vars afunc) inherited-vars (unless no-regs *arm2-nvrs*)))
     5414          (nx2-afunc-allocate-global-registers afunc (unless no-regs *arm2-nvrs*)))
    54155415        (@ (backend-get-next-label)) ; generic self-reference label, should be label #1
    54165416        (when keys ;; Ensure keyvect is the first immediate
  • trunk/source/compiler/PPC/ppc2.lisp

    r15017 r15037  
    52735273              (setq no-regs (%ilogbitp $fbitnoregs fbits)))
    52745274        (multiple-value-setq (pregs reglocatives)
    5275           (nx2-allocate-global-registers *ppc2-fcells* *ppc2-vcells* (afunc-all-vars afunc) inherited-vars (unless no-regs *ppc2-nvrs*)))
     5275          (nx2-afunc-allocate-global-registers (unless no-regs *ppc2-nvrs*)))
    52765276        (@ (backend-get-next-label)) ; generic self-reference label, should be label #1
    52775277        (when keys ;; Ensure keyvect is the first immediate
  • trunk/source/compiler/nx2.lisp

    r15006 r15037  
    2424  (> (cdr x) (cdr y)))
    2525
     26
    2627;;; Return an unordered list of "varsets": each var in a varset can be
    2728;;; assigned a register and all vars in a varset can be assigned the
    2829;;; same register (e.g., no scope conflicts.)
    2930
    30 (defun nx2-partition-vars (vars inherited-vars)
     31(defun nx2-partition-vars (vars inherited-vars &optional (afunc-flags 0))
     32  (declare (ignorable afunc-flags))
    3133  (labels ((var-weight (var)
    3234             (let* ((bits (nx-var-bits var)))
     
    9395;;; Maybe globally allocate registers to symbols naming functions & variables,
    9496;;; and to simple lexical variables.
    95 (defun nx2-allocate-global-registers (fcells vcells all-vars inherited-vars nvrs)
    96   (if (null nvrs)
    97     (progn
    98       (dolist (c fcells) (%rplacd c nil))
    99       (dolist (c vcells) (%rplacd c nil))
    100       (values 0 nil))
    101     (let* ((maybe (nx2-partition-vars all-vars inherited-vars)))
    102       (dolist (c fcells)
    103         (if (>= (the fixnum (cdr c)) 3) (push c maybe)))
    104       (dolist (c vcells)
    105         (if (>= (the fixnum (cdr c)) 3) (push c maybe)))
    106       (do* ((things (%sort-list-no-key maybe #'nx2-bigger-cdr-than) (cdr things))
    107             (n 0 (1+ n))
    108             (registers nvrs)
    109             (regno (pop registers) (pop registers))
    110             (constant-alist ()))
    111            ((or (null things) (null regno))
    112             (dolist (cell fcells) (%rplacd cell nil))
    113             (dolist (cell vcells) (%rplacd cell nil))
    114             (values n constant-alist))
    115         (declare (list things)
    116                  (fixnum n regno))
    117         (let* ((thing (car things)))
    118           (if (or (memq thing fcells)
    119                   (memq thing vcells))
    120             (push (cons thing regno) constant-alist)
    121             (dolist (var (car thing))
    122               (setf (var-nvr var) regno))))))))
     97(defun nx2-afunc-allocate-global-registers (afunc nvrs)
     98  (let* ((vcells (afunc-vcells afunc))
     99         (fcells (afunc-fcells afunc))
     100         (all-vars (afunc-all-vars afunc))
     101         (inherited-vars (afunc-inherited-vars afunc)))
     102    (if (null nvrs)
     103      (progn
     104        (dolist (c fcells) (%rplacd c nil))
     105        (dolist (c vcells) (%rplacd c nil))
     106        (values 0 nil))
     107      (let* ((maybe (nx2-partition-vars
     108                     all-vars
     109                     inherited-vars
     110                     (afunc-bits afunc))))
     111        (dolist (c fcells)
     112          (if (>= (the fixnum (cdr c)) 3) (push c maybe)))
     113        (dolist (c vcells)
     114          (if (>= (the fixnum (cdr c)) 3) (push c maybe)))
     115        (do* ((things (%sort-list-no-key maybe #'nx2-bigger-cdr-than) (cdr things))
     116              (n 0 (1+ n))
     117              (registers nvrs)
     118              (regno (pop registers) (pop registers))
     119              (constant-alist ()))
     120             ((or (null things) (null regno))
     121              (dolist (cell fcells) (%rplacd cell nil))
     122              (dolist (cell vcells) (%rplacd cell nil))
     123              (values n constant-alist))
     124          (declare (list things)
     125                   (fixnum n regno))
     126          (let* ((thing (car things)))
     127            (if (or (memq thing fcells)
     128                    (memq thing vcells))
     129              (push (cons thing regno) constant-alist)
     130              (dolist (var (car thing))
     131                (setf (var-nvr var) regno)))))))))
    123132
    124133(defun nx2-assign-register-var (v)
     
    171180                (eq op (%nx1-operator inherited-arg)))
    172181        (%cadr form)))))
     182
     183(defun nx2-acode-call-p (form)
     184  (when (acode-p form)
     185    (let ((op (acode-operator (acode-unwrapped-form-value form))))
     186      (or (eq op (%nx1-operator multiple-value-call))
     187          (eq op (%nx1-operator call))
     188          (eq op (%nx1-operator lexical-function-call))
     189          (eq op (%nx1-operator self-call))
     190          (eq op (%nx1-operator builtin-call))))))
     191         
     192 
    173193
    174194;;; Returns true iff lexical variable VAR isn't setq'ed in FORM.
Note: See TracChangeset for help on using the changeset viewer.