Changeset 15066


Ignore:
Timestamp:
Nov 15, 2011, 2:29:06 AM (13 years ago)
Author:
Gary Byers
Message:

When allocating "untargeted" temporary registers, heuristically try to
avoid conflicts with registers that may contain live values. These
heuristics occasionally lose, but often win and lead to a reduction
in stack traffic for many functions.

"elide" some PUSHes/POPs on the vstack. Since LOADs and STOREs to
the vstack are VSP-relative, adust the appropriate operand of any
intervening VFRAME-LOAD and VFRAME-STORE vinsns if we're able to
elide the push/pop.

Fix a few things that implicitly and incorrectly assumed that fewer
node temps were used (e.g., that assumed that their result was being
stored in arm::arg_z or that the source and destination operands of
a vinsn were the same.)

While bootstrapping these changes, I ran into mysterious cache coherency
problems. I was never able to resolve them (among other things, running
under GDB made the problems go away.) It's not at all clear how compiler
changes could cause these sorts of problems, but backing out of those
changes and incrementally reintroducing them made the problems go away.

(I saw the problems on a TrimSlice and a Tegra develpment board, both
of which are dual-core Cortex A9 (Nvidia Tegra) systems. I tried a
few different Linux kernels on the TrimSlice but didn't try other ARM
boxes. My best guess is that this is an SMP issue and that some stale
cache state is retaine on one CPU when the other CPU invalidates it.
and that I just happened to be able to provoke a CPU bug.)

Whatever the problem is, I'll try to check in an ARM heap image that reflects
thes changes and those in the next commit; if the problem recurs, reverting
to that image may un-wedge things.

Location:
trunk/source/compiler/ARM
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • trunk/source/compiler/ARM/arm-vinsns.lisp

    r15007 r15066  
    863863     ((object :lisp)))
    864864  (mov tag (:lsl object (:$ arm::fixnumshift)))
    865   (and tag object (:$ (ash arm::tagmask arm::fixnumshift))))
     865  (and tag tag (:$ (ash arm::tagmask arm::fixnumshift))))
    866866
    867867(define-arm-vinsn (extract-fulltag :predicatable)
    … …  
    26852685
    26862686 
    2687 (define-arm-vinsn (adjust-stack-register :predicatable)
    2688     (()
    2689      ((reg t)
    2690       (amount :s16const)))
    2691   (add reg reg (:$ amount)))
    2692 
    2693 (define-arm-vinsn (adjust-vsp :predicatable)
     2687
     2688
     2689(define-arm-vinsn (adjust-vsp :predicatable :vsp :pop :discard)
    26942690    (()
    26952691     ((amount :s16const)))
    … …  
    36473643;;; Clobbers LR
    36483644(define-arm-vinsn %debug-trap (()
    3649                                                      ())
     3645                               ())
    36503646  (uuo-debug-trap))
    36513647

  • trunk/source/compiler/ARM/arm2.lisp

    r15058 r15066  
    294294           (arm2-stack-to-register seg ea arm::arg_x)
    295295           (arm2-lri seg arm::arg_y 0)
    296            (! call-subprim-3 arm::arg_z (arm::arm-subprimitive-address  '.SPgvset) arm::arg_x arm::arg_y arm::arg_z))
     296           (! call-subprim-3 arm::arg_z (arm::arm-subprimitive-address  '.SPgvset) arm::arg_x arm::arg_y arm::arg_z)
     297           (setq valreg arm::arg_z))
    297298          ((memory-spec-p ea)    ; vstack slot
    298299           (arm2-register-to-stack seg valreg ea))
    … …  
    28532854                              address-reg))
    28542855
     2856(defun arm2-push-reg-for-form (seg form suggested &optional targeted)
     2857  (let* ((reg (if (and (node-reg-p suggested)
     2858                         (nx2-acode-call-p form))     ;probably ...
     2859                (arm2-one-targeted-reg-form seg form  arm::arg_z)
     2860                (if targeted
     2861                  (arm2-one-targeted-reg-form seg form suggested)
     2862                  (arm2-one-untargeted-reg-form seg form suggested)))))
     2863    (arm2-push-register seg reg)))
    28552864
    28562865(defun arm2-one-lreg-form (seg form lreg)
    … …  
    28752884                      (%get-regspec-mode y)))))))
    28762885
    2877 (defun arm2-one-untargeted-reg-form (seg form suggested)
     2886;;; If REG is a node reg, add it to the bitmask.
     2887(defun arm2-restrict-node-target (reg mask)
     2888  (if (node-reg-p reg)
     2889    (logior mask (ash 1 (hard-regspec-value reg)))
     2890    mask))
     2891
     2892;;; If suggested reg is a node reg that contains a stack location,
     2893;;; try to use some other node temp.
     2894(defun arm2-try-non-conflicting-reg (suggested reserved)
     2895  (let* ((mask *arm2-gpr-locations-valid-mask*))
     2896    (or (when (and (node-reg-p suggested)
     2897                   (logbitp (hard-regspec-value suggested) mask))
     2898          (setq mask (logior mask reserved))
     2899          (%available-node-temp (logand *available-backend-node-temps*
     2900                                        (lognot mask))))
     2901        suggested)))
     2902
     2903(defun arm2-one-untargeted-reg-form (seg form suggested &optional (reserved 0))
    28782904  (or (arm2-reg-for-form form suggested)
    2879       (with-arm-local-vinsn-macros (seg)
    2880         (let* ((gpr-p (= (hard-regspec-class suggested) hard-reg-class-gpr))
    2881                (node-p (if gpr-p (= (get-regspec-mode suggested) hard-reg-class-gpr-mode-node))))
    2882           (if node-p
    2883             (if (and (acode-p form)
    2884                      (eq (acode-operator form) (%nx1-operator %current-tcr)))
    2885               arm::rcontext
    2886               (arm2-one-untargeted-lreg-form seg form suggested))
    2887             (arm2-one-untargeted-lreg-form seg form suggested))))))
     2905      (if (and (acode-p form)
     2906               (eq (acode-operator form) (%nx1-operator %current-tcr)))
     2907        arm::rcontext
     2908        (if (node-reg-p suggested)
     2909          (arm2-one-untargeted-lreg-form seg form (arm2-try-non-conflicting-reg suggested reserved))
     2910          (arm2-one-untargeted-lreg-form seg form suggested)))))
    28882911             
    28892912
    … …  
    29412964                         (hard-regspec-value popped-reg)))
    29422965           (sp-p (vinsn-attribute-p push-vinsn :csp)))
    2943       (when (and sp-p t)               ; vsp case is harder.
     2966      (when sp-p               ; vsp case is harder.
    29442967        (unless (vinsn-sequence-has-attribute-p push-vinsn pop-vinsn :csp :discard)
    29452968          (let* ((pushed-reg-is-set (vinsn-sequence-sets-reg-p
    … …  
    29913014                       (insert-dll-node-before restore pop-vinsn)
    29923015                       (elide-vinsn push-vinsn)
    2993                        (elide-vinsn pop-vinsn)))))))))))))
     3016                       (elide-vinsn pop-vinsn))))))))))
     3017      (when (and (vinsn-attribute-p push-vinsn :vsp))
     3018        (unless (or
     3019                 (vinsn-sequence-has-attribute-p push-vinsn pop-vinsn :vsp :push)
     3020                 (vinsn-sequence-has-attribute-p push-vinsn pop-vinsn :vsp :pop)
     3021                 (let* ((pushed-reg-is-set (vinsn-sequence-sets-reg-p
     3022                                            push-vinsn pop-vinsn pushed-reg))
     3023                        (popped-reg-is-set (if same-reg
     3024                                             pushed-reg-is-set
     3025                                             (vinsn-sequence-sets-reg-p
     3026                                              push-vinsn pop-vinsn popped-reg)))
     3027                        (popped-reg-is-reffed (unless same-reg
     3028                                                (vinsn-sequence-refs-reg-p
     3029                                                 push-vinsn pop-vinsn popped-reg))))
     3030                   (cond ((and (not (and pushed-reg-is-set popped-reg-is-set))
     3031                               (or (null popped-reg-is-reffed)
     3032                                   (vinsn-in-sequence-p pushed-reg-is-set popped-reg-is-reffed pop-vinsn)))
     3033                          ;; We don't try this if anything's pushed on
     3034                          ;; or popped from the vstack in the
     3035                          ;; sequence, but there can be references to
     3036                          ;; other things that were pushed earlier.
     3037                          ;; Those references use the vstack depth at
     3038                          ;; the time of the reference and the
     3039                          ;; canonical frame offset to address
     3040                          ;; relative to the vsp.  If we elide the
     3041                          ;; push, the vstack depth will be 4 bytes
     3042                          ;; less than when the reference was
     3043                          ;; generated.  Fix that up ...  There was
     3044                          ;; (once) a notion of modeling the vstack as
     3045                          ;; a list of "lcells"; lcells had a width
     3046                          ;; attribute that was usually the native
     3047                          ;; word size.  Eliding a push involved
     3048                          ;; setting the width of the lcell
     3049                          ;; representing the pushed word to 0.
     3050                          ;; That whole idea was never fully implemented,
     3051                          ;; though we generally try to maintain the model.
     3052                          ;; If it ever is implemented, we need to dtrt
     3053                          ;; here.
     3054                          (do* ((element (dll-node-succ push-vinsn) (dll-node-succ element)))
     3055                               ((eq element pop-vinsn))
     3056                            (when (typep element 'vinsn)
     3057                              (let* ((template (vinsn-template element))
     3058                                     (opidx (case (vinsn-template-name template)
     3059                                              (vframe-store 2)
     3060                                              (vframe-load 2))))
     3061                                (when opidx
     3062                                  (let* ((operands (vinsn-variable-parts element)))
     3063                                    (declare (simple-vector operands))
     3064                                    (setf (svref operands opidx)
     3065                                          (the fixnum
     3066                                            (- (the fixnum (svref operands opidx))
     3067                                               arm::node-size))))))))
     3068                                             
     3069                                       
     3070                                     
     3071                          (unless same-reg
     3072                            (let* ((copy (! copy-gpr popped-reg pushed-reg)))
     3073                              (remove-dll-node copy)
     3074                              (if popped-reg-is-reffed
     3075                                (insert-dll-node-after copy popped-reg-is-reffed)
     3076                                (if pushed-reg-is-set
     3077                                  (insert-dll-node-after copy push-vinsn)
     3078                                  (insert-dll-node-before copy push-vinsn)))))
     3079                          (elide-vinsn push-vinsn)
     3080                          (elide-vinsn pop-vinsn))
     3081                   (t                   ; maybe allocate a node temp
     3082                    )))))))))
    29943083               
    29953084       
    … …  
    30063095        (if atriv
    30073096          (arm2-one-targeted-reg-form seg aform areg)
    3008           (setq apushed (arm2-push-register seg (arm2-one-untargeted-reg-form seg aform (arm2-acc-reg-for areg))))))
     3097          (setq apushed (arm2-push-reg-for-form seg aform areg t))))
    30093098      (arm2-one-targeted-reg-form seg bform breg)
    30103099      (if aconst
    … …  
    30343123        (let* ((*available-backend-imm-temps* *available-backend-imm-temps*)
    30353124               (avar (arm2-lexical-reference-p aform))
    3036                (adest areg)
    3037                (bdest breg)
     3125               (adest nil)
     3126               (bdest nil)
    30383127               (atriv (and (arm2-trivial-p bform) (nx2-node-gpr-p breg)))
    30393128               (aconst (and (not atriv) (or (arm-side-effect-free-form-p aform)
    30403129                                            (if avar (arm2-var-not-set-by-form-p avar bform)))))
    3041                (apushed (not (or atriv aconst))))
     3130               (apushed nil)
     3131               (restricted 0))
    30423132          (progn
    30433133            (unless aconst
    30443134              (if atriv
    30453135                (progn
    3046                   (setq adest (arm2-one-untargeted-reg-form seg aform areg))
     3136                  (setq adest (arm2-one-untargeted-reg-form seg aform areg)
     3137                        restricted (arm2-restrict-node-target adest 0))
    30473138                  (when (imm-reg-p adest)
    30483139                    (use-imm-temp (%hard-regspec-value adest)))
    30493140                  (when (same-arm-reg-p adest breg)
    30503141                    (setq breg areg)))
    3051                 (setq apushed (arm2-push-register seg (arm2-one-untargeted-reg-form seg aform (arm2-acc-reg-for areg))))))
    3052             (if (setq bdest (arm2-reg-for-form bform breg))
    3053               (when (same-arm-reg-p bdest areg)
    3054                 (setq areg breg))
    3055               (setq bdest (arm2-one-untargeted-reg-form seg bform breg)))
     3142                (setq apushed (arm2-push-reg-for-form seg aform areg))))
     3143            (setq bdest (arm2-one-untargeted-reg-form seg bform breg restricted)
     3144                  restricted (arm2-restrict-node-target bdest restricted))
     3145            (unless adest
     3146              (if (same-arm-reg-p areg bdest)
     3147                (setq areg breg)))
    30563148            (if aconst
    30573149              (progn
    30583150                (if (imm-reg-p bdest)
    30593151                  (use-imm-temp (%hard-regspec-value bdest)))
    3060                 (setq adest (arm2-one-untargeted-reg-form seg aform areg)))
     3152                (setq adest (arm2-one-untargeted-reg-form seg aform areg restricted)))
    30613153              (if apushed
    3062                 (arm2-elide-pushes seg apushed (arm2-pop-register seg areg)))))
     3154                (arm2-elide-pushes seg apushed (arm2-pop-register seg (setq adest areg))))))
    30633155          (values adest bdest))))))
    30643156
    … …  
    31073199      (if atriv
    31083200        (arm2-one-targeted-reg-form seg aform areg)
    3109         (setq apushed (arm2-push-register seg (arm2-one-untargeted-reg-form seg aform (arm2-acc-reg-for areg))))))
     3201        (setq apushed (arm2-push-reg-for-form seg aform areg t))))
    31103202    (if (and bform (not bconst))
    31113203      (if btriv
    31123204        (arm2-one-targeted-reg-form seg bform breg)
    3113         (setq bpushed (arm2-push-register seg (arm2-one-untargeted-reg-form seg bform (arm2-acc-reg-for breg))))))
     3205        (setq bpushed (arm2-push-reg-for-form seg bform breg t))))
    31143206    (if (and cform (not cconst))
    31153207      (if ctriv
    31163208        (arm2-one-targeted-reg-form seg cform creg)
    3117         (setq cpushed (arm2-push-register seg (arm2-one-untargeted-reg-form seg cform (arm2-acc-reg-for creg))))))
     3209        (setq cpushed (arm2-push-reg-for-form seg cform creg t))))
    31183210    (arm2-one-targeted-reg-form seg dform dreg)
    31193211    (unless ctriv
    … …  
    31583250      (if atriv
    31593251        (arm2-one-targeted-reg-form seg aform areg)
    3160         (setq apushed (arm2-push-register seg (arm2-one-untargeted-reg-form seg aform (arm2-acc-reg-for areg))))))
     3252        (setq apushed (arm2-push-reg-for-form seg aform areg t))))
    31613253    (if (and bform (not bconst))
    31623254      (if btriv
    31633255        (arm2-one-targeted-reg-form seg bform breg)
    3164         (setq bpushed (arm2-push-register seg (arm2-one-untargeted-reg-form seg bform (arm2-acc-reg-for breg))))))
     3256        (setq bpushed (arm2-push-reg-for-form seg bform breg t))))
    31653257    (arm2-one-targeted-reg-form seg cform creg)
    31663258    (unless btriv
    … …  
    31973289                         (let ((bvar (arm2-lexical-reference-p bform)))
    31983290                           (and bvar (arm2-var-not-set-by-form-p bvar cform))))))
    3199            (adest areg)
    3200            (bdest breg)
    3201            (cdest creg)
     3291           (adest nil)
     3292           (bdest nil)
     3293           (cdest nil)
    32023294           (apushed nil)
    3203            (bpushed nil))
    3204       (if (and aform (not aconst))
     3295           (bpushed nil)
     3296           (restricted 0))
     3297      (when (and aform (not aconst))
    32053298        (if atriv
    32063299          (progn
    3207             (setq adest (arm2-one-untargeted-reg-form seg aform ($ areg)))
     3300            (setq adest (arm2-one-untargeted-reg-form seg aform ($ areg))
     3301                  restricted (arm2-restrict-node-target adest 0))
    32083302            (when (same-arm-reg-p adest breg)
    32093303              (setq breg areg))
    32103304            (when (same-arm-reg-p adest creg)
    32113305              (setq creg areg)))
    3212           (setq apushed (arm2-push-register seg (arm2-one-untargeted-reg-form seg aform (arm2-acc-reg-for areg))))))
    3213       (if (and bform (not bconst))
     3306          (setq apushed (arm2-push-reg-for-form seg aform areg ))))
     3307      (when (and bform (not bconst))
    32143308        (if btriv
    32153309          (progn
    3216             (setq bdest (arm2-one-untargeted-reg-form seg bform ($ breg)))
     3310            (setq bdest (arm2-one-untargeted-reg-form seg bform ($ breg) restricted)
     3311                  restricted (arm2-restrict-node-target bdest restricted))
    32173312            (when (same-arm-reg-p bdest creg)
    32183313              (setq creg breg))
    32193314            (when (same-arm-reg-p bdest areg)
    32203315              (setq areg breg)))
    3221           (setq bpushed (arm2-push-register seg (arm2-one-untargeted-reg-form seg bform (arm2-acc-reg-for breg))))))
    3222       (setq cdest (arm2-one-untargeted-reg-form seg cform creg))
     3316          (setq bpushed (arm2-push-reg-for-form seg bform breg))))
     3317      (setq cdest (arm2-one-untargeted-reg-form seg cform creg restricted)
     3318            restricted (arm2-restrict-node-target cdest restricted))
    32233319      (when (same-arm-reg-p cdest areg)
    32243320        (setq areg creg))
    … …  
    32273323      (unless btriv
    32283324        (if bconst
    3229           (setq bdest (arm2-one-untargeted-reg-form seg bform breg))
    3230           (arm2-elide-pushes seg bpushed (arm2-pop-register seg breg))))
     3325          (setq bdest (arm2-one-untargeted-reg-form seg bform breg restricted))
     3326          (arm2-elide-pushes seg bpushed (arm2-pop-register seg (setq bdest breg))))
     3327        (setq restricted (arm2-restrict-node-target bdest restricted))
     3328        (when (same-arm-reg-p bdest areg)
     3329          (setq areg breg)))
    32313330      (unless atriv
    32323331        (if aconst
    3233           (setq adest (arm2-one-untargeted-reg-form seg aform areg))
    3234           (arm2-elide-pushes seg apushed (arm2-pop-register seg areg))))
     3332          (setq adest (arm2-one-untargeted-reg-form seg aform areg restricted))
     3333          (arm2-elide-pushes seg apushed (arm2-pop-register seg (setq adest areg)))))
    32353334      (values adest bdest cdest))))
    32363335
    … …  
    32733372                         (and cvar
    32743373                              (arm2-var-not-set-by-form-p cvar dform))))))
    3275          (adest areg)
    3276          (bdest breg)
    3277          (cdest creg)
    3278          (ddest dreg)
     3374         (adest nil)
     3375         (bdest nil)
     3376         (cdest nil)
     3377         (ddest nil)
    32793378         (apushed nil)
    32803379         (bpushed nil)
    3281          (cpushed nil))
     3380         (cpushed nil)
     3381         (restricted 0))
    32823382    (if (and aform (not aconst))
    32833383      (if atriv
    32843384        (progn
    3285           (setq adest (arm2-one-targeted-reg-form seg aform areg))
     3385          (setq adest (arm2-one-untargeted-reg-form seg aform areg)
     3386                restricted (arm2-restrict-node-target adest restricted))
    32863387          (when (same-arm-reg-p adest breg)
    32873388            (setq breg areg))
    … …  
    32903391          (when (same-arm-reg-p adest dreg)
    32913392            (setq dreg areg)))
    3292         (setq apushed (arm2-push-register seg (arm2-one-untargeted-reg-form seg aform (arm2-acc-reg-for areg))))))
     3393        (setq apushed (arm2-push-reg-for-form seg aform areg))))
    32933394    (if (and bform (not bconst))
    32943395      (if btriv
    32953396        (progn
    3296           (setq bdest (arm2-one-untargeted-reg-form seg bform breg))
     3397          (setq bdest (arm2-one-untargeted-reg-form seg bform breg restricted)
     3398                restricted (arm2-restrict-node-target bdest restricted))
     3399          (unless adest
     3400            (when (same-arm-reg-p areg bdest)
     3401              (setq areg breg)))
    32973402          (when (same-arm-reg-p bdest creg)
    32983403            (setq creg breg))
    32993404          (when (same-arm-reg-p bdest dreg)
    33003405            (setq dreg breg)))
    3301         (setq bpushed (arm2-push-register seg (arm2-one-untargeted-reg-form seg bform (arm2-acc-reg-for breg))))))
     3406        (setq bpushed (arm2-push-reg-for-form seg bform breg))))
    33023407    (if (and cform (not cconst))
    33033408      (if ctriv
    33043409        (progn
    3305           (setq cdest (arm2-one-untargeted-reg-form seg cform creg))
     3410          (setq cdest (arm2-one-untargeted-reg-form seg cform creg restricted)
     3411                restricted (arm2-restrict-node-target bdest restricted))
     3412          (unless adest
     3413            (when (same-arm-reg-p areg cdest)
     3414              (setq areg creg)))
     3415          (unless bdest
     3416            (when (same-arm-reg-p breg cdest)
     3417              (setq breg creg)))         
    33063418          (when (same-arm-reg-p cdest dreg)
    33073419            (setq dreg creg)))
    3308         (setq cpushed (arm2-push-register seg (arm2-one-untargeted-reg-form seg cform (arm2-acc-reg-for creg))))))
    3309     (setq ddest (arm2-one-untargeted-reg-form seg dform dreg))
    3310     (when (same-arm-reg-p ddest areg)
    3311       (setq areg dreg))
    3312     (when (same-arm-reg-p ddest breg)
    3313       (setq breg dreg))
    3314     (when (same-arm-reg-p ddest creg)
    3315       (setq creg dreg))
     3420        (setq cpushed (arm2-push-reg-for-form seg cform creg))))
     3421    (setq ddest (arm2-one-untargeted-reg-form seg dform dreg restricted)
     3422          restricted (arm2-restrict-node-target ddest restricted))
     3423    (unless adest
     3424      (when (same-arm-reg-p ddest areg)
     3425        (setq areg dreg)))
     3426    (unless bdest
     3427      (when (same-arm-reg-p ddest breg)
     3428        (setq breg dreg)))
     3429    (unless cdest
     3430      (when (same-arm-reg-p ddest creg)
     3431        (setq creg dreg)))
    33163432    (unless ctriv
    33173433      (if cconst
    3318         (setq cdest (arm2-one-untargeted-reg-form seg cform creg))
    3319         (arm2-elide-pushes seg cpushed (arm2-pop-register seg creg))))
     3434        (setq cdest (arm2-one-untargeted-reg-form seg cform creg restricted))
     3435        (arm2-elide-pushes seg cpushed (arm2-pop-register seg (setq cdest creg))))
     3436      (setq restricted (arm2-restrict-node-target cdest restricted))
     3437      (unless adest
     3438        (when (same-arm-reg-p cdest areg)
     3439          (setq areg creg)))
     3440      (unless bdest
     3441        (when (same-arm-reg-p ddest breg)
     3442          (setq breg creg))))
    33203443    (unless btriv
    33213444      (if bconst
    3322         (setq bdest (arm2-one-untargeted-reg-form seg bform breg))
    3323         (arm2-elide-pushes seg bpushed (arm2-pop-register seg breg))))
     3445        (setq bdest (arm2-one-untargeted-reg-form seg bform breg restricted))
     3446        (arm2-elide-pushes seg bpushed (arm2-pop-register seg breg)))
     3447      (setq restricted (arm2-restrict-node-target bdest restricted))
     3448      (unless adest
     3449        (when (same-arm-reg-p bdest areg)
     3450          (setq areg breg))))
    33243451    (unless atriv
    33253452      (if aconst
    3326         (setq adest (arm2-one-untargeted-reg-form seg aform areg))
     3453        (setq adest (arm2-one-untargeted-reg-form seg aform areg restricted))
    33273454        (arm2-elide-pushes seg apushed (arm2-pop-register seg areg))))
    33283455    (values adest bdest cdest ddest)))
Note: See TracChangeset for help on using the changeset viewer.