From c74314b66ed9c786cd2a2f6e88af037356a43807 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 14 Mar 1989 19:38:55 +0000
Subject: [PATCH] Can't pass a context to `make-return', because it expects a
 block. This is because this procedure is usually called from fggen, and the
 contexts are constructed later.  Change this code to pass the block and then
 clobber it.

---
 v7/src/compiler/fgopt/sideff.scm | 26 ++++++++++++++++----------
 1 file changed, 16 insertions(+), 10 deletions(-)

diff --git a/v7/src/compiler/fgopt/sideff.scm b/v7/src/compiler/fgopt/sideff.scm
index 3a711219c..e3cb8569d 100644
--- a/v7/src/compiler/fgopt/sideff.scm
+++ b/v7/src/compiler/fgopt/sideff.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/fgopt/sideff.scm,v 1.4 1988/12/20 23:13:20 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/fgopt/sideff.scm,v 1.5 1989/03/14 19:38:55 cph Rel $
 
 Copyright (c) 1988 Massachusetts Institute of Technology
 
@@ -420,15 +420,21 @@ MIT in each case. |#
     (set-procedure-properties! procedure
 			       (cons `(SIMPLIFIED ,r/lvalue)
 				     (procedure-properties procedure))))
-  (set-procedure-entry-node!
-   procedure
-   (let ((context (make-reference-context (procedure-block procedure))))
-     (cfg-entry-node
-      (make-return context
-		   (make-reference context
-				   (procedure-continuation-lvalue procedure)
-				   true)
-		   (r/lvalue->rvalue context r/lvalue))))))
+  ;; **** Kludge! `make-application' requires that a block be given,
+  ;; rather than a context, because this is how "fggen" builds things.
+  ;; So we must pass the block and then clobber it after.
+  (let ((block (procedure-block procedure)))
+    (let ((context (make-reference-context block)))
+      (let ((application
+	     (cfg-entry-node
+	      (make-return block
+			   (make-reference
+			    context
+			    (procedure-continuation-lvalue procedure)
+			    true)
+			   (r/lvalue->rvalue context r/lvalue)))))
+	(set-application-context! application context)
+	(set-procedure-entry-node! procedure application)))))
 
 (define (procedure/simplified-value procedure block)
   (let ((node (procedure-entry-node procedure)))
-- 
2.25.1