When accessing `block-procedure', make sure it is a procedure before

using it as such; it might be an expression instead.

diff --git a/v7/src/compiler/fgopt/closan.scm b/v7/src/compiler/fgopt/closan.scm
index a315bfe1357cb402fba98d87d32236aa23e51ddc..55cf3407a3ddcbc78c0c8ad7165eedae4e36870c 100644 (file)
--- 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 e3cb8569d05305cf19c7baa2abe26ad9f4e1ccbe..03d6bee2e3aebd0e7327a2916e2de9632d1d3e59 100644 (file)
--- 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 2bbacc03e219c0ae90810f38b103a35f4ebda03e..c0ea5b893e9f7e0247f1acb44d43143b9cf7e22b 100644 (file)
--- 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 486d85e7ee19b6432dbe6d0a6ee1883201ae41f6..3fc74805f5d6ff24d6a5845508da6bcf39160940 100644 (file)
--- 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)))))