From 7be3a9c38f523d9858f70a60f3b02152bcbea49a Mon Sep 17 00:00:00 2001
From: "Guillermo J. Rozas" <edu/mit/csail/zurich/gjr>
Date: Thu, 3 May 1990 15:03:49 +0000
Subject: [PATCH] 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.

---
 v7/src/compiler/base/toplev.scm | 19 ++++++++++++++-----
 1 file changed, 14 insertions(+), 5 deletions(-)

diff --git a/v7/src/compiler/base/toplev.scm b/v7/src/compiler/base/toplev.scm
index 9eb27cf59..df2f36ad4 100644
--- 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))
 
@@ -167,7 +168,7 @@ MIT in each case. |#
 (define compiler:abort-handled? false)
 (define compiler:abort-continuation)
 
-;;; 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)
-- 
2.25.1