Compiler can output multiclosures that are not compiled closure

objects, but vectors.  The debugging code was never updated to handle
this case.

diff --git a/v7/src/runtime/uenvir.scm b/v7/src/runtime/uenvir.scm
index 81b6a2d6379a49073b426af4fbd8ca838b6dc0ac..4917a97ef881460ec418df1507e0fe5ceb38bf2c 100644 (file)
--- 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 3806331fe287f5626ed94b03316d068c82b83a05..2f774e3da1d9e586ab59b5f80eecdbbd7841018c 100644 (file)
--- 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 468e1d31dee469a1897e88da577378bc58c67870..55ce64b4023d026e79ae0e5bff409f78f08e665d 100644 (file)
--- 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)))))