From: Stephen Adams <edu/mit/csail/zurich/adams>
Date: Tue, 8 Aug 1995 16:20:41 +0000 (+0000)
Subject: *** empty log message ***
X-Git-Tag: 20090517-FFI~6051
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=17730cf78fc9b7b58c0b83862b7f071c23552903;p=mit-scheme.git

*** empty log message ***
---

diff --git a/v8/src/compiler/base/toplev.scm b/v8/src/compiler/base/toplev.scm
index 616d873b6..8075ef01f 100644
--- a/v8/src/compiler/base/toplev.scm
+++ b/v8/src/compiler/base/toplev.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: toplev.scm,v 1.10 1995/08/08 15:59:50 adams Exp $
+$Id: toplev.scm,v 1.11 1995/08/08 16:20:33 adams Exp $
 
 Copyright (c) 1988-1995 Massachusetts Institute of Technology
 
@@ -354,9 +354,9 @@ MIT in each case. |#
 	(newline)
 	(write-string "Final KMP program ")
 	(write *recursive-compilation-number*)
-	(if *kmp-output-abbreviated?*
+	(if compiler:kmp-output-abbreviated?
 	    (begin
-	      (write-string " (*kmp-output-abbreviated?* is #T)")
+	      (write-string " (compiler:kmp-output-abbreviated? is #T)")
 	      (newline)
 	      (kmp/ppp *optimized-kmp-program*))
 	    (fluid-let (;; (*pp-uninterned-symbols-by-name* false)
@@ -521,7 +521,6 @@ MIT in each case. |#
 (define *remote-links*)
 
 (define *kmp-output-port* false)
-(define *kmp-output-abbreviated?* true)
 
 (define *info-output-filename* false)
 (define *rtl-output-port* false)
@@ -706,15 +705,11 @@ MIT in each case. |#
 	(thunk))))
 
 (define *output-prefix* "")
-(define *phase-level* 0)
 
 (define (compiler-phase/invisible thunk)
-  (fluid-let ((*phase-level* (1+ *phase-level*)))
-    (let ((do-it
-	   (if compiler:phase-wrapper
-	       (lambda () (compiler:phase-wrapper thunk))
-	       thunk)))
-      (do-it))))
+  (if compiler:phase-wrapper
+      (lambda () (compiler:phase-wrapper thunk))
+      (thunk)))
 
 
 (define ((compiler-time-reporter prefix) process-non-gc process-gc real)
diff --git a/v8/src/compiler/midend/midend.scm b/v8/src/compiler/midend/midend.scm
index f8c01d468..9401b99e6 100644
--- a/v8/src/compiler/midend/midend.scm
+++ b/v8/src/compiler/midend/midend.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: midend.scm,v 1.15 1995/08/07 16:17:35 adams Exp $
+$Id: midend.scm,v 1.16 1995/08/08 16:20:41 adams Exp $
 
 Copyright (c) 1994 Massachusetts Institute of Technology
 
@@ -38,7 +38,6 @@ MIT in each case. |#
 
 (define *phases-to-show* '())
 (define *phases-to-omit* '())
-(define *announce-phases?* false)
 (define *debugging?* true)
 (define *current-phase-input* false)
 (define *entry-label*)
@@ -61,9 +60,9 @@ MIT in each case. |#
 	(set! pending-message #F)
 	(show-message message)
 	(write-string " #@") (display (hash program))
-	(if *kmp-output-abbreviated?*
+	(if compiler:kmp-output-abbreviated?
 	    (begin
-	      (write-string " (*kmp-output-abbreviated?* is #T)")
+	      (write-string " (compiler:kmp-output-abbreviated? is #T)")
 	      (newline)
 	      (kmp/ppp program))
 	    (begin
@@ -99,13 +98,14 @@ MIT in each case. |#
 	(set! *current-phase* this-phase)
 	(set! *current-phase-input* (and *debugging?* program))
 	(phase/pre-hook program)
-	(if *announce-phases?*
+	(if (and (or compiler:show-subphases? compiler:guru?)
+		 (memq this-phase *phases-to-omit*))
 	    (begin
 	      (newline)
-	      (write-string "    Phase ")
+	      (write-string *output-prefix*)
+	      (write-string "  Omitting ")
 	      (write this-phase)
-	      (if (memq this-phase *phases-to-omit*)
-		  (write-string " omitted (see *phases-to-omit*)"))))
+	      (write-string " (see *phases-to-omit*)")))
 	(let ((result 
 	       (if (not (show? this-phase))
 		   (run-phase program)
@@ -127,12 +127,14 @@ MIT in each case. |#
 	  ;;(gather-phase-statistics program result)
 	  result)))))
 
-(define (phase-wrapper rewrite)
+(define (phase-wrapper name rewrite)
   (lambda (program)
     (let ((table *code-rewrite-table*))
       (set! *previous-code-rewrite-table* table)
       (set! *code-rewrite-table* (and table (code/rewrite-table/make)))
-      (rewrite program))))
+      (compiler-subphase
+       (with-output-to-string (lambda () (write name)))
+       (lambda () (rewrite program))))))
 
 (define (dummy-phase rewrite)
   (lambda (program)
@@ -183,7 +185,7 @@ Example:
 			`(lambda (,name)
 			   ,result)
 			(loop `((debugging-phase-wrapper
-				 (phase-wrapper ,(car all))
+				 (phase-wrapper ',(car all) ,(car all))
 				 ',(car all)
 				 ',(if (null? (cdr all))
 				       false
@@ -208,7 +210,7 @@ Example:
 	     assconv/top-level		; eliminate SET! and introduce LETREC
 					;  rewriting LOOKUP and SET!
 	     cleanup/top-level/1	; as below
-	     ;;coerce/top-level
+	     coerce/top-level
 
 	     earlyrew/top-level		; rewrite -1+ into -, etc.