From 23dd14c909d882584e6920643bfa145b4d9bd9b7 Mon Sep 17 00:00:00 2001
From: ram <ram>
Date: Wed, 13 Nov 1991 19:34:18 +0000
Subject: [PATCH] Added DFO-AS-NEEDED, which iterates calling FIND-DFO as many
 times as is necessary to delete all unreachable code.  Also, added some ~&'s
 that improve readability when *compile-progress* is T.

---
 compiler/main.lisp | 54 ++++++++++++++++++++++++++++------------------
 1 file changed, 33 insertions(+), 21 deletions(-)

diff --git a/compiler/main.lisp b/compiler/main.lisp
index 3d7dbae9f..883c0a741 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.45 1991/11/08 15:28:02 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/main.lisp,v 1.46 1991/11/13 19:34:18 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -155,6 +155,24 @@
 (defevent reoptimize-maxed-out
   "*REOPTIMIZE-AFTER-TYPE-CHECK-MAX* exceeded.")
 
+
+;;; DFO-AS-NEEDED  --  Internal
+;;;
+;;;    Iterate doing FIND-DFO until no new dead code is discovered.
+;;;
+(defun dfo-as-needed (component)
+  (declare (type component component))
+  (when (component-reanalyze component)
+    (maybe-mumble "DFO")
+    (loop
+      (find-dfo component)
+      (unless (component-reanalyze component)
+	(maybe-mumble " ")
+	(return))
+      (maybe-mumble ".")))
+  (undefined-value))
+
+
 ;;; IR1-Phases  --  Internal
 ;;;
 ;;;    Do all the IR1 phases for a non-top-level component.
@@ -166,9 +184,7 @@
     (declare (special *constraint-number*))
     (loop
       (ir1-optimize-until-done component)
-      (when (component-reanalyze component)
-	(maybe-mumble "DFO ")
-	(find-dfo component))
+      (dfo-as-needed component)
       (when *constraint-propagate*
 	(maybe-mumble "Constraint ")
 	(constraint-propagate component))
@@ -191,7 +207,7 @@
 ;;;
 (defun compile-component (component object)
   (when *compile-print*
-    (compiler-mumble "Compiling ~A: " (component-name component)))
+    (compiler-mumble "~&Compiling ~A: " (component-name component)))
   
   (ir1-phases component)
   
@@ -207,9 +223,7 @@
 	(*elsewhere* nil))
     (maybe-mumble "Env ")
     (environment-analyze component)
-    (when (component-reanalyze component)
-      (maybe-mumble "DFO ")
-      (find-dfo component))
+    (dfo-as-needed component)
     (maybe-mumble "GTN ")
     (gtn-analyze component)
     (maybe-mumble "LTN ")
@@ -219,13 +233,12 @@
 
     (when (ir2-component-values-receivers (component-info component))
       (maybe-mumble "Stack ")
-      (stack-analyze component))
-
-    ;; Assign BLOCK-NUMBER for any cleanup blocks introduced by environment
-    ;; or stack analysis.  There shouldn't be any unreachable code after
-    ;; control, so this won't delete anything.
-    (when (component-reanalyze component)
-      (find-dfo component))
+      (stack-analyze component)
+      ;;
+      ;; Assign BLOCK-NUMBER for any cleanup blocks introduced by stack
+      ;; analysis.  There shouldn't be any unreachable code after control, so
+      ;; this won't delete anything.
+      (dfo-as-needed component))
 
     (maybe-mumble "IR2Tran ")
     (init-assembler)
@@ -241,6 +254,8 @@
     (when *check-consistency*
       (maybe-mumble "Check2 ")
       (check-ir2-consistency component))
+
+    (delete-unreferenced-tns component)
     
     (maybe-mumble "Life ")
     (lifetime-analyze component)
@@ -249,8 +264,6 @@
       (compiler-mumble "") ; Sync before doing random output.
       (pre-pack-tn-stats component *compiler-error-output*))
 
-    (delete-unreferenced-tns component)
-
     (when *check-consistency*
       (maybe-mumble "CheckL ")
       (check-life-consistency component))
@@ -1067,7 +1080,7 @@
 ;;;
 (defun compile-top-level (lambdas object)
   (declare (list lambdas) (type object object))
-  (maybe-mumble "Local call analyze")
+  (maybe-mumble "Locall ")
   (loop
     (let ((did-something nil))
       (dolist (lambda lambdas)
@@ -1077,9 +1090,8 @@
 	    (setq did-something t)
 	    (local-call-analyze component))))
       (unless did-something (return))))
-  (maybe-mumble ".~%")
   
-  (maybe-mumble "Find components")
+  (maybe-mumble "IDFO ")
   (multiple-value-bind (components top-components hairy-top)
 		       (find-initial-dfo lambdas)
     (let ((*all-components* (append components top-components))
@@ -1277,7 +1289,7 @@
 ;;;
 (defun finish-error-output (source-info won)
   (declare (type source-info source-info))
-  (compiler-mumble "Compilation ~:[aborted after~;finished in~] ~A.~&"
+  (compiler-mumble "~&Compilation ~:[aborted after~;finished in~] ~A.~&"
 		   won
 		   (elapsed-time-to-string
 		    (- (get-universal-time)
-- 
GitLab