From 35ac289339237fcb758d1b876dcd724ddc354e16 Mon Sep 17 00:00:00 2001
From: ram <ram>
Date: Thu, 23 Aug 1990 18:42:50 +0000
Subject: [PATCH] Changed ENVIRONMENT-ANALYZE so that it doesn't always give
 multiple "does not return" notes.

---
 compiler/envanal.lisp | 25 +++++++++++++------------
 1 file changed, 13 insertions(+), 12 deletions(-)

diff --git a/compiler/envanal.lisp b/compiler/envanal.lisp
index 2a73c1e8f..e21d840c6 100644
--- a/compiler/envanal.lisp
+++ b/compiler/envanal.lisp
@@ -38,18 +38,19 @@
   (declare (type component component))
   (assert (not (component-new-functions component)))
   (dolist (fun (component-lambdas component))
-    (let* ((f (if (eq (functional-kind fun) :external)
-		  (functional-entry-function fun)
-		  fun))
-	   (dtype (definition-type f))
-	   (node (lambda-bind fun)))
-      (setf (leaf-type f) dtype)
-      (when (and (eq (function-type-returns dtype) *empty-type*)
-		 (or (functional-entry-function f)
-		     (null (functional-kind f)))
-		 (policy node (>= safety brevity)))
-	(let ((*compiler-error-context* node))
-	  (compiler-note "Function does not return."))))
+    (let* ((ef (functional-entry-function fun))
+	   (kind (functional-kind fun))
+	   (f (cond ((eq (functional-kind fun) :external)
+		     (when (optional-dispatch-p ef) ef))
+		    ((null kind) fun))))
+      (when f
+	(let* ((dtype (definition-type f))
+	       (node (lambda-bind fun)))
+	  (setf (leaf-type f) dtype)
+	  (when (and (eq (function-type-returns dtype) *empty-type*)
+		     (policy node (>= safety brevity)))
+	    (let ((*compiler-error-context* node))
+	      (compiler-note "Function does not return."))))))
 
     (get-lambda-environment fun))
   
-- 
GitLab