From 1bad3b034f90c2945252385847975c79da7dd13f Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Mon, 5 Nov 2001 18:12:13 +0000 Subject: [PATCH] Three fixes that together resolve the problem of compiling the XML parser. (1) FOR-EACH-CALLEE! claimed to examine all of the callees, but it wasn't looking at procedures called from descendant blocks that had been disowned. (2) When removing dependent constraints, due to closure, constraints that had indirect dependencies on the now-closed procedure weren't being removed. (3) When adding undrifting constraints due to closure contagion, it's wrong to constrain the invocation block of a trivial closure. --- v7/src/compiler/fgopt/closan.scm | 20 +++++++++----------- 1 file changed, 9 insertions(+), 11 deletions(-) diff --git a/v7/src/compiler/fgopt/closan.scm b/v7/src/compiler/fgopt/closan.scm index a3b25f368..0a8151c6f 100644 --- a/v7/src/compiler/fgopt/closan.scm +++ b/v7/src/compiler/fgopt/closan.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: closan.scm,v 4.26 2001/11/03 05:16:48 cph Exp $ +$Id: closan.scm,v 4.27 2001/11/05 18:12:13 cph Exp $ Copyright (c) 1987-1991, 1998, 1999, 2001 Massachusetts Institute of Technology @@ -302,10 +302,7 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA (application-operator application)))) (block-applications block)) (for-each loop (block-children block)) - #| - (for-each loop (block-disowned-children block)) - |# - ))) + (for-each loop (block-disowned-children block))))) (define (undrifting-constraint! block block* condition) ;; Undrift BLOCK so it is a descendant of BLOCK*, due to CONDITION. @@ -323,8 +320,12 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA block*)) (loop (block-parent block)) block)))) - (if (add-constraint block block* condition) - (update-callers-and-callees! block block* condition)))))) + (if (not (and (eq? (condition-keyword condition) 'CONTAGION) + (let ((procedure (block-procedure block))) + (and procedure + (procedure/trivial-closure? procedure))))) + (if (add-constraint block block* condition) + (update-callers-and-callees! block block* condition))))))) (define (update-callers-and-callees! block block* condition) ;; The context of BLOCK has changed, so it may be necessary to @@ -407,11 +408,8 @@ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA (and condition (or (eq? procedure (condition-procedure condition)) - #| (memq procedure - (condition-dependencies condition)) - |# - ) + (condition-dependencies condition))) (begin (debug:remove-condition (car entry) (car entry*) -- 2.25.1