Changeset 15080

Timestamp:

Nov 19, 2011, 2:27:28 PM (13 years ago)

Author:

Gary Byers

Message:

@+ vinsn macro doesn't invalidate regmap. (Spent several days
trying to avoid regmap invalidation in some cases involving
nested IF/AND, but didn't commit that.)

When loading from the vstack into a non-node target, try to use
a non-conflicting temporary.

When eliding-pushes on the vstack, some cases depend on the order
in which things happen in the sequence. We can't really be sure
of that order unless the sequence is straight-line code.

Fix typos in ARM2-FOUR-UNTARGETED-REG-FORMS.

If a variable's in an FPR, then things like (SYMBOLP VAR) may try
to compare the FPR to NIL. Compare the SP to NIL instead (we're
just trying to clear the Z bit in the status register.)

ARM2-%SINGLE-FLOAT-NEGATE should use ! single-float-negate, not the
double-float variant.

If the result of %NATURAL-LOGAND is known to be small enough and the
result needs to be boxed, boxing is simpler.

File:

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

trunk/source/compiler/ARM/arm2.lisp

@@ -74 +74 @@
                     `(progn
                       (arm2-invalidate-regmap)
+                      (backend-gen-label ,',segvar ,,labelnum-var)))
+                  (@+ (,labelnum-var)
+                    `(progn             ;keep regmap
                       (backend-gen-label ,',segvar ,,labelnum-var)))
                   (-> (,label-var)
@@ -280 +283 @@
       (if (memory-spec-p ea)
         (ensuring-node-target (target vreg)
-          (progn
+          (let* ((reg (unless (node-reg-p vreg)
+                        (or (arm2-reg-for-ea ea)
+                            (arm2-try-non-conflicting-reg target 0)))))
+            (when reg (setq target reg))
             (arm2-stack-to-register seg ea target)
             (if (addrspec-vcell-p ea)
@@ -544 +550 @@
         *arm2-gpr-constants-valid-mask* 0))
 
+
 (defun arm2-update-regmap (vinsn)
   (if (vinsn-attribute-p vinsn :call)
@@ -1261 +1268 @@
           (return reg))))))
 
-  
+(defun arm2-reg-for-ea (ea)
+  (when (and (memory-spec-p ea)
+             (not (addrspec-vcell-p ea)))
+    (let* ((offset (memspec-frame-address-offset ea))
+           (mask *arm2-gpr-locations-valid-mask*)
+           (info *arm2-gpr-locations*))
+      (declare (fixnum mask) (simple-vector info))
+      (dotimes (reg 16)
+        (when (and (logbitp reg mask)
+                   (memq offset (svref info reg)))
+          (return reg))))))
 
 (defun arm2-reg-for-form (form hint)
@@ -1267 +1284 @@
     (cond ((node-reg-p hint)
            (if var
-             (let* ((ea (var-ea var)))
-               (when (and (memory-spec-p ea)
-                          (not (addrspec-vcell-p ea)))
-                 (let* ((offset (memspec-frame-address-offset ea))
-                        (mask *arm2-gpr-locations-valid-mask*)
-                        (info *arm2-gpr-locations*))
-                   (declare (fixnum mask) (simple-vector info))
-                   (dotimes (reg 16)
-                     (when (and (logbitp reg mask)
-                                (memq offset (svref info reg)))
-                       (return reg))))))
+             (arm2-reg-for-ea (var-ea var))
              (multiple-value-bind (value constantp) (acode-constant-p form)
                (when constantp
@@ -3030 +3037 @@
                    (cond ((and (not (and pushed-reg-is-set popped-reg-is-set))
                                (or (null popped-reg-is-reffed)
-                                   (vinsn-in-sequence-p pushed-reg-is-set popped-reg-is-reffed pop-vinsn)))
+                                   (null pushed-reg-is-set)
+                                   ;; If the popped register is
+                                   ;; referenced and the pushed
+                                   ;; register is set, we want to be
+                                   ;; sure that the last reference
+                                   ;; happens before the first
+                                   ;; assignent.  We can't be sure
+                                   ;; that either of these things
+                                   ;; actually happened or happen
+                                   ;; unconditionally, and can't
+                                   ;; be sure of the order in which
+                                   ;; they might happen if the sequence
+                                   ;; contains jumps or branches.
+                                   (vinsn-in-sequence-p pushed-reg-is-set popped-reg-is-reffed pop-vinsn)
+                                   (not (vinsn-sequence-has-some-attribute-p push-vinsn pop-vinsn :branch :jump))))
                           ;; We don't try this if anything's pushed on
                           ;; or popped from the vstack in the
@@ -3066 +3087 @@
                                             (- (the fixnum (svref operands opidx))
                                                arm::node-size))))))))
-                                             
-                                       
-                                     
                           (unless same-reg
                             (let* ((copy (! copy-gpr popped-reg pushed-reg)))
                               (remove-dll-node copy)
-                              (if popped-reg-is-reffed
-                                (insert-dll-node-after copy popped-reg-is-reffed)
-                                (if pushed-reg-is-set
+                              (if pushed-reg-is-set
                                   (insert-dll-node-after copy push-vinsn)
-                                  (insert-dll-node-before copy push-vinsn)))))
+                                  (insert-dll-node-before copy pop-vinsn))))
                           (elide-vinsn push-vinsn)
                           (elide-vinsn pop-vinsn))
@@ -3409 +3425 @@
         (progn
           (setq cdest (arm2-one-untargeted-reg-form seg cform creg restricted)
-                restricted (arm2-restrict-node-target bdest restricted))
+                restricted (arm2-restrict-node-target cdest restricted))
           (unless adest
             (when (same-arm-reg-p areg cdest)
@@ -3444 +3460 @@
       (if bconst
         (setq bdest (arm2-one-untargeted-reg-form seg bform breg restricted))
-        (arm2-elide-pushes seg bpushed (arm2-pop-register seg breg)))
+        (arm2-elide-pushes seg bpushed (arm2-pop-register seg (setq bdest breg))))
       (setq restricted (arm2-restrict-node-target bdest restricted))
       (unless adest
@@ -3767 +3783 @@
             (if dest-crf
               (! set-eq-bit dest-crf)))
-          (if (and dest-crf src-gpr)
-            ;; "Copying" a GPR to a CR field means comparing it to rnil
-            (! compare-to-nil dest src)
+          (if dest-crf
+            ;; "Copying" a GPR to a CR field means comparing it to nil
+            (if src-gpr
+              (! compare-to-nil dest src)
+              (! compare-to-nil dest arm::sp))
             (if (and dest-gpr src-gpr)
               (case dest-mode
@@ -6668 +6686 @@
                     (backend-copy-label merge-else-branch-label falselabel)
                     (progn
-                      (@ falselabel)
+                      (if (and (not need-else) nil)
+                        (@+ falselabel)
+                        (@ falselabel))
                       (arm2-predicate-block falselabel)
                       (when need-else
@@ -6695 +6715 @@
                   (multiple-value-setq (*arm2-undo-count* *arm2-cstack* *arm2-vstack* *arm2-top-vstack-lcell*) 
                     (arm2-decode-stack entry-stack)))
-                (@ endlabel)
+                (if (and (not need-else) (backend-crf-p vreg) nil)
+                  (@+ endlabel)
+                  (@ endlabel)) 
                 (arm2-predicate-block endlabel))))))))
 
@@ -6778 +6800 @@
              (= (hard-regspec-class vreg) hard-reg-class-fpr)
              (= (get-regspec-mode vreg) hard-reg-class-fpr-mode-single))
-      (! double-float-negate vreg r1)
+      (! single-float-negate vreg r1)
       (with-fp-target (r1) (r2 :single-float)
-        (! double-float-negate r2 r1)
+        (! single-float-negate r2 r1)
         (ensuring-node-target (target vreg)
           (arm2-copy-register seg target r2))))
@@ -8971 +8993 @@
                 (arm2-one-targeted-reg-form seg other other-reg)
                 (! logand-immediate other-reg other-reg (logand constant #xffffffff))
-                (<- other-reg))))
+                (if (and (typep constant '(unsigned-byte 29))
+                         (node-reg-p vreg))
+                  (! box-fixnum vreg other-reg)
+                  (<- other-reg)))))
           (^))))))