From ae4f6575705783dd310a39e40b5a240bb5310397 Mon Sep 17 00:00:00 2001 From: ram <ram> Date: Sat, 17 Nov 1990 18:06:32 +0000 Subject: [PATCH] Fixed REPLACE-TOP-LEVEL-XEPS to return T in a few more cases so that we don't bogue out due to premature deletion of the IR1 when *CHECK-CONSISTENCY* is off. --- compiler/entry.lisp | 57 +++++++++++++++++++++++++++------------------ 1 file changed, 34 insertions(+), 23 deletions(-) diff --git a/compiler/entry.lisp b/compiler/entry.lisp index be4ad82bb..44fc6cbe4 100644 --- a/compiler/entry.lisp +++ b/compiler/entry.lisp @@ -80,31 +80,42 @@ ;;; REPLACE-TOP-LEVEL-XEPS -- Interface ;;; -;;; Replace all references in other components to non-closure XEPs in -;;; Component with :TOP-LEVEL-XEP functionals. We return true if any closure -;;; references were encountered. We deliberately don't use the normal -;;; reference deletion, since we don't want to trigger deletion of the XEP -;;; (although it shouldn't hurt, since this is called after Component is -;;; compiled.) Instead, we just clobber the REF-LEAF. +;;; Replace all references to Component's non-closure XEPS that appear in +;;; top-level components, changing to :TOP-LEVEL-XEP functionals. If the +;;; cross-component ref is not in a :TOP-LEVEL component, or is to a closure, +;;; then substitution is suppressed. +;;; +;;; When a cross-component ref is not substituted, we return T to indicate that +;;; early deletion of this component's IR1 should not be done. We also return +;;; T if this component contains :TOP-LEVEL lambdas (though it is not a +;;; :TOP-LEVEL component.) +;;; +;;; We deliberately don't use the normal reference deletion, since we don't +;;; want to trigger deletion of the XEP (although it shouldn't hurt, since this +;;; is called after Component is compiled.) Instead, we just clobber the +;;; REF-LEAF. ;;; (defun replace-top-level-xeps (component) (let ((res nil)) (dolist (lambda (component-lambdas component)) - (when (eq (functional-kind lambda) :external) - (let* ((ef (functional-entry-function lambda)) - (new (make-functional :kind :top-level-xep - :info (leaf-info lambda) - :name (leaf-name ef) - :lexenv (make-null-environment))) - (closure (environment-closure - (lambda-environment (main-entry ef))))) - (dolist (ref (leaf-refs lambda)) - (let ((ref-component (block-component (node-block ref)))) - (when (and (not (eq ref-component component)) - (eq (component-kind ref-component) :top-level)) - (cond (closure - (setq res t)) - (t - (setf (ref-leaf ref) new) - (push ref (leaf-refs new)))))))))) + (case (functional-kind lambda) + (:external + (let* ((ef (functional-entry-function lambda)) + (new (make-functional :kind :top-level-xep + :info (leaf-info lambda) + :name (leaf-name ef) + :lexenv (make-null-environment))) + (closure (environment-closure + (lambda-environment (main-entry ef))))) + (dolist (ref (leaf-refs lambda)) + (let ((ref-component (block-component (node-block ref)))) + (cond ((eq ref-component component)) + ((or (not (eq (component-kind ref-component) :top-level)) + closure) + (setq res t)) + (t + (setf (ref-leaf ref) new) + (push ref (leaf-refs new)))))))) + (:top-level + (setq res t)))) res)) -- GitLab