From 37c985c2fb2cbee5f648a21ec47b9ddf4694eea5 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 21 Mar 1990 02:12:51 +0000
Subject: [PATCH] When accessing `block-procedure', make sure it is a procedure
 before using it as such; it might be an expression instead.

---
 v7/src/compiler/fgopt/closan.scm               | 8 +++++---
 v7/src/compiler/fgopt/sideff.scm               | 8 +++++---
 v7/src/compiler/machines/bobcat/make.scm-68040 | 4 ++--
 v7/src/compiler/rtlgen/rgstmt.scm              | 8 +++++---
 4 files changed, 17 insertions(+), 11 deletions(-)

diff --git a/v7/src/compiler/fgopt/closan.scm b/v7/src/compiler/fgopt/closan.scm
index a315bfe13..55cf3407a 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.11 1989/12/02 21:19:29 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/fgopt/closan.scm,v 4.12 1990/03/21 02:11:13 cph Exp $
 
-Copyright (c) 1987, 1988, 1989 Massachusetts Institute of Technology
+Copyright (c) 1987, 1988, 1989, 1990 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -259,7 +259,9 @@ MIT in each case. |#
 		 (let loop ((block* block*))
 		   (if block*
 		       (let ((procedure (block-procedure block*)))
-			 (if (eq? true (procedure-closure-context procedure))
+			 (if (and (rvalue/procedure? procedure)
+				  (eq? (procedure-closure-context procedure)
+				       true))
 			     (close-non-descendent-callees! procedure block)
 			     (loop (block-parent block*)))))))))
 	  (if (not entry)
diff --git a/v7/src/compiler/fgopt/sideff.scm b/v7/src/compiler/fgopt/sideff.scm
index e3cb8569d..03d6bee2e 100644
--- a/v7/src/compiler/fgopt/sideff.scm
+++ b/v7/src/compiler/fgopt/sideff.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$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 $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/fgopt/sideff.scm,v 1.6 1990/03/21 02:11:37 cph Exp $
 
-Copyright (c) 1988 Massachusetts Institute of Technology
+Copyright (c) 1988, 1990 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -319,7 +319,9 @@ MIT in each case. |#
   (define (simplify-combination! value)
     (combination/constant! app
 			   (r/lvalue->rvalue (combination/context app) value))
-    (enqueue-node! (block-procedure (application-block app))))
+    (let ((procedure (block-procedure (application-block app))))
+      (if (rvalue/procedure? procedure)
+	  (enqueue-node! procedure))))
 
   (define (check value op-vals)
     (if (and value
diff --git a/v7/src/compiler/machines/bobcat/make.scm-68040 b/v7/src/compiler/machines/bobcat/make.scm-68040
index 2bbacc03e..c0ea5b893 100644
--- a/v7/src/compiler/machines/bobcat/make.scm-68040
+++ b/v7/src/compiler/machines/bobcat/make.scm-68040
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/make.scm-68040,v 4.69 1990/03/14 21:06:31 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/machines/bobcat/make.scm-68040,v 4.70 1990/03/21 02:12:51 cph Exp $
 
 Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
 
@@ -41,4 +41,4 @@ MIT in each case. |#
 	    ((package/reference (find-package name) 'INITIALIZE-PACKAGE!)))
 	  '((COMPILER MACROS)
 	    (COMPILER DECLARATIONS)))
-(add-system! (make-system "Liar (Motorola MC68020)" 4 69 '()))
\ No newline at end of file
+(add-system! (make-system "Liar (Motorola MC68020)" 4 70 '()))
\ No newline at end of file
diff --git a/v7/src/compiler/rtlgen/rgstmt.scm b/v7/src/compiler/rtlgen/rgstmt.scm
index 486d85e7e..3fc74805f 100644
--- a/v7/src/compiler/rtlgen/rgstmt.scm
+++ b/v7/src/compiler/rtlgen/rgstmt.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlgen/rgstmt.scm,v 4.12 1990/02/02 18:40:04 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlgen/rgstmt.scm,v 4.13 1990/03/21 02:12:01 cph Exp $
 
 Copyright (c) 1988, 1990 Massachusetts Institute of Technology
 
@@ -161,8 +161,10 @@ MIT in each case. |#
 		   ((let ((variable (virtual-return/target-lvalue return)))
 		      (and variable
 			   (variable-in-cell? variable)
-			   (procedure-inline-code?
-			    (block-procedure (variable-block variable)))))
+			   (let ((procedure
+				  (block-procedure (variable-block variable))))
+			     (and (rvalue/procedure? procedure)
+				  (procedure-inline-code? procedure)))))
 		    (generate/rvalue operand scfg*scfg->scfg!
 		      (lambda (expression)
 			(rtl:make-push (rtl:make-cell-cons expression)))))
-- 
2.25.1