From 6661108774fd6a67a3ca60921d8a1606b12dfaed Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 13 Dec 1988 13:03:45 +0000
Subject: [PATCH] * Guarantee that `combination/model!' is always defined.

* Change `block' to `context' where needed.
---
 v7/src/compiler/fgopt/closan.scm | 33 +++++++++++++-------------------
 1 file changed, 13 insertions(+), 20 deletions(-)

diff --git a/v7/src/compiler/fgopt/closan.scm b/v7/src/compiler/fgopt/closan.scm
index 4233b7455..662620aac 100644
--- a/v7/src/compiler/fgopt/closan.scm
+++ b/v7/src/compiler/fgopt/closan.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/fgopt/closan.scm,v 4.5 1988/12/06 18:56:18 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/fgopt/closan.scm,v 4.6 1988/12/13 13:03:45 cph Exp $
 
-Copyright (c) 1987 Massachusetts Institute of Technology
+Copyright (c) 1987, 1988 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -71,9 +71,7 @@ result, the analysis has been modified to force the closing-limit to
 
 |#
 
-(package (identify-closure-limits!)
-
-(define-export (identify-closure-limits! procs&conts applications lvalues)
+(define (identify-closure-limits! procs&conts applications lvalues)
   (let ((procedures
 	 (list-transform-negative procs&conts procedure-continuation?)))
     (for-each initialize-lvalues-lists! lvalues)
@@ -125,7 +123,10 @@ result, the analysis has been modified to force the closing-limit to
 	     (if (and (rvalue/procedure? value)
 		      (not (procedure-continuation? value)))
 		 (set-procedure-virtual-closure?! value true)))
-	   values)))))
+	   values))
+	(set-combination/model!
+	 application
+	 (rvalue-known-value (combination/operator application))))))
 
 (define (close-passed-out! procedure)
   (if (and (not (procedure-continuation? procedure))
@@ -172,7 +173,7 @@ result, the analysis has been modified to force the closing-limit to
 		   (close-rvalue! operator false class application)
 		   (close-application-arguments! application false)))))
 	  ((or (not (rvalue/procedure? proc))
-	       (procedure-closure-block proc))
+	       (procedure-closure-context proc))
 	   (close-application-arguments! application false))
 	  (else
 	   'DONE))))
@@ -265,8 +266,8 @@ result, the analysis has been modified to force the closing-limit to
       ;; remaining the same.
       (add-closure-reason! procedure reason1 reason2)
       ;; Force the procedure's type to CLOSURE.
-      (if (not (procedure-closure-block procedure))
-	  (set-procedure-closure-block! procedure true))
+      (if (not (procedure-closure-context procedure))
+	  (set-procedure-closure-context! procedure true))
       ;; The code generator needs all callees to be closed.
       (close-callees! (procedure-block procedure)
 		      new-closing-limit
@@ -286,12 +287,6 @@ result, the analysis has been modified to force the closing-limit to
 ;; These are like the corresponding standard block operations, but
 ;; they ignore any block drifting caused by envopt.
 
-(define-integrable (original-block-parent block)
-  (let ((procedure (block-procedure block)))
-    (and procedure
-	 (rvalue/procedure? procedure)
-	 (procedure-target-block procedure))))
-
 (define (original-block-ancestor-or-self? block block*)
   (define (loop block)
     (and block
@@ -336,7 +331,7 @@ result, the analysis has been modified to force the closing-limit to
 						 original-closing-block))))
 	  ((and (not (block<= block original-closing-block))
 		(rvalue/procedure? (block-procedure original-closing-block))
-		(not (procedure-closure-block
+		(not (procedure-closure-context
 		      (block-procedure original-closing-block))))
 	   ;; My original parent has drifted to a place where I can't
 	   ;; be closed.  I must drag it back.
@@ -352,7 +347,7 @@ result, the analysis has been modified to force the closing-limit to
   (let ((myblock (procedure-block procedure)))
     (for-each
      (lambda (procedure*)
-       (if (false? (procedure-closure-block procedure*))
+       (if (false? (procedure-closure-context procedure*))
 	   (let ((closing-block (procedure-closing-limit procedure*))
 		 (original-closing-block (procedure-target-block procedure*)))
 	     ;; No need to do anything if PROCEDURE* hasn't drifted
@@ -392,6 +387,4 @@ result, the analysis has been modified to force the closing-limit to
 				  (procedure value)))
 			    (rvalue-values
 			     (application-operator application))))
-		(block-applications block*)))))
-
-)
\ No newline at end of file
+		(block-applications block*)))))
\ No newline at end of file
-- 
2.25.1