Transferred version 4.8.1.1 onto the main trunk, essentially undoing

4.9 because we no longer use an expansion phase.

diff --git a/v7/src/compiler/base/toplev.scm b/v7/src/compiler/base/toplev.scm
index 605632134815108ac6e5381fa5c2da28c8f3c999..cf462ecfb2baa6a07a73122b3bdb3a19f831d68b 100644 (file)
--- a/v7/src/compiler/base/toplev.scm
+++ b/v7/src/compiler/base/toplev.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/toplev.scm,v 4.9 1988/08/22 20:25:43 markf Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/toplev.scm,v 4.10 1988/10/20 18:34:36 markf Exp $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -385,38 +385,37 @@ MIT in each case. |#
        (SET! ,name)))
 \f
 (define (phase/fg-generation)
-  (compiler-superphase
-   "Generating the Flow Graph"
-   (lambda ()
-     (phase/canonicalize-scode)
-     (phase/translate-scode))))
+  (compiler-superphase "Flow Graph Generation"
+    (lambda ()
+      (phase/canonicalize-scode)
+      (phase/translate-scode))))
 
 (define (phase/canonicalize-scode)
-  (compiler-subphase "Canonicalizing Scode"
-   (lambda ()
-     (set! *scode* (canonicalize/top-level (last-reference *input-scode*))))))
+  (compiler-subphase "Scode Canonicalization"
+    (lambda ()
+      (set! *scode* (canonicalize/top-level (last-reference *input-scode*))))))
 
 (define (phase/translate-scode)
-  (compiler-subphase "Translating Scode into Flow Graph"
-   (lambda ()
-     (set! *current-label-number* 0)
-     (set! *constants* '())
-     (set! *blocks* '())
-     (set! *expressions* '())
-     (set! *procedures* '())
-     (set! *lvalues* '())
-     (set! *applications* '())
-     (set! *parallels* '())
-     (set! *assignments* '())
-     (set! *root-expression* (construct-graph (last-reference *scode*)))
-     (set! *root-block* (expression-block *root-expression*))
-     (if (or (null? *expressions*)
-            (not (null? (cdr *expressions*))))
-        (error "Multiple expressions"))
-     (set! *expressions*))))
+  (compiler-subphase "Translation of Scode into Flow Graph"
+    (lambda ()
+      (set! *current-label-number* 0)
+      (set! *constants* '())
+      (set! *blocks* '())
+      (set! *expressions* '())
+      (set! *procedures* '())
+      (set! *lvalues* '())
+      (set! *applications* '())
+      (set! *parallels* '())
+      (set! *assignments* '())
+      (set! *root-expression* (construct-graph (last-reference *scode*)))
+      (set! *root-block* (expression-block *root-expression*))
+      (if (or (null? *expressions*)
+             (not (null? (cdr *expressions*))))
+         (error "Multiple expressions"))
+      (set! *expressions*))))
 \f
 (define (phase/fg-optimization)
-  (compiler-superphase "Optimizing the Flow Graph"
+  (compiler-superphase "Flow Graph Optimization"
     (lambda ()
       (phase/simulate-application)
       (phase/outer-analysis)
@@ -433,7 +432,7 @@ MIT in each case. |#
       (phase/fg-optimization-cleanup))))
 
 (define (phase/simulate-application)
-  (compiler-subphase "Simulating Applications"
+  (compiler-subphase "Application Simulation"
     (lambda ()
       (simulate-application *lvalues* *applications*))))
 \f
@@ -443,7 +442,7 @@ MIT in each case. |#
       (outer-analysis *root-expression* *procedures* *applications*))))
 
 (define (phase/fold-constants)
-  (compiler-subphase "Constant Folding"
+  (compiler-subphase "Fold Constants"
     (lambda ()
       (fold-constants *lvalues* *applications*))))
 
@@ -458,12 +457,12 @@ MIT in each case. |#
       (operator-analysis *procedures* *applications*))))
 
 (define (phase/identify-closure-limits)
-  (compiler-subphase "Identifying Closure Limits"
+  (compiler-subphase "Closure Limit Identification"
     (lambda ()
       (identify-closure-limits! *procedures* *applications* *assignments*))))
 
 (define (phase/setup-block-types)
-  (compiler-subphase "Setting Up Block Types"
+  (compiler-subphase "Block Type Determination"
     (lambda ()
       (setup-block-types! *root-block*))))
 
@@ -478,7 +477,7 @@ MIT in each case. |#
       (simplicity-analysis *parallels*))))
 \f
 (define (phase/subproblem-ordering)
-  (compiler-subphase "Ordering Subproblems"
+  (compiler-subphase "Subproblem Ordering"
     (lambda ()
       (subproblem-ordering *parallels*))))
 
@@ -488,17 +487,17 @@ MIT in each case. |#
       (connectivity-analysis *root-expression* *procedures*))))
 
 (define (phase/design-environment-frames)
-  (compiler-subphase "Designing Environment Frames"
+  (compiler-subphase "Environment Frame Design"
     (lambda ()
       (design-environment-frames! *blocks*))))
 
 (define (phase/compute-node-offsets)
-  (compiler-subphase "Computing Node Offsets"
+  (compiler-subphase "Stack Frame Offset Determination"
     (lambda ()
       (compute-node-offsets *root-expression*))))
 
 (define (phase/fg-optimization-cleanup)
-  (compiler-subphase "Cleaning Up After Flow Graph Optimization"
+  (compiler-subphase "Flow Graph Optimization Cleanup"
     (lambda ()
       (if (not compiler:preserve-data-structures?)
          (begin (set! *constants*)
@@ -511,16 +510,14 @@ MIT in each case. |#
                 (set! *root-block*))))))
 \f
 (define (phase/rtl-generation)
-  (compiler-phase "Generating RTL"
+  (compiler-phase "RTL Generation"
     (lambda ()
       (set! *rtl-procedures* '())
       (set! *rtl-continuations* '())
       (set! *rtl-graphs* '())
       (set! *ic-procedure-headers* '())
       (initialize-machine-register-map!)
-      (cleanup-noop-nodes
-       (lambda ()
-        (generate/top-level (last-reference *root-expression*))))
+      (generate/top-level (last-reference *root-expression*))
       (set! label->object
            (make/label->object *rtl-expression*
                                *rtl-procedures*
@@ -545,62 +542,45 @@ MIT in each case. |#
        (write-string " mean")))))
 
 (define (phase/rtl-optimization)
-  (compiler-superphase "Optimizing RTL"
+  (compiler-superphase "RTL Optimization"
     (lambda ()
       (if compiler:cse?
          (phase/common-subexpression-elimination))
-      (cleanup-noop-nodes
-       (lambda ()
-        (phase/rtl-expansion)))
       (phase/lifetime-analysis)
       (if compiler:code-compression?
          (phase/code-compression))
+      (phase/linearization-analysis)
       (phase/register-allocation)
       (phase/rtl-optimization-cleanup))))
 
 (define (phase/common-subexpression-elimination)
-  (compiler-subphase "Eliminating Common Subexpressions"
+  (compiler-subphase "Common Subexpression Elimination"
     (lambda ()
       (common-subexpression-elimination *rtl-graphs*))))
-\f(define (phase/rtl-expansion)
-  (compiler-subphase "Expanding RTL"
-    (lambda ()
-      (rtl-expansion *rtl-graphs*))))
-
-(define (phase/lifetime-analysis)
+\f(define (phase/lifetime-analysis)
   (compiler-subphase "Lifetime Analysis"
     (lambda ()
       (lifetime-analysis *rtl-graphs*))))
 
 (define (phase/code-compression)
-  (compiler-subphase "Code Compression"
+  (compiler-subphase "Instruction Combination"
     (lambda ()
       (code-compression *rtl-graphs*))))
 
-(define (phase/rtl-file-output pathname)
-  (compiler-phase "RTL File Output"
+(define (phase/linearization-analysis)
+  (compiler-subphase "Linearization Analysis"
     (lambda ()
-      (let ((rtl (linearize-rtl *rtl-graphs*)))
-       (if (eq? pathname true)
-           ;; recursive compilation
-           (set! *recursive-compilation-rtl-blocks*
-                 (cons (cons *recursive-compilation-number* rtl)
-                       *recursive-compilation-rtl-blocks*))
-           (fasdump (if (null? *recursive-compilation-rtl-blocks*)
-                        rtl
-                        (list->vector
-                         (cons (cons 0 rtl)
-                               *recursive-compilation-rtl-blocks*)))
-                    pathname))))))
+      (setup-bblock-continuations! *rtl-graphs*))))
 
 (define (phase/register-allocation)
-  (compiler-subphase "Allocating Registers"
+  (compiler-subphase "Register Allocation"
     (lambda ()
       (register-allocation *rtl-graphs*))))
 
 (define (phase/rtl-optimization-cleanup)
   (if (not compiler:preserve-data-structures?)
       (for-each (lambda (rgraph)
+                 (set-rgraph-bblocks! rgraph false)
                  ;; **** this slot is reused. ****
                  ;;(set-rgraph-register-bblock! rgraph false)
                  (set-rgraph-register-crosses-call?! rgraph false)
@@ -609,8 +589,27 @@ MIT in each case. |#
                  (set-rgraph-register-n-refs! rgraph false))
                *rtl-graphs*)))
 
+(define (phase/rtl-file-output pathname)
+  (compiler-phase "RTL File Output"
+    (lambda ()
+      (let ((rtl
+            (linearize-rtl *rtl-expression*
+                           *rtl-procedures*
+                           *rtl-continuations*)))
+       (if (eq? pathname true)
+           ;; recursive compilation
+           (set! *recursive-compilation-rtl-blocks*
+                 (cons (cons *recursive-compilation-number* rtl)
+                       *recursive-compilation-rtl-blocks*))
+           (fasdump (if (null? *recursive-compilation-rtl-blocks*)
+                        rtl
+                        (list->vector
+                         (cons (cons 0 rtl)
+                               *recursive-compilation-rtl-blocks*)))
+                    pathname))))))
+
 (define (phase/bit-generation)
-  (compiler-phase "Generating BITs"
+  (compiler-phase "LAP Generation"
     (lambda ()
       (set! compiler:external-labels '())
       (generate-bits
@@ -619,23 +618,26 @@ MIT in each case. |#
         (set! compiler:block-label block-label)
         (node-insert-snode! (rtl-expr/entry-node *rtl-expression*)
                             (make-sblock prefix))))
-      (set! compiler:entry-label (rtl-expr/label *rtl-expression*))
-      (if (not compiler:preserve-data-structures?)
-         (begin (set! label->object)
-                (set! *rtl-expression*)
-                (set! *rtl-procedures*)
-                (set! *rtl-continuations*))))))
+      (set! compiler:entry-label (rtl-expr/label *rtl-expression*)))))
 \f
 (define (phase/bit-linearization)
-  (compiler-phase "Linearizing BITs"
+  (compiler-phase "LAP Linearization"
     (lambda ()
       (set! compiler:bits
            (append-instruction-sequences!
             (lap:make-entry-point compiler:entry-label compiler:block-label)
-            (linearize-bits (last-reference *rtl-graphs*)))))))
+            (linearize-bits *rtl-expression*
+                            *rtl-procedures*
+                            *rtl-continuations*)))
+      (if (not compiler:preserve-data-structures?)
+         (begin (set! label->object)
+                (set! *rtl-expression*)
+                (set! *rtl-procedures*)
+                (set! *rtl-continuations*)
+                (set! *rtl-graphs*))))))
 
 (define (phase/assemble)
-  (compiler-phase "Assembling"
+  (compiler-phase "Assembly"
     (lambda ()
       (if compiler:preserve-data-structures?
          (assemble compiler:block-label compiler:bits phase/assemble-finish)
@@ -656,7 +658,7 @@ MIT in each case. |#
       (display " iterations.")))
 
 (define (phase/info-generation-2 pathname)
-  (compiler-phase "Generating Debugging Information (pass 2)"
+  (compiler-phase "Debugging Information Generation"
    (lambda ()
      (let ((info
            (generation-phase2 compiler:label-bindings
@@ -682,7 +684,7 @@ MIT in each case. |#
              (pathname->string pathname))))))))
 \f
 (define (phase/link)
-  (compiler-phase "Linking"
+  (compiler-phase "Linkification"
     (lambda ()
       ;; This has sections locked against GC to prevent relocation
       ;; while computing addresses.