From fe822b62cb5a0130f3f957781a5b139b2de91234 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Sat, 2 Jan 1988 19:12:14 +0000 Subject: [PATCH] Fix bug -- locating closing block of closure whose parent is IC block. --- v7/src/compiler/rtlgen/fndblk.scm | 20 +++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) diff --git a/v7/src/compiler/rtlgen/fndblk.scm b/v7/src/compiler/rtlgen/fndblk.scm index e9ea31fb7..47c4d813e 100644 --- a/v7/src/compiler/rtlgen/fndblk.scm +++ b/v7/src/compiler/rtlgen/fndblk.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlgen/fndblk.scm,v 4.3 1987/12/31 08:50:06 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/rtlgen/fndblk.scm,v 4.4 1988/01/02 19:12:14 cph Exp $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -177,14 +177,16 @@ MIT in each case. |# (define (find-block/parent-procedure block) (enumeration-case block-type (block-type block) ((STACK) - (let ((parent (block-parent block))) - (if parent - (enumeration-case block-type (block-type parent) - ((STACK) internal-block/parent-locative) - ((CLOSURE) stack-block/closure-parent-locative) - ((IC) stack-block/static-link-locative) - (else (error "Illegal procedure parent" parent))) - (error "Block has no parent" block)))) + (if (procedure/closure? (block-procedure block)) + stack-block/closure-parent-locative + (let ((parent (block-parent block))) + (if parent + (enumeration-case block-type (block-type parent) + ((STACK) internal-block/parent-locative) + ((IC) stack-block/static-link-locative) + ((CLOSURE) (error "Closure parent of open procedure" block)) + (else (error "Illegal procedure parent" parent))) + (error "Block has no parent" block))))) ((CLOSURE) closure-block/parent-locative) ((CONTINUATION) continuation-block/parent-locative) (else (error "Illegal parent block type" block)))) -- 2.25.1