From f734076d027c59deaeb7e3fd239a0cb588256037 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 29 Oct 1991 13:31:30 +0000
Subject: [PATCH] Compiler can output multiclosures that are not compiled
 closure objects, but vectors.  The debugging code was never updated to handle
 this case.

---
 v7/src/runtime/uenvir.scm | 21 +++++++++++----------
 v7/src/runtime/uproc.scm  | 10 ++++++----
 v8/src/runtime/uenvir.scm | 21 +++++++++++----------
 3 files changed, 28 insertions(+), 24 deletions(-)

diff --git a/v7/src/runtime/uenvir.scm b/v7/src/runtime/uenvir.scm
index 81b6a2d63..4917a97ef 100644
--- a/v7/src/runtime/uenvir.scm
+++ b/v7/src/runtime/uenvir.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/uenvir.scm,v 14.24 1991/07/21 07:02:17 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/uenvir.scm,v 14.25 1991/10/29 13:31:11 cph Exp $
 
 Copyright (c) 1988-91 Massachusetts Institute of Technology
 
@@ -475,7 +475,7 @@ MIT in each case. |#
 	 (find-stack-element environment
 			     dbg-block/normal-closure-index
 			     "closure")))
-    (if (not (compiled-closure? closure))
+    (if (not (or (compiled-closure? closure) (vector? closure)))
 	(error "Frame missing closure" closure environment))
 #|
     ;; Temporarily disable this consistency check until the compiler
@@ -587,12 +587,14 @@ MIT in each case. |#
     (let ((parent (dbg-block/parent stack-block))
 	  (use-simulation
 	   (lambda ()
-	     (let ((environment
-		    (compiled-code-block/environment
-		     (compiled-entry/block closure))))
-	       (if (ic-environment? environment)
-		   environment
-		   system-global-environment)))))
+	     (if (compiled-closure? closure)
+		 (let ((environment
+			(compiled-code-block/environment
+			 (compiled-entry/block closure))))
+		   (if (ic-environment? environment)
+		       environment
+		       system-global-environment))
+		 system-global-environment))))
       (if parent
 	  (case (dbg-block/type parent)
 	    ((STACK)
@@ -607,8 +609,7 @@ MIT in each case. |#
 	      (let ((index (dbg-block/ic-parent-index closure-block)))
 		(if index
 		    (closure/get-value closure closure-block index)
-		    (compiled-code-block/environment
-		     (compiled-entry/block closure))))))
+		    (use-simulation)))))
 	    (else
 	     (error "Illegal parent block" parent)))
 	  (use-simulation)))))
diff --git a/v7/src/runtime/uproc.scm b/v7/src/runtime/uproc.scm
index 3806331fe..2f774e3da 100644
--- a/v7/src/runtime/uproc.scm
+++ b/v7/src/runtime/uproc.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/uproc.scm,v 1.2 1991/06/10 22:45:37 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/runtime/uproc.scm,v 1.3 1991/10/29 13:31:30 cph Exp $
 
-Copyright (c) 1990 Massachusetts Institute of Technology
+Copyright (c) 1990-91 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -244,8 +244,10 @@ MIT in each case. |#
   (if (not offset)
       ((ucode-primitive primitive-object-ref 2) closure (+ 2 index))
       ((ucode-primitive primitive-object-ref 2)
-       ((ucode-primitive compiled-code-address->block 1)
-	closure)
+       (if (compiled-closure? closure)
+	   ((ucode-primitive compiled-code-address->block 1) closure)
+	   ;; Closure may also be a vector in this case.
+	   closure)
        (+ index offset))))
 
 (define-integrable (compiled-closure/set! closure index offset value)
diff --git a/v8/src/runtime/uenvir.scm b/v8/src/runtime/uenvir.scm
index 468e1d31d..55ce64b40 100644
--- a/v8/src/runtime/uenvir.scm
+++ b/v8/src/runtime/uenvir.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/uenvir.scm,v 14.24 1991/07/21 07:02:17 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/runtime/uenvir.scm,v 14.25 1991/10/29 13:31:11 cph Exp $
 
 Copyright (c) 1988-91 Massachusetts Institute of Technology
 
@@ -475,7 +475,7 @@ MIT in each case. |#
 	 (find-stack-element environment
 			     dbg-block/normal-closure-index
 			     "closure")))
-    (if (not (compiled-closure? closure))
+    (if (not (or (compiled-closure? closure) (vector? closure)))
 	(error "Frame missing closure" closure environment))
 #|
     ;; Temporarily disable this consistency check until the compiler
@@ -587,12 +587,14 @@ MIT in each case. |#
     (let ((parent (dbg-block/parent stack-block))
 	  (use-simulation
 	   (lambda ()
-	     (let ((environment
-		    (compiled-code-block/environment
-		     (compiled-entry/block closure))))
-	       (if (ic-environment? environment)
-		   environment
-		   system-global-environment)))))
+	     (if (compiled-closure? closure)
+		 (let ((environment
+			(compiled-code-block/environment
+			 (compiled-entry/block closure))))
+		   (if (ic-environment? environment)
+		       environment
+		       system-global-environment))
+		 system-global-environment))))
       (if parent
 	  (case (dbg-block/type parent)
 	    ((STACK)
@@ -607,8 +609,7 @@ MIT in each case. |#
 	      (let ((index (dbg-block/ic-parent-index closure-block)))
 		(if index
 		    (closure/get-value closure closure-block index)
-		    (compiled-code-block/environment
-		     (compiled-entry/block closure))))))
+		    (use-simulation)))))
 	    (else
 	     (error "Illegal parent block" parent)))
 	  (use-simulation)))))
-- 
2.25.1