(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
;;; (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)
;;; 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))))
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.
;;;
(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))
(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)))