Changeset 15037

Timestamp:

Oct 24, 2011, 4:03:57 AM (13 years ago)

Author:

Gary Byers

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:

• ARM/arm2.lisp (modified) (1 diff)
• PPC/ppc2.lisp (modified) (1 diff)
• nx2.lisp (modified) (3 diffs)

trunk/source/compiler/ARM/arm2.lisp

@@ -5412 +5412 @@
         (multiple-value-setq (pregs reglocatives) 
          
-          (nx2-allocate-global-registers *arm2-fcells* *arm2-vcells* (afunc-all-vars afunc) inherited-vars (unless no-regs *arm2-nvrs*)))
+          (nx2-afunc-allocate-global-registers afunc (unless no-regs *arm2-nvrs*)))
         (@ (backend-get-next-label)) ; generic self-reference label, should be label #1
         (when keys ;; Ensure keyvect is the first immediate

trunk/source/compiler/PPC/ppc2.lisp

@@ -5273 +5273 @@
               (setq no-regs (%ilogbitp $fbitnoregs fbits)))
         (multiple-value-setq (pregs reglocatives) 
-          (nx2-allocate-global-registers *ppc2-fcells* *ppc2-vcells* (afunc-all-vars afunc) inherited-vars (unless no-regs *ppc2-nvrs*)))
+          (nx2-afunc-allocate-global-registers (unless no-regs *ppc2-nvrs*)))
         (@ (backend-get-next-label)) ; generic self-reference label, should be label #1
         (when keys ;; Ensure keyvect is the first immediate

trunk/source/compiler/nx2.lisp

@@ -24 +24 @@
   (> (cdr x) (cdr y)))
 
+
 ;;; Return an unordered list of "varsets": each var in a varset can be
 ;;; assigned a register and all vars in a varset can be assigned the
 ;;; same register (e.g., no scope conflicts.)
 
-(defun nx2-partition-vars (vars inherited-vars)
+(defun nx2-partition-vars (vars inherited-vars &optional (afunc-flags 0))
+  (declare (ignorable afunc-flags))
   (labels ((var-weight (var)
              (let* ((bits (nx-var-bits var)))
@@ -93 +95 @@
 ;;; Maybe globally allocate registers to symbols naming functions & variables,
 ;;; and to simple lexical variables.
-(defun nx2-allocate-global-registers (fcells vcells all-vars inherited-vars nvrs)
-  (if (null nvrs)
-    (progn
-      (dolist (c fcells) (%rplacd c nil))
-      (dolist (c vcells) (%rplacd c nil))
-      (values 0 nil))
-    (let* ((maybe (nx2-partition-vars all-vars inherited-vars)))
-      (dolist (c fcells) 
-        (if (>= (the fixnum (cdr c)) 3) (push c maybe)))
-      (dolist (c vcells) 
-        (if (>= (the fixnum (cdr c)) 3) (push c maybe)))
-      (do* ((things (%sort-list-no-key maybe #'nx2-bigger-cdr-than) (cdr things))
-            (n 0 (1+ n))
-            (registers nvrs)
-            (regno (pop registers) (pop registers))
-            (constant-alist ()))
-           ((or (null things) (null regno))
-            (dolist (cell fcells) (%rplacd cell nil))
-            (dolist (cell vcells) (%rplacd cell nil))
-            (values n constant-alist))
-        (declare (list things)
-                 (fixnum n regno))
-        (let* ((thing (car things)))
-          (if (or (memq thing fcells)
-                  (memq thing vcells))
-            (push (cons thing regno) constant-alist)
-            (dolist (var (car thing))
-              (setf (var-nvr var) regno))))))))
+(defun nx2-afunc-allocate-global-registers (afunc nvrs)
+  (let* ((vcells (afunc-vcells afunc))
+         (fcells (afunc-fcells afunc))
+         (all-vars (afunc-all-vars afunc))
+         (inherited-vars (afunc-inherited-vars afunc)))
+    (if (null nvrs)
+      (progn
+        (dolist (c fcells) (%rplacd c nil))
+        (dolist (c vcells) (%rplacd c nil))
+        (values 0 nil))
+      (let* ((maybe (nx2-partition-vars
+                     all-vars
+                     inherited-vars
+                     (afunc-bits afunc))))
+        (dolist (c fcells) 
+          (if (>= (the fixnum (cdr c)) 3) (push c maybe)))
+        (dolist (c vcells) 
+          (if (>= (the fixnum (cdr c)) 3) (push c maybe)))
+        (do* ((things (%sort-list-no-key maybe #'nx2-bigger-cdr-than) (cdr things))
+              (n 0 (1+ n))
+              (registers nvrs)
+              (regno (pop registers) (pop registers))
+              (constant-alist ()))
+             ((or (null things) (null regno))
+              (dolist (cell fcells) (%rplacd cell nil))
+              (dolist (cell vcells) (%rplacd cell nil))
+              (values n constant-alist))
+          (declare (list things)
+                   (fixnum n regno))
+          (let* ((thing (car things)))
+            (if (or (memq thing fcells)
+                    (memq thing vcells))
+              (push (cons thing regno) constant-alist)
+              (dolist (var (car thing))
+                (setf (var-nvr var) regno)))))))))
 
 (defun nx2-assign-register-var (v)
@@ -171 +180 @@
                 (eq op (%nx1-operator inherited-arg)))
         (%cadr form)))))
+
+(defun nx2-acode-call-p (form)
+  (when (acode-p form)
+    (let ((op (acode-operator (acode-unwrapped-form-value form))))
+      (or (eq op (%nx1-operator multiple-value-call))
+          (eq op (%nx1-operator call))
+          (eq op (%nx1-operator lexical-function-call))
+          (eq op (%nx1-operator self-call))
+          (eq op (%nx1-operator builtin-call))))))
+          
+  
 
 ;;; Returns true iff lexical variable VAR isn't setq'ed in FORM.