diff options
| -rwxr-xr-x | make.sh | 1 | ||||
| -rw-r--r-- | src/code/target-error.lisp | 2 | ||||
| -rw-r--r-- | src/compiler/dfo.lisp | 46 | ||||
| -rw-r--r-- | src/compiler/ir1-translators.lisp | 2 | ||||
| -rw-r--r-- | src/compiler/ir1tran.lisp | 2 | ||||
| -rw-r--r-- | src/compiler/locall.lisp | 81 | ||||
| -rw-r--r-- | src/compiler/node.lisp | 29 | ||||
| -rw-r--r-- | version.lisp-expr | 2 |
8 files changed, 76 insertions, 89 deletions
@@ -1,4 +1,3 @@ - #!/bin/sh # "When we build software, it's a good idea to have a reliable method diff --git a/src/code/target-error.lisp b/src/code/target-error.lisp index 72ca0f04a..380a3de1c 100644 --- a/src/code/target-error.lisp +++ b/src/code/target-error.lisp @@ -288,7 +288,7 @@ body) If restart-name is not invoked, then all values returned by forms are returned. If control is transferred to this restart, it immediately - returns the values nil and t." + returns the values NIL and T." `(restart-case ;; If there's just one body form, then don't use PROGN. This allows ;; RESTART-CASE to "see" calls to ERROR, etc. diff --git a/src/compiler/dfo.lisp b/src/compiler/dfo.lisp index 68469c8f2..a135cd575 100644 --- a/src/compiler/dfo.lisp +++ b/src/compiler/dfo.lisp @@ -255,27 +255,31 @@ (unlink-blocks return-block (component-tail old-lambda-component)))) (let ((res (find-initial-dfo-aux bind-block component))) (declare (type component res)) - ;; Scavenge call relationships. - (let ((calls (if (eq (lambda-kind clambda) :external) - (append (find-reference-funs clambda) - (lambda-calls clambda)) - (lambda-calls clambda)))) - (dolist (call calls) - (let ((call-home (lambda-home call))) - (setf res (dfo-scavenge-dependency-graph call-home res))))) - ;; Scavenge closure-over relationships: if FUN refers to a - ;; variable whose home lambda is not FUN, then the home lambda - ;; should be in the same component as FUN. (sbcl-0.6.13, and - ;; CMU CL, didn't do this, leading to the occasional failure - ;; when physenv analysis, which is local to each component, - ;; would bogusly conclude that a closed-over variable was - ;; unused and thus delete it. See e.g. cmucl-imp 2001-11-29.) - (dolist (var (lambda-refers-to-vars clambda)) - (unless (null (lambda-var-refs var)) ; i.e. unless deleted - (let ((var-home-home (lambda-home (lambda-var-home var)))) - (unless (eql (lambda-kind var-home-home) :deleted) - (setf res - (dfo-scavenge-dependency-graph var-home-home res)))))) + ;; Scavenge related lambdas. + (flet (;; Scavenge call relationship. + (scavenge-call (call) + (let ((call-home (lambda-home call))) + (setf res (dfo-scavenge-dependency-graph call-home res)))) + ;; Scavenge closure-over relationship: if FUN refers to a + ;; variable whose home lambda is not FUN, then the home lambda + ;; should be in the same component as FUN. (sbcl-0.6.13, and + ;; CMU CL, didn't do this, leading to the occasional failure + ;; when physenv analysis, which is local to each component, + ;; would bogusly conclude that a closed-over variable was + ;; unused and thus delete it. See e.g. cmucl-imp 2001-11-29.) + (scavenge-closure-var (var) + (unless (null (lambda-var-refs var)) ; i.e. unless deleted + (let ((var-home-home (lambda-home (lambda-var-home var)))) + (unless (eql (lambda-kind var-home-home) :deleted) + (setf res + (dfo-scavenge-dependency-graph var-home-home + res))))))) + (dolist (cc (lambda-calls-or-closes clambda)) + (etypecase cc + (clambda (scavenge-call cc)) + (lambda-var (scavenge-closure-var cc)))) + (when (eq (lambda-kind clambda) :external) + (mapc #'scavenge-call (find-reference-funs clambda)))) ;; Voila. res))))) diff --git a/src/compiler/ir1-translators.lisp b/src/compiler/ir1-translators.lisp index 4d71fe52e..8b0f8523e 100644 --- a/src/compiler/ir1-translators.lisp +++ b/src/compiler/ir1-translators.lisp @@ -755,7 +755,7 @@ (when (lambda-var-p leaf) (let ((home-lambda (continuation-home-lambda-or-null start))) (when home-lambda - (pushnew leaf (lambda-refers-to-vars home-lambda)))) + (pushnew leaf (lambda-calls-or-closes 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. diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp index c530557da..950f3c7dd 100644 --- a/src/compiler/ir1tran.lisp +++ b/src/compiler/ir1tran.lisp @@ -526,7 +526,7 @@ (when (lambda-var-p var) (let ((home (continuation-home-lambda-or-null start))) (when home - (pushnew var (lambda-refers-to-vars home)))) + (pushnew var (lambda-calls-or-closes home)))) (when (lambda-var-ignorep var) ;; (ANSI's specification for the IGNORE declaration requires ;; that this be a STYLE-WARNING, not a full WARNING.) diff --git a/src/compiler/locall.lisp b/src/compiler/locall.lisp index d0311610c..0622e7eb9 100644 --- a/src/compiler/locall.lisp +++ b/src/compiler/locall.lisp @@ -91,7 +91,7 @@ (declare (type ref ref) (type combination call) (type clambda fun)) (propagate-to-args call fun) (setf (basic-combination-kind call) :local) - (pushnew fun (lambda-calls (node-home-lambda call))) + (pushnew fun (lambda-calls-or-closes (node-home-lambda call))) (merge-tail-sets call fun) (change-ref-leaf ref fun) (values)) @@ -417,7 +417,7 @@ (= (length (basic-combination-args call)) 1)) (let ((ep (car (last (optional-dispatch-entry-points fun))))) (setf (basic-combination-kind call) :local) - (pushnew ep (lambda-calls (node-home-lambda call))) + (pushnew ep (lambda-calls-or-closes (node-home-lambda call))) (merge-tail-sets call ep) (change-ref-leaf ref ep) @@ -763,33 +763,25 @@ (setf (lambda-home clambda) home) (setf (lambda-physenv clambda) home-env) + ;; All of CLAMBDA's LETs belong to HOME now. (let ((lets (lambda-lets clambda))) - ;; All of CLAMBDA's LETs belong to HOME now. (dolist (let lets) (setf (lambda-home let) home) (setf (lambda-physenv let) home-env)) - (setf (lambda-lets home) (nconc lets (lambda-lets home))) - ;; CLAMBDA no longer has an independent existence as an entity - ;; which has LETs. - (setf (lambda-lets clambda) nil)) + (setf (lambda-lets home) (nconc lets (lambda-lets home)))) + ;; CLAMBDA no longer has an independent existence as an entity + ;; which has LETs. + (setf (lambda-lets clambda) nil) ;; HOME no longer calls CLAMBDA, and owns all of CLAMBDA's old - ;; calls. - (setf (lambda-calls home) + ;; DFO dependencies. + (setf (lambda-calls-or-closes home) (delete clambda - (nunion (lambda-calls clambda) - (lambda-calls home)))) - ;; CLAMBDA no longer has an independent existence as an entity - ;; 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))) + (nunion (lambda-calls-or-closes clambda) + (lambda-calls-or-closes home)))) ;; CLAMBDA no longer has an independent existence as an entity - ;; which refers to things. - (setf (lambda-refers-to-vars clambda) nil) + ;; which calls things or has DFO dependencies. + (setf (lambda-calls-or-closes clambda) nil) ;; All of CLAMBDA's ENTRIES belong to HOME now. (setf (lambda-entries home) @@ -853,30 +845,31 @@ ;;; NEXT-BLOCK (FUN's return point.) We can't do this by DO-USES on ;;; the RETURN-RESULT, because the return might have been deleted (if ;;; all calls were TR.) -;;; -;;; The called function might be an assignment in the case where we -;;; are currently converting that function. In steady-state, -;;; assignments never appear in the lambda-calls. (defun unconvert-tail-calls (fun call next-block) - (dolist (called (lambda-calls fun)) - (dolist (ref (leaf-refs called)) - (let ((this-call (continuation-dest (node-cont ref)))) - (when (and this-call - (node-tail-p this-call) - (eq (node-home-lambda this-call) fun)) - (setf (node-tail-p this-call) nil) - (ecase (functional-kind called) - ((nil :cleanup :optional) - (let ((block (node-block this-call)) - (cont (node-cont call))) - (ensure-block-start cont) - (unlink-blocks block (first (block-succ block))) - (link-blocks block next-block) - (delete-continuation-use this-call) - (add-continuation-use this-call cont))) - (:deleted) - (:assignment - (aver (eq called fun)))))))) + (dolist (called (lambda-calls-or-closes fun)) + (when (lambda-p called) + (dolist (ref (leaf-refs called)) + (let ((this-call (continuation-dest (node-cont ref)))) + (when (and this-call + (node-tail-p this-call) + (eq (node-home-lambda this-call) fun)) + (setf (node-tail-p this-call) nil) + (ecase (functional-kind called) + ((nil :cleanup :optional) + (let ((block (node-block this-call)) + (cont (node-cont call))) + (ensure-block-start cont) + (unlink-blocks block (first (block-succ block))) + (link-blocks block next-block) + (delete-continuation-use this-call) + (add-continuation-use this-call cont))) + (:deleted) + ;; The called function might be an assignment in the + ;; case where we are currently converting that function. + ;; In steady-state, assignments never appear as a called + ;; function. + (:assignment + (aver (eq called fun))))))))) (values)) ;;; Deal with returning from a LET or assignment that we are diff --git a/src/compiler/node.lisp b/src/compiler/node.lisp index dcb0a690d..484ba63d7 100644 --- a/src/compiler/node.lisp +++ b/src/compiler/node.lisp @@ -911,25 +911,16 @@ ;; If this CLAMBDA is a LET, then this slot holds the LAMBDA whose ;; LETS list we are in, otherwise it is a self-pointer. (home nil :type (or clambda null)) - ;; a list of all the all the lambdas that have been LET-substituted - ;; in this lambda. This is only non-null in lambdas that aren't - ;; LETs. - (lets () :type list) - ;; a list of all the ENTRY nodes in this function and its LETs, or - ;; null in a LET - (entries () :type list) - ;; a list of all the functions directly called from this function - ;; (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) + ;; all the lambdas that have been LET-substituted in this lambda. + ;; This is only non-null in lambdas that aren't LETs. + (lets nil :type list) + ;; all the ENTRY nodes in this function and its LETs, or null in a LET + (entries nil :type list) + ;; CLAMBDAs which are locally called by this lambda, and other + ;; objects (closed-over LAMBDA-VARs and XEPs) which this lambda + ;; depends on in such a way that DFO shouldn't put them in separate + ;; components. + (calls-or-closes nil :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 ea6d3366e..c16666906 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.23" +"0.pre7.86.flaky7.24" |