Changeset 13818

Timestamp:

Jun 14, 2010, 10:12:11 AM (9 years ago)

Author:

gb

Message:

Make the fact that some things that handle overflow out-of-line set
arg_z explicit (failing to do that confused the register-tracking
code.) Screw: should really treat them as :calls, since they
sometimes do subprim calls.
Fix closure allocation/initialization (need entrypoint slot);
compare-immediate confusion.

File:

• branches/arm/compiler/ARM/arm2.lisp (modified) (15 diffs)

branches/arm/compiler/ARM/arm2.lisp

@@ -2452 +2452 @@
              (dest ($ arm::arg_z))
              (vsize (+ (length inherited-vars) 
-                       2                ; %closure-code%, afunc
+                       3                ; entrypoint,%closure-code%, afunc
                        2)))             ; name, lfun-bits
         (declare (list inherited-vars))
@@ -2460 +2460 @@
                    (*arm2-top-vstack-lcell* *arm2-top-vstack-lcell*))
               (arm2-lri seg arm::arg_x (ash (nx-lookup-target-uvector-subtag :function) *arm2-target-fixnum-shift*))
+              (arm2-lri seg arm::temp0 (subprim-name->offset '.SPfix-nfn-entrypoint))
               (! %closure-code% arm::arg_y)
               (arm2-store-immediate seg (arm2-afunc-lfun-ref afunc) arm::arg_z)
+              (arm2-vpush-register-arg seg arm::temp0)
               (arm2-vpush-register-arg seg arm::arg_x)
               (arm2-vpush-register-arg seg arm::arg_y)
@@ -2475 +2477 @@
               (! make-stack-gvector))
             (arm2-open-undo $undostkblk))
-          (let* ((cell 0))
+          (let* ((cell 1))
             (declare (fixnum cell))
             (progn
@@ -2482 +2484 @@
                         (arch::make-vheader vsize (nx-lookup-target-uvector-subtag :function)))
               (! %alloc-misc-fixed dest arm::imm0 (ash vsize (arch::target-word-shift arch)))
-              )       
+              )
+            (! lri arm::arg_x (subprim-name->offset '.SPfix-nfn-entrypoint))
+            (! misc-set-c-node arm::arg_x dest 0)
             (! %closure-code% arm::arg_x)
             (arm2-store-immediate seg (arm2-afunc-lfun-ref afunc) arm::arg_y)
@@ -3058 +3062 @@
       (if (eql op (%nx1-operator fixnum))
         (let* ((val (ash (cadr form) arm::fixnumshift)))
-          (if (arm::encode-arm-immediate val)
-            (logand val #xffffffff)
-            (if (arm::encode-arm-immediate (lognot val))
-              (logand (lognot val) #xffffffff))))
+          (if (or (arm::encode-arm-immediate val)
+                  (arm::encode-arm-immediate (- val)))
+            (logand val #xffffffff)))
         (if (eql op (%nx1-operator %unbound-marker))
           arm::unbound-marker
@@ -3173 +3176 @@
 
 (defun arm2-test-reg-%izerop (seg vreg xfer reg cr-bit true-p  zero)
-  (declare (fixnum reg zero))
+  (declare (fixnum reg))
   (with-arm-local-vinsn-macros (seg vreg xfer)
     (regspec-crf-gpr-case 
@@ -3179 +3182 @@
      (progn
        (if (or (arm::encode-arm-immediate zero)
-               (arm::encode-arm-immediate (lognot zero)))
+               (arm::encode-arm-immediate (- zero)))
          (! compare-immediate dest reg zero)
          (with-node-target (reg) other
@@ -3187 +3190 @@
      (with-crf-target () crf
        (if (or (arm::encode-arm-immediate zero)
-               (arm::encode-arm-immediate (lognot zero)))
+               (arm::encode-arm-immediate (- zero)))
          (! compare-immediate crf reg (logand #xffffffff zero))
          (with-node-target (reg) other
@@ -4773 +4776 @@
         (arm::make-lap-label unique)))
     (labels ((parse-operand-form (valform)
-               ;(break "valform = ~s" valform)
+                                        ;(break "valform = ~s" valform)
                (cond ((typep valform 'keyword)
                       (or (assq valform unique-labels)
@@ -4830 +4833 @@
                      (if (eval-predicate (car f))
                        (dolist (subform (cdr f))
-                         (expand-form subform))))))))
+                           (expand-form subform))))))))
       (declare (dynamic-extent #'expand-form #'parse-operand-form #'expand-insn-form #'eval-predicate))
-      ;(format t "~& vinsn = ~s" vinsn)
+                                        ;(format t "~& vinsn = ~s" vinsn)
       (dolist (form (vinsn-template-body template))
         (expand-form form ))
@@ -5338 +5341 @@
           (! negate-fixnum-overflow-inline target src)
           (progn
-            (! negate-fixnum-overflow-ool src)
+            (! negate-fixnum-overflow-ool ($ arm::arg_z) src)
             (arm2-copy-register seg target ($ arm::arg_z))))))
     (^)))
@@ -5948 +5951 @@
           (! fixnum-add-overflow-inline-skip ($ arm::arg_z) ($ arm::arg_y) ($ arm::arg_z) (aref *backend-labels* done))
           (progn
-            (! fixnum-add-overflow-ool ($ arm::arg_y) ($ arm::arg_z))
+            (! fixnum-add-overflow-ool ($ arm::arg_z) ($ arm::arg_y) ($ arm::arg_z))
             (-> done)))
         (@ out-of-line)
@@ -5970 +5973 @@
           (! fixnum-sub-overflow-inline-skip ($ arm::arg_z) ($ arm::arg_y) ($ arm::arg_z) (aref *backend-labels* done))
           (progn
-            (! fixnum-sub-overflow-ool ($ arm::arg_y) ($ arm::arg_z))
+            (! fixnum-sub-overflow-ool ($ arm::arg_z)($ arm::arg_y) ($ arm::arg_z))
             (-> done)))
         (@ out-of-line)
@@ -6266 +6269 @@
                  (! fixnum-add-overflow-inline target r1 r2)
                  (progn
-                   (! fixnum-add-overflow-ool r1 r2)
+                   (! fixnum-add-overflow-ool ($ arm::arg_z) r1 r2)
                    (arm2-copy-register seg target ($ arm::arg_z)))))
              (^)))
@@ -6329 +6332 @@
                    (! fixnum-sub-overflow-inline target r1 r2)
                    (progn
-                     (! fixnum-sub-overflow-ool r1 r2)
+                     (! fixnum-sub-overflow-ool ($ arm::arg_z) r1 r2)
                      (arm2-copy-register seg target ($ arm::arg_z)))))
               (^)))