Changeset 15041

Timestamp:

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

Author:

Gary Byers

Message:

Work in progress.

File:

• trunk/source/compiler/X86/x862.lisp (modified) (14 diffs)

trunk/source/compiler/X86/x862.lisp

@@ -1477 +1477 @@
           (return reg))))))
 
+(defun x862-existing-reg-for-var (var)
+  (let* ((ea (var-ea var)))
+    (if (and (memory-spec-p ea)
+             (not (addrspec-vcell-p ea)))
+      (let* ((offset (memspec-frame-address-offset ea))
+             (mask *x862-gpr-locations-valid-mask*)
+             (info *x862-gpr-locations*))
+        (declare (fixnum mask) (simple-vector info))
+        (dotimes (reg 16)
+          (when (and (logbitp reg mask)
+                     (memq offset (svref info reg)))
+            (return reg))))
+      (if (register-spec-p ea)
+        ea))))
 
 (defun x862-reg-for-form (form hint)
@@ -1482 +1496 @@
     (cond ((node-reg-p hint)
            (if var
-             (let* ((ea (var-ea var)))
-               (if (and (memory-spec-p ea)
-                          (not (addrspec-vcell-p ea)))
-                 (let* ((offset (memspec-frame-address-offset ea))
-                        (mask *x862-gpr-locations-valid-mask*)
-                        (info *x862-gpr-locations*))
-                   (declare (fixnum mask) (simple-vector info))
-                   (dotimes (reg 16)
-                     (when (and (logbitp reg mask)
-                                (memq offset (svref info reg)))
-                       (return reg))))
-                 (if (register-spec-p ea)
-                   ea)))
+             (x862-existing-reg-for-var var)
              (if (acode-p (setq form (acode-unwrapped-form form)))
                (let* ((op (acode-operator form)))
@@ -3350 +3352 @@
                               address-reg))
 
+(defun x862-push-reg-for-form (seg form suggested)
+  (let* ((reg (if (and (node-reg-p suggested)
+                         (nx2-acode-call-p form))     ;probably ...
+                (x862-one-targeted-reg-form seg form *x862-arg-z*)
+                (x862-one-untargeted-reg-form seg form suggested))))
+    (x862-push-register seg reg)))
 
 (defun x862-one-lreg-form (seg form lreg)
@@ -3586 +3594 @@
         (if atriv
           (x862-one-targeted-reg-form seg aform areg)
-          (setq apushed (x862-push-register
-                         seg
-                         (x862-one-untargeted-reg-form seg aform areg)))))
+          (setq apushed (x862-push-reg-for-form seg aform areg))))
       (x862-one-targeted-reg-form seg bform breg)
       (if aconst
@@ -3616 +3622 @@
               (when (same-x86-reg-p adest breg)
                 (setq breg areg)))
-            (setq apushed (x862-push-register
-                           seg
-                           (x862-one-untargeted-reg-form seg aform areg restricted)
-                           t))))
+            (setq apushed (x862-push-reg-for-form seg aform areg))))
         (unless (eql restricted-by-caller 0)
           (setq *x862-gpr-locations-valid-mask* (logandc2 *x862-gpr-locations-valid-mask* restricted-by-caller)))
@@ -3663 +3666 @@
       (if atriv
         (x862-one-targeted-reg-form seg aform areg)
-        (setq apushed (x862-push-register
-                       seg
-                       (x862-one-targeted-reg-form seg aform areg)))))
+        (setq apushed (x862-push-reg-for-form seg aform areg))))
     (if (and bform (not bconst))
       (if btriv
         (x862-one-targeted-reg-form seg bform breg)
-        (setq bpushed (x862-push-register
-                       seg
-                       (x862-one-targeted-reg-form seg bform breg)))))
+        (setq bpushed (x862-push-reg-for-form seg bform breg))))
     (x862-one-targeted-reg-form seg cform creg)
     (unless btriv 
@@ -3727 +3726 @@
       (if atriv
         (x862-one-targeted-reg-form seg aform areg)
-        (setq apushed (x862-push-register seg (x862-one-targeted-reg-form seg aform areg)))))
+        (setq apushed (x862-push-reg-for-form seg aform areg))))
     (if (and bform (not bconst))
       (if btriv
         (x862-one-targeted-reg-form seg bform breg)
-        (setq bpushed (x862-push-register seg (x862-one-targeted-reg-form seg bform breg)))))
+        (setq bpushed (x862-push-reg-for-form seg bform breg))))
     (if (and cform (not cconst))
       (if ctriv
         (x862-one-targeted-reg-form seg cform creg)
-        (setq cpushed (x862-push-register seg (x862-one-targeted-reg-form seg cform creg)))))
+        (setq cpushed (x862-push-reg-for-form seg cform creg))))
     (x862-one-targeted-reg-form seg dform dreg)
     (unless ctriv
@@ -3788 +3787 @@
             (when (same-x86-reg-p adest creg)
               (setq creg areg)))
-          (setq apushed (x862-push-register
-                         seg
-                         (x862-one-untargeted-reg-form seg aform areg)))))
+          (setq apushed (x862-push-reg-for-form seg aform areg))))
       (when (and bform (not bconst))
         (if btriv
@@ -3801 +3798 @@
             (when (same-x86-reg-p bdest creg)
               (setq creg breg)))
-          (setq bpushed (x862-push-register
-                         seg (x862-one-untargeted-reg-form seg bform breg)))))
+          (setq bpushed (x862-push-reg-for-form seg bform breg))))
       (setq cdest (x862-one-untargeted-reg-form seg cform creg restricted)
             restricted (x862-restrict-node-target cdest restricted))
@@ -3878 +3874 @@
           (when (same-x86-reg-p dreg adest)
             (setq dreg areg)))
-        (setq apushed (x862-push-register seg (x862-one-untargeted-reg-form seg aform areg)))))
+        (setq apushed (x862-push-reg-for-form seg aform areg))))
     (when (and bform (not bconst))
       (if btriv
@@ -3891 +3887 @@
           (when (same-x86-reg-p dreg bdest)
             (setq dreg breg)))
-        (setq bpushed (x862-push-register seg (x862-one-untargeted-reg-form seg bform breg)))))
+        (setq bpushed (x862-push-reg-for-form seg  bform breg))))
     (when (and cform (not cconst))
       (if ctriv
@@ -3905 +3901 @@
           (when (same-x86-reg-p cdest dreg)
             (setq dreg creg)))
-        (setq cpushed (x862-push-register seg (x862-one-untargeted-reg-form seg cform creg)))))
+        (setq cpushed (x862-push-reg-for-form seg cform creg))))
     (setq ddest (x862-one-untargeted-reg-form seg dform dreg restricted)
           restricted (x862-restrict-node-target ddest restricted))
@@ -4052 +4048 @@
           (x862-compare-u8 seg vreg xfer u8-operand u8 (if (and iu8 (not (eq cr-bit x86::x86-e-bits))) (logxor 1 cr-bit) cr-bit) true-p u8-operator)
           (if (and boolean (or js32 is32))
-            (let* ((ea (x862-lexical-reference-ea (if js32 i j)))
-                   (offset (and ea (memory-spec-p ea) (memspec-frame-address-offset ea)))
+            (let* ((form (if js32 i j))
+                   (var (nx2-lexical-reference-p form))
+                   (ea (when var
+                         (unless (x862-existing-reg-for-var var) (var-ea var))))
+                   (offset (and ea
+                                (memory-spec-p ea)
+                                (not (addrspec-vcell-p ea))
+                                (memspec-frame-address-offset ea)))
                    (reg (unless offset (x862-one-untargeted-reg-form seg (if js32 i j) *x862-arg-z*)))
                    (constant (or js32 is32)))
@@ -6503 +6505 @@
               (setq no-regs (%ilogbitp $fbitnoregs fbits)))
         (multiple-value-setq (pregs reglocatives) 
-          (nx2-allocate-global-registers
-           *x862-fcells*
-           *x862-vcells*
-           (afunc-all-vars afunc)
-           inherited-vars
+          (nx2-afunc-allocate-global-registers
+           afunc
            (unless no-regs
              (target-arch-case