X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fir2tran.lisp;h=d796e127457a788ac0ae7321f2d77ecc97a705b0;hb=c2431e2d0d0222a3cf20cfdfa48201bdcc65cd76;hp=8157cd81595c9618ce875125bbdd0c059b60549c;hpb=883b33b092472473b0dd559d64351b9436916af3;p=sbcl.git diff --git a/src/compiler/ir2tran.lisp b/src/compiler/ir2tran.lisp index 8157cd8..d796e12 100644 --- a/src/compiler/ir2tran.lisp +++ b/src/compiler/ir2tran.lisp @@ -236,19 +236,12 @@ (let ((info (make-ir2-lvar *backend-t-primitive-type*))) (setf (ir2-lvar-kind info) :delayed) (setf (lvar-info leaves) info) - #!+stack-grows-upward-not-downward - (let ((tn (make-normal-tn *backend-t-primitive-type*))) - (setf (ir2-lvar-locs info) (list tn))) - #!+stack-grows-downward-not-upward (setf (ir2-lvar-stack-pointer info) (make-stack-pointer-tn))))) (defoptimizer (%allocate-closures ir2-convert) ((leaves) call 2block) - (let ((dx-p (lvar-dynamic-extent leaves)) - #!+stack-grows-upward-not-downward - (first-closure nil)) + (let ((dx-p (lvar-dynamic-extent leaves))) (collect ((delayed)) - #!+stack-grows-downward-not-upward (when dx-p (vop current-stack-pointer call 2block (ir2-lvar-stack-pointer (lvar-info leaves)))) @@ -263,9 +256,6 @@ (leaf-dx-p (and dx-p (leaf-dynamic-extent leaf)))) (vop make-closure call 2block entry (length closure) leaf-dx-p tn) - #!+stack-grows-upward-not-downward - (when (and (not first-closure) leaf-dx-p) - (setq first-closure tn)) (loop for what in closure and n from 0 do (unless (and (lambda-var-p what) (null (leaf-refs what))) @@ -282,10 +272,6 @@ tn (find-in-physenv what this-env) n))))))) - #!+stack-grows-upward-not-downward - (when dx-p - (emit-move call 2block first-closure - (first (ir2-lvar-locs (lvar-info leaves))))) (loop for (tn what n) in (delayed) do (vop closure-init call 2block tn what n)))) @@ -681,7 +667,6 @@ (r-refs (reference-tn-list results t))) (aver (= (length info-args) (template-info-arg-count template))) - #!+stack-grows-downward-not-upward (when (and lvar (lvar-dynamic-extent lvar)) (vop current-stack-pointer call block (ir2-lvar-stack-pointer (lvar-info lvar)))) @@ -1345,12 +1330,8 @@ (vop reset-stack-pointer node block (first (ir2-lvar-locs 2lvar)))) ((lvar-dynamic-extent lvar) - #!+stack-grows-downward-not-upward (vop reset-stack-pointer node block - (ir2-lvar-stack-pointer 2lvar)) - #!-stack-grows-downward-not-upward - (vop %%pop-dx node block - (first (ir2-lvar-locs 2lvar)))) + (ir2-lvar-stack-pointer 2lvar))) (t (bug "Trying to pop a not stack-allocated LVAR ~S." lvar))))) @@ -1382,21 +1363,11 @@ (nipped (first (ir2-lvar-locs 2first)) (reference-tn-list moved-tns nil)) - ((reference-tn-list moved-tns t)))) - #!-stack-grows-downward-not-upward - (nip-unaligned (nipped) - (vop* %%nip-dx node block - (nipped - (first (ir2-lvar-locs 2first)) - (reference-tn-list moved-tns nil)) ((reference-tn-list moved-tns t))))) (cond ((eq (ir2-lvar-kind 2after) :unknown) (nip-aligned (first (ir2-lvar-locs 2after)))) ((lvar-dynamic-extent after) - #!+stack-grows-downward-not-upward - (nip-aligned (ir2-lvar-stack-pointer 2after)) - #!-stack-grows-downward-not-upward - (nip-unaligned (ir2-lvar-stack-pointer 2after))) + (nip-aligned (ir2-lvar-stack-pointer 2after))) (t (bug "Trying to nip a not stack-allocated LVAR ~S." after)))))) @@ -1489,11 +1460,13 @@ ;;; IR2 converted. (defun ir2-convert-exit (node block) (declare (type exit node) (type ir2-block block)) - (let ((loc (find-in-physenv (exit-nlx-info node) - (node-physenv node))) - (temp (make-stack-pointer-tn)) - (value (exit-value node))) - (vop value-cell-ref node block loc temp) + (let* ((nlx (exit-nlx-info node)) + (loc (find-in-physenv nlx (node-physenv node))) + (temp (make-stack-pointer-tn)) + (value (exit-value node))) + (if (nlx-info-safe-p nlx) + (vop value-cell-ref node block loc temp) + (emit-move node block loc temp)) (if value (let ((locs (ir2-lvar-locs (lvar-info value)))) (vop unwind node block temp (first locs) (second locs))) @@ -1510,9 +1483,11 @@ ;;; dynamic extent. This is done by storing 0 into the indirect value ;;; cell that holds the closed unwind block. (defoptimizer (%lexical-exit-breakup ir2-convert) ((info) node block) - (vop value-cell-set node block - (find-in-physenv (lvar-value info) (node-physenv node)) - (emit-constant 0))) + (let ((nlx (lvar-value info))) + (when (nlx-info-safe-p nlx) + (vop value-cell-set node block + (find-in-physenv nlx (node-physenv node)) + (emit-constant 0))))) ;;; We have to do a spurious move of no values to the result lvar so ;;; that lifetime analysis won't get confused. @@ -1560,7 +1535,9 @@ (ecase kind ((:block :tagbody) - (do-make-value-cell node block res (ir2-nlx-info-home 2info))) + (if (nlx-info-safe-p info) + (do-make-value-cell node block res (ir2-nlx-info-home 2info)) + (emit-move node block res (ir2-nlx-info-home 2info)))) (:unwind-protect (vop set-unwind-protect node block block-tn)) (:catch))) @@ -1659,7 +1636,6 @@ (res (lvar-result-tns lvar (list (primitive-type (specifier-type 'list)))))) - #!+stack-grows-downward-not-upward (when (and lvar (lvar-dynamic-extent lvar)) (vop current-stack-pointer node block (ir2-lvar-stack-pointer (lvar-info lvar))))