Index: /trunk/source/compiler/ARM/arm2.lisp =================================================================== --- /trunk/source/compiler/ARM/arm2.lisp (revision 15079) +++ /trunk/source/compiler/ARM/arm2.lisp (revision 15080) @@ -74,4 +74,7 @@ `(progn (arm2-invalidate-regmap) + (backend-gen-label ,',segvar ,,labelnum-var))) + (@+ (,labelnum-var) + `(progn ;keep regmap (backend-gen-label ,',segvar ,,labelnum-var))) (-> (,label-var) @@ -280,5 +283,8 @@ (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,4 +550,5 @@ *arm2-gpr-constants-valid-mask* 0)) + (defun arm2-update-regmap (vinsn) (if (vinsn-attribute-p vinsn :call) @@ -1261,5 +1268,15 @@ (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,15 +1284,5 @@ (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,5 +3037,19 @@ (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,15 +3087,10 @@ (- (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,5 +3425,5 @@ (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,5 +3460,5 @@ (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,7 +3783,9 @@ (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,5 +6686,7 @@ (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,5 +6715,7 @@ (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,7 +6800,7 @@ (= (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,5 +8993,8 @@ (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))))) (^))))))