Changeset 14302

Timestamp:

Sep 25, 2010, 2:49:11 PM (14 years ago)

Author:

Gary Byers

Message:

Avoid register conflicts in ARM2-TWO-TARGETED-REG-FORMS, especially
when imm regs are involved and unboxing may be. (Similar functions
have the same issue, but this is currently the only variant that's
used to get multiple values into imm regs.)

Fix various problems in %NATURAL-LOGAND, %NATURAL-LOGIOR,
%NATURAL-LOGXOR. Note that there's a little bit of asymmetry: a
complemented ARM constant can be used with an AND instruction
(and becomes a BIC), but there aren't variants of ORR or EOR that
allow this transform.

Fixes ticket:747.

File:

• trunk/source/compiler/ARM/arm2.lisp (modified) (8 diffs)

trunk/source/compiler/ARM/arm2.lisp

@@ -2805 +2805 @@
          (aconst (and (not atriv) (or (arm-side-effect-free-form-p aform)
                                       (if avar (arm2-var-not-set-by-form-p avar bform)))))
-         (apushed (not (or atriv aconst))))
+         (apushed))
     (progn
       (unless aconst
@@ -2813 +2813 @@
       (arm2-one-targeted-reg-form seg bform breg)
       (if aconst
-        (arm2-one-targeted-reg-form seg aform areg)
+        (let* ((*available-backend-imm-temps* *available-backend-imm-temps*)
+               (*available-backend-node-temps* *available-backend-node-temps*)
+               (*available-backend-fp-temps* *available-backend-fp-temps*)
+               (bclass (hard-regspec-class breg))
+               (bregval (hard-regspec-value breg)))
+          (if (eq bclass hard-reg-class-fpr)
+            (use-fp-temp bregval)
+            (if (eq bclass hard-reg-class-gpr)
+              (if (eq (get-regspec-mode breg) hard-reg-class-gpr-mode-node)
+                (use-node-temp bregval)
+                (use-imm-temp bregval))))
+          (arm2-one-targeted-reg-form seg aform areg))
         (if apushed
           (arm2-elide-pushes seg apushed (arm2-pop-register seg areg)))))
@@ -8324 +8335 @@
       (if (and naturalx naturaly) 
         (arm2-absolute-natural seg vreg xfer (logior naturalx naturaly))
-        (let* ((u32x (nx-u32-constant-p x))
-               (u32y (nx-u32-constant-p y))
-               (constant (or u32x u32y)))
+        (let* ((constant (let* ((c (or naturalx naturaly)))
+                           (when c
+                             (if (arm::encode-arm-immediate c)
+                               c)))))
           (if (not constant)
             (with-imm-target () (xreg :natural)
@@ -8333 +8345 @@
                 (! %natural-logior xreg xreg yreg))
               (<- xreg))
-            (let* ((other (if u32x y x))
-                   (high (ldb (byte 16 16) constant))
-                   (low (ldb (byte 16 0) constant)))
+            (let* ((other (if naturalx y x)))
               (with-imm-target () (other-reg :natural)
                 (arm2-one-targeted-reg-form seg other other-reg)
-                (! %natural-logior-c other-reg other-reg high low)
+                (! logior-immediate other-reg other-reg (logand constant #xffffffff))
                 (<- other-reg))))
           (^))))))
@@ -8351 +8361 @@
       (if (and naturalx naturaly) 
         (arm2-absolute-natural seg vreg xfer (logxor naturalx naturaly))
-        (let* ((u32x (nx-u32-constant-p x))
-               (u32y (nx-u32-constant-p y))
-               (constant (or u32x u32y)))
+        (let* ((constant (let* ((c (or naturalx naturaly)))
+                           (when c
+                             (if (arm::encode-arm-immediate c)
+                               c)))))
           (if (not constant)
             (with-imm-target () (xreg :natural)
@@ -8360 +8371 @@
                 (! %natural-logxor xreg xreg yreg))
               (<- xreg))
-            (let* ((other (if u32x y x))
-                   (high (ldb (byte 16 16) constant))
-                   (low (ldb (byte 16 0) constant)))
+            (let* ((other (if naturalx y x)))
               (with-imm-target () (other-reg :natural)
                 (arm2-one-targeted-reg-form seg other other-reg)
-                (! %natural-logxor-c other-reg other-reg high low)
+                (! logxor-immediate other-reg other-reg (logand constant #xffffffff))
                 (<- other-reg))))
           (^))))))
@@ -8378 +8387 @@
       (if (and naturalx naturaly) 
         (arm2-absolute-natural seg vreg xfer (logand naturalx naturaly))
-        (let* ((u32x (nx-u32-constant-p x))
-               (u32y (nx-u32-constant-p y))
-               (constant (let* ((c (or u32x u32y)))
-                           (if (arm::encode-arm-immediate c)
-                             c
-                             (if (arm::encode-arm-immediate (lognot c))
-                               (lognot c))))))
+        (let* ((constant (let* ((c (or naturalx naturaly)))
+                           (when c
+                             (if (or (arm::encode-arm-immediate c)
+                                     (arm::encode-arm-immediate (lognot c)))
+                               c)))))
           (if (not constant)
             (with-imm-target () (xreg :natural)
@@ -8391 +8398 @@
                 (! %natural-logand xreg xreg yreg))
               (<- xreg))
-            (let* ((other (if u32x y x)))
+            (let* ((other (if naturalx y x)))
               (with-imm-target () (other-reg :natural)
                 (arm2-one-targeted-reg-form seg other other-reg)