X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Flocall.lisp;h=0e9ba01c102a9ccafa5c652119b8ad920a0a5ec3;hb=f73c1f391342c797b8daebe4e8c27e5923341b6d;hp=4a8ab1902a197c5f81804b146a699e744b2c11f4;hpb=6053e7f804b430144bb09e2d107ad4ab3fb97db4;p=sbcl.git diff --git a/src/compiler/locall.lisp b/src/compiler/locall.lisp index 4a8ab19..0e9ba01 100644 --- a/src/compiler/locall.lisp +++ b/src/compiler/locall.lisp @@ -234,22 +234,21 @@ ;;; do LET conversion here. (defun locall-analyze-fun-1 (fun) (declare (type functional fun)) - (let ((refs (leaf-refs fun)) - (first-time t)) + (let ((refs (leaf-refs fun))) (dolist (ref refs) (let* ((lvar (node-lvar ref)) (dest (when lvar (lvar-dest lvar)))) - (cond ((and (basic-combination-p dest) - (eq (basic-combination-fun dest) lvar) - (eq (lvar-uses lvar) ref)) + (unless (node-to-be-deleted-p ref) + (cond ((and (basic-combination-p dest) + (eq (basic-combination-fun dest) lvar) + (eq (lvar-uses lvar) ref)) - (convert-call-if-possible ref dest) + (convert-call-if-possible ref dest) - (unless (eq (basic-combination-kind dest) :local) - (reference-entry-point ref))) - (t - (reference-entry-point ref)))) - (setq first-time nil))) + (unless (eq (basic-combination-kind dest) :local) + (reference-entry-point ref))) + (t + (reference-entry-point ref))))))) (values)) @@ -282,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))) @@ -393,8 +392,7 @@ (original-fun (ref-leaf ref))) (aver (functional-p original-fun)) (unless (or (member (basic-combination-kind call) '(:local :error)) - (block-delete-p block) - (eq (functional-kind (block-home-lambda block)) :deleted) + (node-to-be-deleted-p call) (member (functional-kind original-fun) '(:toplevel-xep :deleted)) (not (or (eq (component-kind component) :initial) @@ -440,22 +438,23 @@ (defun convert-mv-call (ref call fun) (declare (type ref ref) (type mv-combination call) (type functional fun)) (when (and (looks-like-an-mv-bind fun) - (not (functional-entry-fun fun)) (singleton-p (leaf-refs fun)) (singleton-p (basic-combination-args call))) (let* ((*current-component* (node-component ref)) (ep (optional-dispatch-entry-point-fun fun (optional-dispatch-max-args fun)))) - (aver (= (optional-dispatch-min-args fun) 0)) - (setf (basic-combination-kind call) :local) - (pushnew ep (lambda-calls-or-closes (node-home-lambda call))) - (merge-tail-sets call ep) - (change-ref-leaf ref ep) + (when (null (leaf-refs ep)) + (aver (= (optional-dispatch-min-args fun) 0)) + (aver (not (functional-entry-fun fun))) + (setf (basic-combination-kind call) :local) + (pushnew ep (lambda-calls-or-closes (node-home-lambda call))) + (merge-tail-sets call ep) + (change-ref-leaf ref ep) - (assert-lvar-type - (first (basic-combination-args call)) - (make-short-values-type (mapcar #'leaf-type (lambda-vars ep))) - (lexenv-policy (node-lexenv call))))) + (assert-lvar-type + (first (basic-combination-args call)) + (make-short-values-type (mapcar #'leaf-type (lambda-vars ep))) + (lexenv-policy (node-lexenv call)))))) (values)) ;;; Attempt to convert a call to a lambda. If the number of args is @@ -954,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,7 +1037,8 @@ (when (and (basic-combination-p dest) (eq (basic-combination-fun dest) ref-lvar) (eq (basic-combination-kind dest) :local) - (not (block-delete-p (node-block dest))) + (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) @@ -1072,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 @@ -1083,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)) @@ -1121,7 +1128,7 @@ (let ((outside-non-tail-call nil) (outside-call nil)) (when (and (dolist (ref (leaf-refs clambda) t) - (let ((dest (lvar-dest (node-lvar ref)))) + (let ((dest (node-dest ref))) (when (or (not dest) (block-delete-p (node-block dest))) (return nil))