From e17fc7facd62020806e05c19e299664020594804 Mon Sep 17 00:00:00 2001 From: Stephen Adams Date: Thu, 9 Feb 1995 21:23:49 +0000 Subject: [PATCH] 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. --- v7/src/runtime/uenvir.scm | 29 +++++++++++++++++------------ v8/src/runtime/uenvir.scm | 29 +++++++++++++++++------------ 2 files changed, 34 insertions(+), 24 deletions(-) diff --git a/v7/src/runtime/uenvir.scm b/v7/src/runtime/uenvir.scm index 8f525264c..ca1bc11b5 100644 --- 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)))))) (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 8f525264c..ca1bc11b5 100644 --- 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)))))) (define (stack-ccenv/has-parent? environment) (if (dbg-block/parent (stack-ccenv/block environment)) -- 2.25.1