From 177cea359afa4b73abf43ce687aa34e47be9538a Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Sun, 2 Dec 2001 20:06:58 +0000 Subject: [PATCH] 0.pre7.86.flaky7.16: (still works as well as before, still fails in pathnames.impure.lisp the same way as before, since all the changes are still only preparation for a real fix) making FIND-INITIAL-DFO recognize closure dependencies, continued... ...In order to make the information conveniently available for DFO-SCAVENGE-DEPENDENCY-GRAPH, add a new slot LAMBDA-REFERS-TO-VARS, analogous to LAMBDA-CALLS. ...made IR1-CONVERT-VARIABLE and DEF-IR1-TRANSLATOR SETQ set LAMBDA-REFERS-TO-VARS as appropriate ...wrote untidy CONTINUATION-HOME-LAMBDA to support this ...tweaked CONTINUATION-STARTS-BLOCK and LINK-BLOCKS so that when IR1-CONVERT-IF uses them it sets up links early enough to let CONTINUATION-HOME-LAMBDA work ...made merge-LETs logic merge LAMBDA-REFERS-TO-VARS as it already merged LAMBDA-CALLS --- src/compiler/ir1-translators.lisp | 26 ++++++++++--------- src/compiler/ir1tran.lisp | 15 ++++++----- src/compiler/ir1util.lisp | 51 ++++++++++++++++++++++++++++++------- src/compiler/locall.lisp | 11 +++++++- src/compiler/node.lisp | 10 +++++++- version.lisp-expr | 2 +- 6 files changed, 85 insertions(+), 30 deletions(-) diff --git a/src/compiler/ir1-translators.lisp b/src/compiler/ir1-translators.lisp index 5f12ea2..e7c4b01 100644 --- a/src/compiler/ir1-translators.lisp +++ b/src/compiler/ir1-translators.lisp @@ -45,15 +45,15 @@ (continuation-starts-block cont) (link-blocks start-block then-block) - (link-blocks start-block else-block) + (link-blocks start-block else-block)) - (ir1-convert then-cont cont then) - (ir1-convert else-cont cont else)))) + (ir1-convert then-cont cont then) + (ir1-convert else-cont cont else))) ;;;; BLOCK and TAGBODY -;;;; We make an Entry node to mark the start and a :Entry cleanup to -;;;; mark its extent. When doing GO or RETURN-FROM, we emit an Exit +;;;; We make an ENTRY node to mark the start and a :ENTRY cleanup to +;;;; mark its extent. When doing GO or RETURN-FROM, we emit an EXIT ;;;; node. ;;; Make a :ENTRY cleanup and emit an ENTRY node, then convert the @@ -741,13 +741,15 @@ (leaf (when (constant-p leaf) (compiler-error "~S is a constant and thus can't be set." name)) - (when (and (lambda-var-p leaf) - (lambda-var-ignorep leaf)) - ;; ANSI's definition of "Declaration IGNORE, IGNORABLE" - ;; requires that this be a STYLE-WARNING, not a full warning. - (compiler-style-warning - "~S is being set even though it was declared to be ignored." - name)) + (when (lambda-var-p leaf) + (let ((home-lambda (continuation-home-lambda start))) + (pushnew leaf (lambda-refers-to-vars home-lambda))) + (when (lambda-var-ignorep leaf) + ;; ANSI's definition of "Declaration IGNORE, IGNORABLE" + ;; requires that this be a STYLE-WARNING, not a full warning. + (compiler-style-warning + "~S is being set even though it was declared to be ignored." + name))) (set-variable start cont leaf (second things))) (cons (aver (eq (car leaf) 'MACRO)) diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp index 36cfd94..61b9a74 100644 --- a/src/compiler/ir1tran.lisp +++ b/src/compiler/ir1tran.lisp @@ -523,10 +523,13 @@ (let ((var (or (lexenv-find name variables) (find-free-variable name)))) (etypecase var (leaf - (when (and (lambda-var-p var) (lambda-var-ignorep var)) - ;; (ANSI's specification for the IGNORE declaration requires - ;; that this be a STYLE-WARNING, not a full WARNING.) - (compiler-style-warning "reading an ignored variable: ~S" name)) + (when (lambda-var-p var) + (pushnew var + (lambda-refers-to-vars (continuation-home-lambda start))) + (when (lambda-var-ignorep var) + ;; (ANSI's specification for the IGNORE declaration requires + ;; that this be a STYLE-WARNING, not a full WARNING.) + (compiler-style-warning "reading an ignored variable: ~S" name))) (reference-leaf start cont var)) (cons (aver (eq (car var) 'MACRO)) @@ -678,8 +681,8 @@ ;;;; converting combinations ;;; Convert a function call where the function (i.e. the FUN argument) -;;; is a LEAF. We return the COMBINATION node so that we can poke at -;;; it if we want to. +;;; is a LEAF. We return the COMBINATION node so that the caller can +;;; poke at it if it wants to. (declaim (ftype (function (continuation continuation list leaf) combination) ir1-convert-combination)) (defun ir1-convert-combination (start cont form fun) diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp index 4f2eb6e..2d2d687 100644 --- a/src/compiler/ir1util.lisp +++ b/src/compiler/ir1util.lisp @@ -203,13 +203,14 @@ (:block-start (continuation-block cont)))) -;;; Ensure that Cont is the start of a block (or deleted) so that the use -;;; set can be freely manipulated. -;;; -- If the continuation is :Unused or is :Inside-Block and the Cont of Last -;;; in its block, then we make it the start of a new deleted block. -;;; -- If the continuation is :Inside-Block inside a block, then we split the -;;; block using Node-Ends-Block, which makes the continuation be a -;;; :Block-Start. +;;; Ensure that CONT is the start of a block (or deleted) so that +;;; the use set can be freely manipulated. +;;; -- If the continuation is :UNUSED or is :INSIDE-BLOCK and the +;;; CONT of LAST in its block, then we make it the start of a new +;;; deleted block. +;;; -- If the continuation is :INSIDE-BLOCK inside a block, then we +;;; split the block using Node-Ends-Block, which makes the +;;; continuation be a :BLOCK-START. (defun ensure-block-start (cont) (declare (type continuation cont)) (let ((kind (continuation-kind cont))) @@ -275,13 +276,28 @@ (defun block-home-lambda (block) (declare (type cblock block)) #!-sb-fluid (declare (inline node-home-lambda)) - (node-home-lambda (block-last block))) + (if (node-p (block-last block)) + ;; This is the old CMU CL way of doing it. + (node-home-lambda (block-last block)) + ;; The CMU CL approach sometimes fails, e.g. in IR1-CONVERT of + ;; one of the legs of an IF, now that SBCL uses this operation + ;; more aggressively than CMU CL did. + ;; + ;; In this case we reason that previous-in-target-execution-order + ;; blocks should be in the same lambda, and that they seem in + ;; practice to be previous-in-compilation-order blocks too, + ;; so we look back to find one which is sufficiently + ;; initialized to tell us what the home lambda is. We could + ;; get fancy about this, flooding the graph of all the + ;; previous blocks, but in practice it seems to work just + ;; to grab the first previous block and use it. + (node-home-lambda (block-last (first (block-pred block)))))) ;;; Return the IR1 physical environment for BLOCK. (defun block-physenv (block) (declare (type cblock block)) #!-sb-fluid (declare (inline node-home-lambda)) - (lambda-physenv (node-home-lambda (block-last block)))) + (lambda-physenv (block-home-lambda block))) ;;; Return the Top Level Form number of PATH, i.e. the ordinal number ;;; of its original source's top level form in its compilation unit. @@ -324,6 +340,23 @@ (if use (values (node-source-form use) t) (values nil nil)))) + +;;; Return the LAMBDA that is CONT's home. +(defun continuation-home-lambda (cont) + ;; KLUDGE: This function is a post-CMU-CL hack by WHN, and this + ;; implementation might not be quite right, or might be uglier than + ;; necessary. It appears that the original Python never found a need + ;; to do this operation. The obvious things based on + ;; NODE-HOME-LAMBDA of CONTINUATION-USE usually works; then if that + ;; fails, BLOCK-HOME-LAMBDA of CONTINUATION-BLOCK works, given that + ;; generalize it enough to grovel harder when the simple CMU CL + ;; approach fails. -- WHN 2001-12-02 + (cond ((continuation-use cont) + (node-home-lambda (continuation-use cont))) + ((continuation-block cont) + (block-home-lambda (continuation-block cont))) + (t + (error "internal error: can't find home lambda for ~S")))) ;;; Return a new LEXENV just like DEFAULT except for the specified ;;; slot values. Values for the alist slots are NCONCed to the diff --git a/src/compiler/locall.lisp b/src/compiler/locall.lisp index d16b38d..8cab2c5 100644 --- a/src/compiler/locall.lisp +++ b/src/compiler/locall.lisp @@ -783,9 +783,18 @@ ;; which calls things. (setf (lambda-calls clambda) nil) + ;; All of CLAMBDA's variable references belong to HOME now. + (setf (lambda-refers-to-vars home) + (nunion (lambda-refers-to-vars clambda) + (lambda-refers-to-vars home))) + ;; CLAMBDA no longer has an independent existence as an entity + ;; which refers to things. + (setf (lambda-refers-to-vars clambda) nil) + ;; All of CLAMBDA's ENTRIES belong to HOME now. (setf (lambda-entries home) - (nconc (lambda-entries clambda) (lambda-entries home))) + (nconc (lambda-entries clambda) + (lambda-entries home))) ;; CLAMBDA no longer has an independent existence as an entity ;; with ENTRIES. (setf (lambda-entries clambda) nil)) diff --git a/src/compiler/node.lisp b/src/compiler/node.lisp index c8e43e6..dcb0a69 100644 --- a/src/compiler/node.lisp +++ b/src/compiler/node.lisp @@ -84,7 +84,7 @@ ;; cached type of this continuation's value. If NIL, then this must ;; be recomputed: see CONTINUATION-DERIVED-TYPE. (%derived-type nil :type (or ctype null)) - ;; Node where this continuation is used, if unique. This is always + ;; the node where this continuation is used, if unique. This is always ;; null in :DELETED and :UNUSED continuations, and is never null in ;; :INSIDE-BLOCK continuations. In a :BLOCK-START continuation, the ;; Block's START-USES indicate whether NIL means no uses or more @@ -922,6 +922,14 @@ ;; (or one of its LETs) using a non-LET local call. This may include ;; deleted functions because nobody bothers to clear them out. (calls () :type list) + ;; a list of all the LAMBDA-VARs directly referred to from this + ;; function (or one of its LETs). This may include deleted variables + ;; because nobody bothers to clean them out. + ;; + ;; FIXME: This is completely analogous to the CALLS slot, except the + ;; elements here are LAMBDA-VARs instead of FUNCTIONALs. Maybe the + ;; two lists should be merged into a single list. + (refers-to-vars () :type list) ;; the TAIL-SET that this LAMBDA is in. This is null during creation. ;; ;; In CMU CL, and old SBCL, this was also NILed out when LET diff --git a/version.lisp-expr b/version.lisp-expr index f4a439e..099af03 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; for internal versions, especially for internal versions off the ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.pre7.86.flaky7.14" +"0.pre7.86.flaky7.16" -- 1.7.10.4