Changeset 16480


Ignore:
Timestamp:
Jul 17, 2015, 4:59:05 PM (5 years ago)
Author:
gb
Message:

revive self-call

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/lscan/source/compiler/X86/x862.lisp

    r16478 r16480  
    85578557
    85588558(defx862 x862-self-call self-call (seg vreg xfer arglist &optional spread-p)
    8559   (cond (*backend-use-linear-scan*
    8560          (break)
    8561          )
    8562         (t
    8563          (progn
    8564            (setq arglist (x862-augment-arglist *x862-cur-afunc* arglist (if spread-p 1 *x862-target-num-arg-regs*)))
    8565            (let* ((nargs *x862-tail-nargs*))
    8566              (if (and nargs (x862-tailcallok xfer) (not spread-p)
    8567                       (eql nargs (+ (length (car arglist))
    8568                                     (length (cadr arglist)))))
    8569                (let* ((forms (append (car arglist) (reverse (cadr arglist))))
    8570                       (vars *x862-tail-arg-vars*)
    8571                       (regs (ecase nargs
    8572                               (0 ())
    8573                               (1 (list ($ *x862-arg-z*)))
    8574                               (2 (list ($ *x862-arg-y*) ($ *x862-arg-z*)))
    8575                               (3 (list (target-arch-case
    8576                                         (:x8632 ($ x8632::temp0))
    8577                                         (:x8664 ($ x8664::arg_x)))
    8578                                        ($ *x862-arg-y*) ($ *x862-arg-z*)))
    8579                               (4 (target-arch-case
    8580                                   (:x8632 (compiler-bug "4 tail-call args on x8632"))
    8581                                   (:x8664 (list ($ x8664::temp0)
    8582                                                 ($ x8664::arg_x)
    8583                                                 ($ x8664::arg_y)
    8584                                                 ($ x8664::arg_z))))))))
    8585                  ;; A form that's a lexical reference to X that's ultimately going
    8586                  ;; to be stored in X is a noop.
    8587                  (collect ((new-forms)
    8588                            (new-vars)
    8589                            (new-regs))
    8590                    (do* ((xforms forms (cdr xforms))
    8591                          (xvars vars (cdr xvars))
    8592                          (xregs regs (cdr xregs))
    8593                          (new-nargs 0))
    8594                         ((null xforms)
    8595                          (setq nargs new-nargs
    8596                                forms (new-forms)
    8597                                vars (new-vars)
    8598                                regs (new-regs)))
    8599                      (declare (fixnum new-nargs))
    8600                      (let* ((var (car xvars))
    8601                             (form (car xforms)))
    8602                        (unless (and (eq var (nx2-lexical-reference-p form))
    8603                                     (not (logbitp $vbitsetq (nx-var-bits var)))
    8604                                     (var-nvr var))
    8605                          (incf new-nargs)
    8606                          (new-vars var)
    8607                          (new-forms form)
    8608                          (new-regs (car xregs))))))
    8609                  (dotimes (i nargs)
    8610                    (let* ((var (nth i vars))
    8611                           (nvr (var-nvr var)))
    8612                      (when nvr
    8613                        (when (dotimes (j nargs t)
    8614                                (unless (= i j)
    8615                                  (let* ((form (nth j forms)))
    8616                                    (unless (and (nx2-var-not-set-by-form-p var form)
    8617                                                 (nx2-var-not-reffed-by-form-p var form))
    8618                                      (return)))))
    8619                          (setf (nth i regs) nvr)))))
    8620                  (case nargs
    8621                    (1 (x862-one-targeted-reg-form seg (car forms) (car regs)))
    8622                    (2 (x862-two-targeted-reg-forms seg (car forms) (car regs) (cadr forms) (cadr regs)))
    8623                    (3 (x862-three-targeted-reg-forms seg (car forms) (car regs) (cadr forms) (cadr regs) (caddr forms) (caddr regs)))
    8624                    (4 (x862-four-targeted-reg-forms seg (car forms) (car regs) (cadr forms) (cadr regs)  (caddr forms) (caddr regs) (cadddr forms) (cadddr regs))))
    8625                  (do* ((vars vars (cdr vars))
    8626                        (forms forms (cdr forms))
    8627                        (regs regs (cdr regs)))
    8628                       ((null vars))
    8629                    (let* ((var (car vars))
    8630                           (reg (car regs)))
    8631                      (unless (and (eq var (nx2-lexical-reference-p (car forms)))
    8632                                   (not (logbitp $vbitsetq (nx-var-bits var))))
    8633                        (x862-do-lexical-setq seg nil (var-ea var) reg))))
    8634                  (let* ((diff (- *x862-vstack* *x862-tail-vsp*)))
    8635                    (unless (eql 0 diff)
    8636                      (! adjust-vsp diff))
    8637                    (! jump (aref *backend-labels* *x862-tail-label*))))
    8638                (x862-call-fn seg vreg xfer -2 arglist spread-p)))))))
     8559  (progn
     8560    (setq arglist (x862-augment-arglist *x862-cur-afunc* arglist (if spread-p 1 *x862-target-num-arg-regs*)))
     8561    (let* ((nargs *x862-tail-nargs*))
     8562      (if (and nargs (x862-tailcallok xfer) (not spread-p)
     8563               (eql nargs (+ 17  (length (car arglist))
     8564                             (length (cadr arglist)))))
     8565        (let* ((forms (append (car arglist) (reverse (cadr arglist))))
     8566               (vars *x862-tail-arg-vars*)
     8567               (regs (ecase nargs
     8568                       (0 ())
     8569                       (1 (list ($ *x862-arg-z*)))
     8570                       (2 (list ($ *x862-arg-y*) ($ *x862-arg-z*)))
     8571                       (3 (list (target-arch-case
     8572                                 (:x8632 ($ x8632::temp0))
     8573                                 (:x8664 ($ x8664::arg_x)))
     8574                                ($ *x862-arg-y*) ($ *x862-arg-z*)))
     8575                       (4 (target-arch-case
     8576                           (:x8632 (compiler-bug "4 tail-call args on x8632"))
     8577                           (:x8664 (list ($ x8664::temp0)
     8578                                         ($ x8664::arg_x)
     8579                                         ($ x8664::arg_y)
     8580                                         ($ x8664::arg_z))))))))
     8581          ;; A form that's a lexical reference to X that's ultimately going
     8582          ;; to be stored in X is a noop.
     8583          (collect ((new-forms)
     8584                    (new-vars)
     8585                    (new-regs))
     8586            (do* ((xforms forms (cdr xforms))
     8587                  (xvars vars (cdr xvars))
     8588                  (xregs regs (cdr xregs))
     8589                  (new-nargs 0))
     8590                 ((null xforms)
     8591                  (setq nargs new-nargs
     8592                        forms (new-forms)
     8593                        vars (new-vars)
     8594                        regs (new-regs)))
     8595              (declare (fixnum new-nargs))
     8596              (let* ((var (car xvars))
     8597                     (form (car xforms)))
     8598                (unless (and (eq var (nx2-lexical-reference-p form))
     8599                             (not (logbitp $vbitsetq (nx-var-bits var)))
     8600                             (var-nvr var))
     8601                  (incf new-nargs)
     8602                  (new-vars var)
     8603                  (new-forms form)
     8604                  (new-regs (car xregs))))))
     8605          (dotimes (i nargs)
     8606            (let* ((var (nth i vars))
     8607                   (nvr (var-nvr var)))
     8608              (when nvr
     8609                (when (dotimes (j nargs t)
     8610                        (unless (= i j)
     8611                          (let* ((form (nth j forms)))
     8612                            (unless (and (nx2-var-not-set-by-form-p var form)
     8613                                         (nx2-var-not-reffed-by-form-p var form))
     8614                              (return)))))
     8615                  (setf (nth i regs) nvr)))))
     8616          (case nargs
     8617            (1 (x862-one-targeted-reg-form seg (car forms) (car regs)))
     8618            (2 (x862-two-targeted-reg-forms seg (car forms) (car regs) (cadr forms) (cadr regs)))
     8619            (3 (x862-three-targeted-reg-forms seg (car forms) (car regs) (cadr forms) (cadr regs) (caddr forms) (caddr regs)))
     8620            (4 (x862-four-targeted-reg-forms seg (car forms) (car regs) (cadr forms) (cadr regs)  (caddr forms) (caddr regs) (cadddr forms) (cadddr regs))))
     8621          (do* ((vars vars (cdr vars))
     8622                (forms forms (cdr forms))
     8623                (regs regs (cdr regs)))
     8624               ((null vars))
     8625            (let* ((var (car vars))
     8626                   (reg (car regs)))
     8627              (unless (and (eq var (nx2-lexical-reference-p (car forms)))
     8628                           (not (logbitp $vbitsetq (nx-var-bits var))))
     8629                (x862-do-lexical-setq seg nil (var-ea var) reg))))
     8630          (let* ((diff (- *x862-vstack* *x862-tail-vsp*)))
     8631            (unless (eql 0 diff)
     8632              (! adjust-vsp diff))
     8633            (! jump (aref *backend-labels* *x862-tail-label*))))
     8634        (x862-call-fn seg vreg xfer -2 arglist spread-p)))))
    86398635
    86408636
Note: See TracChangeset for help on using the changeset viewer.