-
#!/bin/sh
# "When we build software, it's a good idea to have a reliable method
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.
(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)))))
(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.
(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.)
(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))
(= (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)
(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)
;;; 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
;; 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
;;; 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"
projects / sbcl.git / commitdiff