Changeset 15050


Ignore:
Timestamp:
Oct 28, 2011, 9:20:18 PM (8 years ago)
Author:
gb
Message:

In NX2-AFUNC-ALLOCATE-GLOBAL-REGISTERS, increase var weight if
function (apparently) tailcalls itself.

Do self tail-calls involving small numbers of fixed args (currently,
one more than the number of args passed in registers, e.g., 4 on x8664
and 3 on x8632) better: avoid pushing/popping outgoing args, branch
back to a point after NVRs have been saved, etc.) There's still some
extra stack traffic and there's still room for improvement, but it's
better.

Location:
trunk/source/compiler
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/compiler/X86/x862.lisp

    r15041 r15050  
    9494                    `(progn
    9595                       (x862-invalidate-regmap)
     96                       (backend-gen-label ,',segvar ,,labelnum-var)))
     97                  (@+ (,labelnum-var)
     98                    `(progn             ;keep regmap
    9699                       (backend-gen-label ,',segvar ,,labelnum-var)))
    97100                  (@= (,labelnum-var)
     
    188191(defvar *x862-tail-vsp* nil)
    189192(defvar *x862-tail-nargs* nil)
     193(defvar *x862-tail-arg-vars* nil)
    190194(defvar *x862-tail-allow* t)
    191195(defvar *x862-reckless* nil)
     
    611615           (*x862-tail-vsp* nil)
    612616           (*x862-tail-nargs* nil)
     617           (*x862-tail-arg-vars* nil)
    613618           (*x862-inhibit-register-allocation* nil)
    614619           (*x862-tail-allow* t)
     
    28992904      (! call-known-symbol *x862-arg-z*))))
    29002905
    2901 (defun x862-self-call (seg nargs tail-p)
     2906(defun x862-do-self-call (seg nargs tail-p)
    29022907  (with-x86-local-vinsn-macros (seg)
    29032908    (cond ((and tail-p
     
    29422947           (callable (or symp lfunp label-p))
    29432948           (destreg (if symp ($ *x862-fname*) (unless label-p ($ *x862-temp0*))))
    2944            (alternate-tail-call
    2945             (and tail-p label-p *x862-tail-label* (eql nargs *x862-tail-nargs*) (not spread-p)))
     2949
    29462950           (set-nargs-vinsn nil))
    29472951      (or (and label-p nargs (not spread-p) (not (x862-mvpass-p xfer))
    2948                (not alternate-tail-call)
    2949                (x862-self-call seg nargs tail-p))
     2952               (x862-do-self-call seg nargs tail-p))
    29502953          (progn
    29512954            (when expression-p
     
    29652968                (x862-copy-register seg destreg a-reg))
    29662969              (unless spread-p
    2967                 (unless alternate-tail-call
    2968                   (x862-restore-nvrs seg *x862-register-restore-ea* *x862-register-restore-count* (and nargs (<= nargs *x862-target-num-arg-regs*))))))
     2970                (x862-restore-nvrs seg *x862-register-restore-ea* *x862-register-restore-count* (and nargs (<= nargs *x862-target-num-arg-regs*)))))
    29692971            (if spread-p
    29702972              (progn
     
    29842986                  (x862-restore-nvrs seg *x862-register-restore-ea* *x862-register-restore-count* nil)))
    29852987              (if nargs
    2986                 (unless alternate-tail-call
    2987                   (setq set-nargs-vinsn (x862-set-nargs seg nargs)))
     2988                (setq set-nargs-vinsn (x862-set-nargs seg nargs))
    29882989                (! pop-argument-registers)))
    29892990            (if callable
     
    30143015                          (x862-call-symbol seg nil)
    30153016                          (! call-known-function))))))
    3016                 (if alternate-tail-call
    3017                   (progn
    3018                     (x862-unwind-stack seg xfer 0 0 *x862-tail-vsp*)
    3019                     (! jump (aref *backend-labels* *x862-tail-label*)))
    3020                   (progn
     3017                (progn
    30213018                    (x862-unwind-stack seg xfer 0 0 #x7fffff)
    30223019                    (if (and (not spread-p) nargs (%i<= nargs *x862-target-num-arg-regs*))
     
    30803077                               (if symp
    30813078                                 (! jump-known-symbol)
    3082                                  (! jump-known-function)))))))))
     3079                                 (! jump-known-function))))))))
    30833080              ;; The general (funcall) case: we don't know (at compile-time)
    30843081              ;; for sure whether we've got a symbol or a (local, constant)
     
    33523349                              address-reg))
    33533350
    3354 (defun x862-push-reg-for-form (seg form suggested)
     3351(defun x862-push-reg-for-form (seg form suggested &optional targeted)
    33553352  (let* ((reg (if (and (node-reg-p suggested)
    33563353                         (nx2-acode-call-p form))     ;probably ...
    33573354                (x862-one-targeted-reg-form seg form *x862-arg-z*)
    3358                 (x862-one-untargeted-reg-form seg form suggested))))
     3355                (if targeted
     3356                  (x862-one-targeted-reg-form seg form suggested)
     3357                  (x862-one-untargeted-reg-form seg form suggested)))))
    33593358    (x862-push-register seg reg)))
    33603359
     
    35943593        (if atriv
    35953594          (x862-one-targeted-reg-form seg aform areg)
    3596           (setq apushed (x862-push-reg-for-form seg aform areg))))
     3595          (setq apushed (x862-push-reg-for-form seg aform areg t))))
    35973596      (x862-one-targeted-reg-form seg bform breg)
    35983597      (if aconst
     
    36663665      (if atriv
    36673666        (x862-one-targeted-reg-form seg aform areg)
    3668         (setq apushed (x862-push-reg-for-form seg aform areg))))
     3667        (setq apushed (x862-push-reg-for-form seg aform areg t))))
    36693668    (if (and bform (not bconst))
    36703669      (if btriv
    36713670        (x862-one-targeted-reg-form seg bform breg)
    3672         (setq bpushed (x862-push-reg-for-form seg bform breg))))
     3671        (setq bpushed (x862-push-reg-for-form seg bform breg t))))
    36733672    (x862-one-targeted-reg-form seg cform creg)
    36743673    (unless btriv
     
    37263725      (if atriv
    37273726        (x862-one-targeted-reg-form seg aform areg)
    3728         (setq apushed (x862-push-reg-for-form seg aform areg))))
     3727        (setq apushed (x862-push-reg-for-form seg aform areg t))))
    37293728    (if (and bform (not bconst))
    37303729      (if btriv
    37313730        (x862-one-targeted-reg-form seg bform breg)
    3732         (setq bpushed (x862-push-reg-for-form seg bform breg))))
     3731        (setq bpushed (x862-push-reg-for-form seg bform breg t))))
    37333732    (if (and cform (not cconst))
    37343733      (if ctriv
    37353734        (x862-one-targeted-reg-form seg cform creg)
    3736         (setq cpushed (x862-push-reg-for-form seg cform creg))))
     3735        (setq cpushed (x862-push-reg-for-form seg cform creg t))))
    37373736    (x862-one-targeted-reg-form seg dform dreg)
    37383737    (unless ctriv
     
    40514050                   (var (nx2-lexical-reference-p form))
    40524051                   (ea (when var
    4053                          (unless (x862-existing-reg-for-var var) (var-ea var))))
     4052                         (unless (x862-existing-reg-for-var var)
     4053                           (when (eql 1 (var-refs var)) (var-ea var)))))
    40544054                   (offset (and ea
    40554055                                (memory-spec-p ea)
    40564056                                (not (addrspec-vcell-p ea))
    40574057                                (memspec-frame-address-offset ea)))
    4058                    (reg (unless offset (x862-one-untargeted-reg-form seg (if js32 i j) *x862-arg-z*)))
     4058                   (reg (unless (and offset nil) (x862-one-untargeted-reg-form seg (if js32 i j) *x862-arg-z*)))
    40594059                   (constant (or js32 is32)))
    40604060              (if offset
     
    65156515              (:x8632
    65166516               *x8632-nvrs*)))))
    6517         (@ (backend-get-next-label)) ; generic self-reference label, should be label #1
     6517        (@ (backend-get-next-label))    ; generic self-reference label, should be label #1
    65186518        (! establish-fn)
    65196519        (@ (backend-get-next-label))    ; self-call label
    6520         (when keys ;; Ensure keyvect is the first immediate
     6520        (when keys;; Ensure keyvect is the first immediate
    65216521          (x86-immediate-label (%cadr (%cdddr keys))))
    65226522        (when code-note
     
    66486648                (rplacd constant reg)
    66496649                (! ref-constant reg (x86-immediate-label (car constant))))))
    6650           (when (and (not (or opt rest keys))
    6651                      (<= max-args *x862-target-num-arg-regs*)
    6652                      (not (some #'null arg-regs)))
    6653             (setq *x862-tail-vsp* *x862-vstack*
    6654                   *x862-tail-nargs* max-args)
    6655             (@ (setq *x862-tail-label* (backend-get-next-label))))
     6650          (when (and (not (or opt rest keys method-var))
     6651                     (logbitp $fbittailcallsself (afunc-bits *x862-cur-afunc*))
     6652                     (<= max-args (1+ *x862-target-num-arg-regs*))
     6653                     (dolist (var rev-fixed t)
     6654                       (let* ((bits (nx-var-bits var)))
     6655                         (declare (fixnum bits))
     6656                         (when (or (logbitp $vbitspecial bits)
     6657                                   (eql (logior (ash 1 $vbitclosed)
     6658                                                (ash 1 $vbitsetq))
     6659                                        (logand bits (logior (ash 1 $vbitclosed)
     6660                                                             (ash 1 $vbitsetq)))))
     6661                           (return)))))
     6662            (setq *x862-tail-nargs* max-args
     6663                  *x862-tail-arg-vars* (reverse rev-fixed)
     6664                  *x862-tail-vsp* *x862-vstack*)
     6665            (let* ((stack-arg-var (if (> max-args *x862-target-num-arg-regs*)
     6666                                    (car *x862-tail-arg-vars*))))
     6667              (when (and stack-arg-var (not (var-nvr stack-arg-var)))
     6668                (x862-stack-to-register seg (x862-vloc-ea 0) *x862-temp0*)))
     6669            (setq *x862-tail-label* (backend-get-next-label)))
    66566670          (when method-var
    66576671            (target-arch-case
     
    66906704          (setq reserved-lcells (x862-collect-lcells :reserved))
    66916705          (x862-bind-lambda seg reserved-lcells req opt rest keys auxen optsupvloc arg-regs lexprp inherited-vars)
     6706          (when *x862-tail-label*
     6707            (@+ *x862-tail-label*))
    66926708          (when next-method-var-scope-info
    66936709            (push next-method-var-scope-info *x862-recorded-symbols*)))
     
    75007516(defx862 x862-self-call self-call (seg vreg xfer arglist &optional spread-p)
    75017517  (setq arglist (x862-augment-arglist *x862-cur-afunc* arglist (if spread-p 1 *x862-target-num-arg-regs*)))
    7502   (x862-call-fn seg vreg xfer -2 arglist spread-p))
     7518  (let* ((nargs *x862-tail-nargs*))
     7519    (if (and nargs (x862-tailcallok xfer) (not spread-p)
     7520             (eql nargs (+ (length (car arglist))
     7521                           (length (cadr arglist)))))
     7522      (let* ((forms (append (car arglist) (reverse (cadr arglist))))
     7523             (vars *x862-tail-arg-vars*)
     7524             (regs (ecase nargs
     7525                     (0 ())
     7526                     (1 (list ($ *x862-arg-z*)))
     7527                     (2 (list ($ *x862-arg-y*) ($ *x862-arg-z*)))
     7528                     (3 (list (target-arch-case
     7529                               (:x8632 ($ x8632::temp0))
     7530                               (:x8664 ($ x8664::arg_x)))
     7531                              ($ *x862-arg-y*) ($ *x862-arg-z*)))
     7532                     (4 (target-arch-case
     7533                         (:x8632 (compiler-bug "4 tail-call args on x8632"))
     7534                         (:x8664 (list ($ x8664::temp0)
     7535                                       ($ x8664::arg_x)
     7536                                       ($ x8664::arg_y)
     7537                                       ($ x8664::arg_z))))))))
     7538        (case nargs
     7539          (1 (x862-one-targeted-reg-form seg (car forms) (car regs)))
     7540          (2 (x862-two-targeted-reg-forms seg (car forms) (car regs) (cadr forms) (cadr regs)))
     7541          (3 (x862-three-targeted-reg-forms seg (car forms) (car regs) (cadr forms) (cadr regs) (caddr forms) (caddr regs)))
     7542          (4 (x862-four-targeted-reg-forms seg (car forms) (car regs) (cadr forms) (cadr regs)  (caddr forms) (caddr regs) (cadddr forms) (cadddr regs))))
     7543        (do* ((vars vars (cdr vars))
     7544              (regs regs (cdr regs)))
     7545             ((null vars))
     7546          (let* ((var (car vars))
     7547                 (reg (car regs)))
     7548            (x862-do-lexical-setq seg nil (var-ea var) reg)))
     7549        (let* ((diff (- *x862-vstack* *x862-tail-vsp*)))
     7550          (unless (eql 0 diff)
     7551            (! adjust-vsp diff))
     7552          (! jump (aref *backend-labels* *x862-tail-label*))))
     7553      (x862-call-fn seg vreg xfer -2 arglist spread-p))))
    75037554
    75047555
  • trunk/source/compiler/nx2.lisp

    r15037 r15050  
    3030
    3131(defun nx2-partition-vars (vars inherited-vars &optional (afunc-flags 0))
    32   (declare (ignorable afunc-flags))
    3332  (labels ((var-weight (var)
    3433             (let* ((bits (nx-var-bits var)))
     
    4241                              (logand bits (logior (ash 1 $vbitclosed) (ash 1 $vbitsetq)))))
    4342                   0
    44                    (var-refs var))
     43                   (let* ((w (var-refs var)))
     44                     (if (logbitp $fbittailcallsself afunc-flags)
     45                       (ash w 2)
     46                       w)))
    4547                 0)))
    4648           (sum-weights (varlist)
Note: See TracChangeset for help on using the changeset viewer.