Fix the lap->code example.

procedure-variables are now cleaned up after phase/setup-block-types
rather than phase/identify-closure-limits, since the multi-closure
code in phase/setup-block-types needs this information.

diff --git a/v7/src/compiler/base/toplev.scm b/v7/src/compiler/base/toplev.scm
index 9eb27cf59926913ba1d36959d8c1d8e92034a05b..df2f36ad477dc3986bef5ce4c2596df625dcb64d 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.27 1990/04/03 04:50:30 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/toplev.scm,v 4.28 1990/05/03 15:03:49 jinx Exp $
 
 Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
@@ -33,6 +33,7 @@ promotional, or sales literature without prior written consent from
 MIT in each case. |#
 
 ;;;; Compiler Top Level
+;;; package: (compiler top-level)
 
 (declare (usual-integrations))
 \f
@@ -167,7 +168,7 @@ MIT in each case. |#
 (define compiler:abort-handled? false)
 (define compiler:abort-continuation)
 \f
-;;; Example of `lap->code' usage:
+;;; Example of `lap->code' usage (MC68020):
 
 #|
 (define bar
@@ -176,7 +177,11 @@ MIT in each case. |#
   (scode-eval
    (lap->code
     'start
-    `((pea (@pcr proc))
+    `((entry-point start)
+      (dc uw #xffff)
+      (block-offset start)
+      (label start)
+      (pea (@pcr proc))
       (or b (& ,(* (microcode-type 'compiled-entry) 4)) (@a 7))
       (mov l (@a+ 7) (@ao 6 8))
       (and b (& #x3) (@a 7))
@@ -719,14 +724,18 @@ MIT in each case. |#
                      (if (not (procedure-continuation? procedure))
                          (begin
                            (set-procedure-free-callees! procedure '())
-                           (set-procedure-free-callers! procedure '())
-                           (set-procedure-variables! procedure '()))))
+                           (set-procedure-free-callers! procedure '()))))
                    *procedures*)))))
 
 (define (phase/setup-block-types)
   (compiler-subphase "Block Type Determination"
     (lambda ()
       (setup-block-types! *root-block*)
+      (if (not compiler:preserve-data-structures?)
+         (for-each (lambda (procedure)
+                     (if (not (procedure-continuation? procedure))
+                         (set-procedure-variables! procedure '())))
+                   *procedures*))
       (setup-closure-contexts! *root-expression* *procedures*))))
 
 (define (phase/compute-call-graph)