From 9b1d4d0fa5bfc8a8056d20d83a41798c6e3efb90 Mon Sep 17 00:00:00 2001 From: ram <ram> Date: Sat, 9 Nov 1991 22:04:48 +0000 Subject: [PATCH] Defer walking blocks whose successor is the component tail, so that we don't drop-through into error code so often. --- compiler/control.lisp | 19 ++++++++++++++----- 1 file changed, 14 insertions(+), 5 deletions(-) diff --git a/compiler/control.lisp b/compiler/control.lisp index e41837e6a..489039c3e 100644 --- a/compiler/control.lisp +++ b/compiler/control.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/control.lisp,v 1.7 1991/11/08 22:20:33 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/control.lisp,v 1.8 1991/11/09 22:04:48 ram Exp $") ;;; ;;; ********************************************************************** ;;; @@ -102,6 +102,10 @@ ;;; through to. (But it doesn't have to be from the last block walked, since ;;; that call might not have added anything.) ;;; +;;; We defer walking successors whose successor is the component tail (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) (declare (type cblock block) (type ir2-block tail)) (unless (block-flag block) @@ -117,10 +121,15 @@ (eq (basic-combination-kind last) :local)) (combination-lambda last)) (t - (let ((fun nil)) - (dolist (succ (block-succ block)) - (let ((res (control-analyze-block succ tail))) - (when res (setq fun res)))) + (let ((component-tail (component-tail (block-component block))) + (block-succ (block-succ block)) + (fun nil)) + (dolist (succ block-succ) + (unless (eq (first (block-succ succ)) component-tail) + (let ((res (control-analyze-block succ tail))) + (when res (setq fun res))))) + (dolist (succ block-succ) + (control-analyze-block succ tail)) fun))))))) -- GitLab