Index: /trunk/source/compiler/X86/x862.lisp =================================================================== --- /trunk/source/compiler/X86/x862.lisp (revision 15040) +++ /trunk/source/compiler/X86/x862.lisp (revision 15041) @@ -1477,4 +1477,18 @@ (return reg)))))) +(defun x862-existing-reg-for-var (var) + (let* ((ea (var-ea var))) + (if (and (memory-spec-p ea) + (not (addrspec-vcell-p ea))) + (let* ((offset (memspec-frame-address-offset ea)) + (mask *x862-gpr-locations-valid-mask*) + (info *x862-gpr-locations*)) + (declare (fixnum mask) (simple-vector info)) + (dotimes (reg 16) + (when (and (logbitp reg mask) + (memq offset (svref info reg))) + (return reg)))) + (if (register-spec-p ea) + ea)))) (defun x862-reg-for-form (form hint) @@ -1482,17 +1496,5 @@ (cond ((node-reg-p hint) (if var - (let* ((ea (var-ea var))) - (if (and (memory-spec-p ea) - (not (addrspec-vcell-p ea))) - (let* ((offset (memspec-frame-address-offset ea)) - (mask *x862-gpr-locations-valid-mask*) - (info *x862-gpr-locations*)) - (declare (fixnum mask) (simple-vector info)) - (dotimes (reg 16) - (when (and (logbitp reg mask) - (memq offset (svref info reg))) - (return reg)))) - (if (register-spec-p ea) - ea))) + (x862-existing-reg-for-var var) (if (acode-p (setq form (acode-unwrapped-form form))) (let* ((op (acode-operator form))) @@ -3350,4 +3352,10 @@ address-reg)) +(defun x862-push-reg-for-form (seg form suggested) + (let* ((reg (if (and (node-reg-p suggested) + (nx2-acode-call-p form)) ;probably ... + (x862-one-targeted-reg-form seg form *x862-arg-z*) + (x862-one-untargeted-reg-form seg form suggested)))) + (x862-push-register seg reg))) (defun x862-one-lreg-form (seg form lreg) @@ -3586,7 +3594,5 @@ (if atriv (x862-one-targeted-reg-form seg aform areg) - (setq apushed (x862-push-register - seg - (x862-one-untargeted-reg-form seg aform areg))))) + (setq apushed (x862-push-reg-for-form seg aform areg)))) (x862-one-targeted-reg-form seg bform breg) (if aconst @@ -3616,8 +3622,5 @@ (when (same-x86-reg-p adest breg) (setq breg areg))) - (setq apushed (x862-push-register - seg - (x862-one-untargeted-reg-form seg aform areg restricted) - t)))) + (setq apushed (x862-push-reg-for-form seg aform areg)))) (unless (eql restricted-by-caller 0) (setq *x862-gpr-locations-valid-mask* (logandc2 *x862-gpr-locations-valid-mask* restricted-by-caller))) @@ -3663,13 +3666,9 @@ (if atriv (x862-one-targeted-reg-form seg aform areg) - (setq apushed (x862-push-register - seg - (x862-one-targeted-reg-form seg aform areg))))) + (setq apushed (x862-push-reg-for-form seg aform areg)))) (if (and bform (not bconst)) (if btriv (x862-one-targeted-reg-form seg bform breg) - (setq bpushed (x862-push-register - seg - (x862-one-targeted-reg-form seg bform breg))))) + (setq bpushed (x862-push-reg-for-form seg bform breg)))) (x862-one-targeted-reg-form seg cform creg) (unless btriv @@ -3727,13 +3726,13 @@ (if atriv (x862-one-targeted-reg-form seg aform areg) - (setq apushed (x862-push-register seg (x862-one-targeted-reg-form seg aform areg))))) + (setq apushed (x862-push-reg-for-form seg aform areg)))) (if (and bform (not bconst)) (if btriv (x862-one-targeted-reg-form seg bform breg) - (setq bpushed (x862-push-register seg (x862-one-targeted-reg-form seg bform breg))))) + (setq bpushed (x862-push-reg-for-form seg bform breg)))) (if (and cform (not cconst)) (if ctriv (x862-one-targeted-reg-form seg cform creg) - (setq cpushed (x862-push-register seg (x862-one-targeted-reg-form seg cform creg))))) + (setq cpushed (x862-push-reg-for-form seg cform creg)))) (x862-one-targeted-reg-form seg dform dreg) (unless ctriv @@ -3788,7 +3787,5 @@ (when (same-x86-reg-p adest creg) (setq creg areg))) - (setq apushed (x862-push-register - seg - (x862-one-untargeted-reg-form seg aform areg))))) + (setq apushed (x862-push-reg-for-form seg aform areg)))) (when (and bform (not bconst)) (if btriv @@ -3801,6 +3798,5 @@ (when (same-x86-reg-p bdest creg) (setq creg breg))) - (setq bpushed (x862-push-register - seg (x862-one-untargeted-reg-form seg bform breg))))) + (setq bpushed (x862-push-reg-for-form seg bform breg)))) (setq cdest (x862-one-untargeted-reg-form seg cform creg restricted) restricted (x862-restrict-node-target cdest restricted)) @@ -3878,5 +3874,5 @@ (when (same-x86-reg-p dreg adest) (setq dreg areg))) - (setq apushed (x862-push-register seg (x862-one-untargeted-reg-form seg aform areg))))) + (setq apushed (x862-push-reg-for-form seg aform areg)))) (when (and bform (not bconst)) (if btriv @@ -3891,5 +3887,5 @@ (when (same-x86-reg-p dreg bdest) (setq dreg breg))) - (setq bpushed (x862-push-register seg (x862-one-untargeted-reg-form seg bform breg))))) + (setq bpushed (x862-push-reg-for-form seg bform breg)))) (when (and cform (not cconst)) (if ctriv @@ -3905,5 +3901,5 @@ (when (same-x86-reg-p cdest dreg) (setq dreg creg))) - (setq cpushed (x862-push-register seg (x862-one-untargeted-reg-form seg cform creg))))) + (setq cpushed (x862-push-reg-for-form seg cform creg)))) (setq ddest (x862-one-untargeted-reg-form seg dform dreg restricted) restricted (x862-restrict-node-target ddest restricted)) @@ -4052,6 +4048,12 @@ (x862-compare-u8 seg vreg xfer u8-operand u8 (if (and iu8 (not (eq cr-bit x86::x86-e-bits))) (logxor 1 cr-bit) cr-bit) true-p u8-operator) (if (and boolean (or js32 is32)) - (let* ((ea (x862-lexical-reference-ea (if js32 i j))) - (offset (and ea (memory-spec-p ea) (memspec-frame-address-offset ea))) + (let* ((form (if js32 i j)) + (var (nx2-lexical-reference-p form)) + (ea (when var + (unless (x862-existing-reg-for-var var) (var-ea var)))) + (offset (and ea + (memory-spec-p ea) + (not (addrspec-vcell-p ea)) + (memspec-frame-address-offset ea))) (reg (unless offset (x862-one-untargeted-reg-form seg (if js32 i j) *x862-arg-z*))) (constant (or js32 is32))) @@ -6503,9 +6505,6 @@ (setq no-regs (%ilogbitp $fbitnoregs fbits))) (multiple-value-setq (pregs reglocatives) - (nx2-allocate-global-registers - *x862-fcells* - *x862-vcells* - (afunc-all-vars afunc) - inherited-vars + (nx2-afunc-allocate-global-registers + afunc (unless no-regs (target-arch-case