[Openmcl-cvs-notifications] r15150 - /trunk/source/compiler/ARM/arm2.lisp

[gb at clozure.com]

Author: gb
Date: Wed Dec 21 16:50:16 2011
New Revision: 15150

Log:
ARM backend had the same bug as in r15149.

Modified:
    trunk/source/compiler/ARM/arm2.lisp

Modified: trunk/source/compiler/ARM/arm2.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/compiler/ARM/arm2.lisp (original)
+++ trunk/source/compiler/ARM/arm2.lisp Wed Dec 21 16:50:16 2011
@@ -4285,6 +4285,13 @@
       (arm2-lri seg vreg value))
     (^)))
 =

+(defun arm2-natural-constant (seg vreg xfer value)
+  (arm2-use-operator
+   (if (typep value *nx-target-fixnum-type*)
+     (%nx1-operator fixnum)
+     (%nx1-operator immediate))
+   seg vreg xfer value))
+    =

 =

 =

 (defun arm2-store-macptr (seg vreg address-reg)
@@ -8953,7 +8960,7 @@
     (let* ((fix-x (acode-fixnum-form-p x))
            (fix-y (acode-fixnum-form-p y)))
       (if (and fix-x fix-y)
-        (arm2-absolute-natural seg vreg xfer (+ fix-x fix-y))
+        (arm2-natural-constant seg vreg xfer (+ fix-x fix-y))
         (let* ((u15x (and (typep fix-x '(unsigned-byte 15)) fix-x))
                (u15y (and (typep fix-y '(unsigned-byte 15)) fix-y)))
           (if (not (or u15x u15y))
@@ -8977,7 +8984,7 @@
     (let* ((fix-x (acode-fixnum-form-p x))
            (fix-y (acode-fixnum-form-p y)))
       (if (and fix-x fix-y)
-        (arm2-absolute-natural seg vreg xfer (- fix-x fix-y))
+        (arm2-natural-constant seg vreg xfer (- fix-x fix-y))
         (let* ((u15y (and (typep fix-y '(unsigned-byte 15)) fix-y)))
           (if (not u15y)
             (with-imm-target () (xreg :natural)
@@ -9000,7 +9007,7 @@
     (let* ((naturalx (nx-natural-constant-p x))
            (naturaly (nx-natural-constant-p y)))
       (if (and naturalx naturaly) =

-        (arm2-absolute-natural seg vreg xfer (logior naturalx naturaly))
+        (arm2-natural-constant seg vreg xfer (logior naturalx naturaly))
         (let* ((constant (let* ((c (or naturalx naturaly)))
                            (when c
                              (if (arm::encode-arm-immediate c)
@@ -9026,7 +9033,7 @@
     (let* ((naturalx (nx-natural-constant-p x))
            (naturaly (nx-natural-constant-p y)))
       (if (and naturalx naturaly) =

-        (arm2-absolute-natural seg vreg xfer (logxor naturalx naturaly))
+        (arm2-natural-constant seg vreg xfer (logxor naturalx naturaly))
         (let* ((constant (let* ((c (or naturalx naturaly)))
                            (when c
                              (if (arm::encode-arm-immediate c)
@@ -9052,7 +9059,7 @@
     (let* ((naturalx (nx-natural-constant-p x))
            (naturaly (nx-natural-constant-p y)))
       (if (and naturalx naturaly) =

-        (arm2-absolute-natural seg vreg xfer (logand naturalx naturaly))
+        (arm2-natural-constant seg vreg xfer (logand naturalx naturaly))
         (let* ((constant (let* ((c (or naturalx naturaly)))
                            (when c
                              (if (or (arm::encode-arm-immediate c)