From c1f08ed20a38f5c19e29a865988a682ceb887fec Mon Sep 17 00:00:00 2001
From: ram <ram>
Date: Thu, 10 Feb 1994 23:20:53 +0000
Subject: [PATCH] Add DELETE-IF-NO-ENTRIES to blow away components that can't
 be reached before we try to generate IR2.  This avoids some internal errors
 when unreachable local functions are deleted.

---
 compiler/main.lisp | 24 +++++++++++++++++++++++-
 1 file changed, 23 insertions(+), 1 deletion(-)

diff --git a/compiler/main.lisp b/compiler/main.lisp
index 9d7c86ae9..61a33f7cb 100644
--- a/compiler/main.lisp
+++ b/compiler/main.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/main.lisp,v 1.100 1994/01/05 16:33:44 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/main.lisp,v 1.101 1994/02/10 23:20:53 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -358,6 +358,26 @@
       (policy nil (zerop speed) (<= debug 1))
       (and *byte-compile* *byte-compiling*)))
 
+
+;;; DELETE-IF-NO-ENTRIES  --  Internal
+;;;
+;;;    Delete components with no external entry points before we try to
+;;; generate code.  Unreachable closures can cause IR2 conversion to puke on
+;;; itself, since it is the reference to the closure which normally causes the
+;;; components to be combined.  This doesn't really cover all cases...
+;;;
+(defun delete-if-no-entries (component)
+  (dolist (fun (component-lambdas component)
+	       (delete-component component))
+    (case (functional-kind fun)
+      (:top-level (return))
+      (:external
+       (unless (every #'(lambda (ref)
+			  (eq (block-component (node-block ref))
+			      component))
+		      (leaf-refs fun))
+	 (return))))))
+
   
 ;;; COMPILE-COMPONENT -- internal.
 ;;;
@@ -391,6 +411,8 @@
     (environment-analyze component)
     (dfo-as-needed component)
 
+    (delete-if-no-entries component)
+
     (unless (eq (block-next (component-head component))
 		(component-tail component))
       (if *byte-compiling*
-- 
GitLab