X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fcontrol.lisp;h=2e1db870749b936af3eb91ba15f7d9e9244f9430;hb=11f02398a1a9ccbde847c82fd233e8378e45c29c;hp=3d96ee6a25f4a048b6acfcdf8e22c1b30c12623d;hpb=7fd2eb4b1bc68e8aaec233c4a39bdfc40225bda2;p=sbcl.git diff --git a/src/compiler/control.lisp b/src/compiler/control.lisp index 3d96ee6..2e1db87 100644 --- a/src/compiler/control.lisp +++ b/src/compiler/control.lisp @@ -59,8 +59,7 @@ (cond ((and pred (not (physenv-nlx-info env)) - (not (eq (node-block (lambda-bind (block-home-lambda block))) - block))) + (not (eq (lambda-block (block-home-lambda block)) block))) (let ((current pred) (current-num (block-number pred))) (block DONE @@ -97,7 +96,9 @@ ;;; (end in an error, NLX or tail full call.) This is to discourage ;;; making error code the drop-through. (defun control-analyze-block (block tail block-info-constructor) - (declare (type cblock block) (type block-annotation tail)) + (declare (type cblock block) + (type block-annotation tail) + (type function block-info-constructor)) (unless (block-flag block) (let ((block (find-rotated-loop-head block))) (setf (block-flag block) t) @@ -138,7 +139,9 @@ ;;; course, it will never get a drop-through if either function has ;;; NLX code. (defun control-analyze-1-fun (fun component block-info-constructor) - (declare (type clambda fun) (type component component)) + (declare (type clambda fun) + (type component component) + (type function block-info-constructor)) (let* ((tail-block (block-info (component-tail component))) (prev-block (block-annotation-prev tail-block)) (bind-block (node-block (lambda-bind fun)))) @@ -164,7 +167,7 @@ block-info-constructor))))))) (values)) -;;; Do control analysis on Component, finding the emit order. Our only +;;; Do control analysis on COMPONENT, finding the emit order. Our only ;;; cleverness here is that we walk XEP's first to increase the ;;; probability that the tail call will be a drop-through. ;;; @@ -189,7 +192,7 @@ (clear-flags component) (dolist (fun (component-lambdas component)) - (when (external-entry-point-p fun) + (when (xep-p fun) (control-analyze-1-fun fun component block-info-constructor))) (dolist (fun (component-lambdas component)) @@ -197,7 +200,7 @@ (do-blocks (block component) (unless (block-flag block) - (event control-deleted-block (continuation-next (block-start block))) + (event control-deleted-block (block-start-node block)) (delete-block block)))) (let ((2comp (component-info component)))