Changeset 16464


Ignore:
Timestamp:
Jul 13, 2015, 5:46:35 AM (4 years ago)
Author:
gb
Message:

bail out on self-calls until I stop breaking them.

File:
1 edited

Legend:

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

    r16459 r16464  
    37413741  (with-x86-local-vinsn-macros (seg)
    37423742    (when mv-label
    3743       (if *backend-use-linear-scan*
    3744 
    3745         (warn "multiple-values"))
    37463743      (x862-vpush-label seg (aref *backend-labels* mv-label)))
    37473744    (when (and (car args) (not suppress-frame-reservation))
     
    58135810(defun x862-set-var-ea (seg var ea)
    58145811  (setf (var-ea var) ea)
    5815   (when (and *x862-record-symbols* (not *backend-use-linear-scan*) (or (typep ea 'lreg) (typep ea 'fixnum)))
     5812  (when (and *x862-record-symbols* (or (typep ea 'lreg) (typep ea 'fixnum)))
    58165813    (let* ((start (enqueue-vinsn-note seg :begin-variable-scope var)))
    58175814      (push (list var (var-name var) start nil)
     
    58225819  (let ((bits (nx-var-bits var)))
    58235820    (when (and *x862-record-symbols*
    5824                (not *backend-use-linear-scan*)
     5821             
    58255822               (var-ea var)
    58265823               (or (logbitp $vbitspecial bits)
     
    75107507                (setq arg-regs (x862-simple-opt-entry seg rev-opt rev-fixed)))
    75117508              (progn
    7512                 (when *backend-use-linear-scan*
     7509                '(when *backend-use-linear-scan*
    75137510                  (warn "lambda-list too complex for now? handled = ~s" handled-lambda))
    75147511                ;; From now on, the runtime assumes that all
     
    85608557
    85618558(defx862 x862-self-call self-call (seg vreg xfer arglist &optional spread-p)
    8562   (setq arglist (x862-augment-arglist *x862-cur-afunc* arglist (if spread-p 1 *x862-target-num-arg-regs*)))
    8563   (let* ((nargs *x862-tail-nargs*))
    8564     (if (and nargs (x862-tailcallok xfer) (not spread-p)
    8565              (eql nargs (+ (length (car arglist))
    8566                            (length (cadr arglist)))))
    8567       (let* ((forms (append (car arglist) (reverse (cadr arglist))))
    8568              (vars *x862-tail-arg-vars*)
    8569              (regs (ecase nargs
    8570                      (0 ())
    8571                      (1 (list ($ *x862-arg-z*)))
    8572                      (2 (list ($ *x862-arg-y*) ($ *x862-arg-z*)))
    8573                      (3 (list (target-arch-case
    8574                                (:x8632 ($ x8632::temp0))
    8575                                (:x8664 ($ x8664::arg_x)))
    8576                               ($ *x862-arg-y*) ($ *x862-arg-z*)))
    8577                      (4 (target-arch-case
    8578                          (:x8632 (compiler-bug "4 tail-call args on x8632"))
    8579                          (:x8664 (list ($ x8664::temp0)
    8580                                        ($ x8664::arg_x)
    8581                                        ($ x8664::arg_y)
    8582                                        ($ x8664::arg_z))))))))
    8583         ;; A form that's a lexical reference to X that's ultimately going
    8584         ;; to be stored in X is a noop.
    8585         (collect ((new-forms)
    8586                   (new-vars)
    8587                   (new-regs))
    8588           (do* ((xforms forms (cdr xforms))
    8589                 (xvars vars (cdr xvars))
    8590                 (xregs regs (cdr xregs))
    8591                 (new-nargs 0))
    8592                ((null xforms)
    8593                 (setq nargs new-nargs
    8594                       forms (new-forms)
    8595                       vars (new-vars)
    8596                       regs (new-regs)))
    8597             (declare (fixnum new-nargs))
    8598             (let* ((var (car xvars))
    8599                    (form (car xforms)))
    8600               (unless (and (eq var (nx2-lexical-reference-p form))
    8601                            (not (logbitp $vbitsetq (nx-var-bits var)))
    8602                            (var-nvr var))
    8603                 (incf new-nargs)
    8604                 (new-vars var)
    8605                 (new-forms form)
    8606                 (new-regs (car xregs))))))
    8607         (dotimes (i nargs)
    8608           (let* ((var (nth i vars))
    8609                  (nvr (var-nvr var)))
    8610             (when nvr
    8611               (when (dotimes (j nargs t)
    8612                       (unless (= i j)
    8613                         (let* ((form (nth j forms)))
    8614                           (unless (and (nx2-var-not-set-by-form-p var form)
    8615                                        (nx2-var-not-reffed-by-form-p var form))
    8616                             (return)))))
    8617                 (setf (nth i regs) nvr)))))
    8618         (case nargs
    8619           (1 (x862-one-targeted-reg-form seg (car forms) (car regs)))
    8620           (2 (x862-two-targeted-reg-forms seg (car forms) (car regs) (cadr forms) (cadr regs)))
    8621           (3 (x862-three-targeted-reg-forms seg (car forms) (car regs) (cadr forms) (cadr regs) (caddr forms) (caddr regs)))
    8622           (4 (x862-four-targeted-reg-forms seg (car forms) (car regs) (cadr forms) (cadr regs)  (caddr forms) (caddr regs) (cadddr forms) (cadddr regs))))
    8623         (do* ((vars vars (cdr vars))
    8624               (forms forms (cdr forms))
    8625               (regs regs (cdr regs)))
    8626              ((null vars))
    8627           (let* ((var (car vars))
    8628                  (reg (car regs)))
    8629             (unless (and (eq var (nx2-lexical-reference-p (car forms)))
    8630                          (not (logbitp $vbitsetq (nx-var-bits var))))
    8631               (x862-do-lexical-setq seg nil (var-ea var) reg))))
    8632         (let* ((diff (- *x862-vstack* *x862-tail-vsp*)))
    8633           (unless (eql 0 diff)
    8634             (! adjust-vsp diff))
    8635           (! jump (aref *backend-labels* *x862-tail-label*))))
    8636       (x862-call-fn seg vreg xfer -2 arglist 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)))))))
    86378639
    86388640
Note: See TracChangeset for help on using the changeset viewer.