X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Flocall.lisp;h=0e9ba01c102a9ccafa5c652119b8ad920a0a5ec3;hb=e5e1b41799b814bca18e5f6e5c10b12d06c35c46;hp=3239cd36f4ec45ebf60204f10e272b9a59a5d046;hpb=140791a0479787eaca83bea2355c15b65259a823;p=sbcl.git diff --git a/src/compiler/locall.lisp b/src/compiler/locall.lisp index 3239cd3..0e9ba01 100644 --- a/src/compiler/locall.lisp +++ b/src/compiler/locall.lisp @@ -281,7 +281,7 @@ (return)) (let ((kind (functional-kind functional))) (cond ((or (functional-somewhat-letlike-p functional) - (eql kind :deleted)) + (memq kind '(:deleted :zombie))) (values)) ; nothing to do ((and (null (leaf-refs functional)) (eq kind nil) (not (functional-entry-fun functional))) @@ -953,11 +953,17 @@ ;;; new references to it. (defun let-convert (fun call) (declare (type clambda fun) (type basic-combination call)) - (let ((next-block (if (node-tail-p call) - nil - (insert-let-body fun call)))) + (let* ((next-block (insert-let-body fun call)) + (next-block (if (node-tail-p call) + nil + next-block))) (move-return-stuff fun call next-block) - (merge-lets fun call))) + (merge-lets fun call) + (setf (node-tail-p call) nil) + ;; If CALL has a derive type NIL, it means that "its return" is + ;; unreachable, but the next BIND is still reachable; in order to + ;; not confuse MAYBE-TERMINATE-BLOCK... + (setf (node-derived-type call) *wild-type*))) ;;; Reoptimize all of CALL's args and its result. (defun reoptimize-call (call) @@ -1032,6 +1038,7 @@ (eq (basic-combination-fun dest) ref-lvar) (eq (basic-combination-kind dest) :local) (not (node-to-be-deleted-p dest)) + (not (block-delete-p (lambda-block clambda))) (cond ((ok-initial-convert-p clambda) t) (t (reoptimize-lvar ref-lvar) @@ -1071,7 +1078,8 @@ ;;; tail-convert. The second is the value of M-C-T-A. (defun maybe-convert-tail-local-call (call) (declare (type combination call)) - (let ((return (lvar-dest (node-lvar call)))) + (let ((return (lvar-dest (node-lvar call))) + (fun (combination-lambda call))) (aver (return-p return)) (when (and (not (node-tail-p call)) ; otherwise already converted ;; this is a tail call @@ -1082,10 +1090,10 @@ ;; non-tail so that we can use known return inside the ;; component. (not (eq (functional-kind (node-home-lambda call)) - :external))) + :external)) + (not (block-delete-p (lambda-block fun)))) (node-ends-block call) - (let ((block (node-block call)) - (fun (combination-lambda call))) + (let ((block (node-block call))) (setf (node-tail-p call) t) (unlink-blocks block (first (block-succ block))) (link-blocks block (lambda-block fun))