Fixed COMPILED-PROCEDURE/ENVIRONMENT not to SIGSEGV on compiled

procedures which have no free variables.  This happened because the
compiler failed to produce a dbg-block for the dbg-block/parent of the
procedure's dbg-block.  An alternative fix would be to modify the
compiler to insert the correct IC dbg-block instead of leaving it as
#F.

diff --git a/v7/src/runtime/uenvir.scm b/v7/src/runtime/uenvir.scm
index 8f525264ca9b51ebaf93c812c387d06915cd0cbb..ca1bc11b5f793dd88c5c2b45ad5fd26803f1f7b2 100644 (file)
--- a/v7/src/runtime/uenvir.scm
+++ b/v7/src/runtime/uenvir.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: uenvir.scm,v 14.34 1994/12/15 22:19:37 adams Exp $
+$Id: uenvir.scm,v 14.35 1995/02/09 21:23:49 adams Exp $
 
 Copyright (c) 1988-1992 Massachusetts Institute of Technology
 
@@ -342,17 +342,22 @@ MIT in each case. |#
          (error "Unable to obtain closing environment (missing block info)"
                 entry))
       (let ((parent (dbg-block/parent block)))
-       (case (dbg-block/type parent)
-         ((CLOSURE)
-          (make-closure-ccenv (dbg-block/original-parent block)
-                              parent
-                              entry))
-         ((IC)
-          (guarantee-interpreter-environment
-           (compiled-code-block/environment
-            (compiled-code-address->block entry))))
-         (else
-          (error "Illegal procedure parent block" parent)))))))
+       (define (use-compile-code-block-environment)
+         (guarantee-interpreter-environment
+          (compiled-code-block/environment
+           (compiled-code-address->block entry))))
+       (if parent
+           (case (dbg-block/type parent)
+             ((CLOSURE)
+              (make-closure-ccenv (dbg-block/original-parent block)
+                                  parent
+                                  entry))
+             ((IC)
+              (use-compile-code-block-environment))
+             (else
+              (error "Illegal procedure parent block" parent)))
+           ;; This happens when the procedure has no free variables:
+           (use-compile-code-block-environment))))))
 \f
 (define (stack-ccenv/has-parent? environment)
   (if (dbg-block/parent (stack-ccenv/block environment))

diff --git a/v8/src/runtime/uenvir.scm b/v8/src/runtime/uenvir.scm
index 8f525264ca9b51ebaf93c812c387d06915cd0cbb..ca1bc11b5f793dd88c5c2b45ad5fd26803f1f7b2 100644 (file)
--- a/v8/src/runtime/uenvir.scm
+++ b/v8/src/runtime/uenvir.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: uenvir.scm,v 14.34 1994/12/15 22:19:37 adams Exp $
+$Id: uenvir.scm,v 14.35 1995/02/09 21:23:49 adams Exp $
 
 Copyright (c) 1988-1992 Massachusetts Institute of Technology
 
@@ -342,17 +342,22 @@ MIT in each case. |#
          (error "Unable to obtain closing environment (missing block info)"
                 entry))
       (let ((parent (dbg-block/parent block)))
-       (case (dbg-block/type parent)
-         ((CLOSURE)
-          (make-closure-ccenv (dbg-block/original-parent block)
-                              parent
-                              entry))
-         ((IC)
-          (guarantee-interpreter-environment
-           (compiled-code-block/environment
-            (compiled-code-address->block entry))))
-         (else
-          (error "Illegal procedure parent block" parent)))))))
+       (define (use-compile-code-block-environment)
+         (guarantee-interpreter-environment
+          (compiled-code-block/environment
+           (compiled-code-address->block entry))))
+       (if parent
+           (case (dbg-block/type parent)
+             ((CLOSURE)
+              (make-closure-ccenv (dbg-block/original-parent block)
+                                  parent
+                                  entry))
+             ((IC)
+              (use-compile-code-block-environment))
+             (else
+              (error "Illegal procedure parent block" parent)))
+           ;; This happens when the procedure has no free variables:
+           (use-compile-code-block-environment))))))
 \f
 (define (stack-ccenv/has-parent? environment)
   (if (dbg-block/parent (stack-ccenv/block environment))