X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fdfo.lisp;h=cb0960f664ae307989e05a60c654214af3629dd7;hb=012fbee7176df4472ef4add1a7df558d762bc4f6;hp=dd304c7e753fa18c9afcb403b1e469245677b760;hpb=d147d512602d761a2dcdfded506dd1a8f9a140dc;p=sbcl.git diff --git a/src/compiler/dfo.lisp b/src/compiler/dfo.lisp index dd304c7..cb0960f 100644 --- a/src/compiler/dfo.lisp +++ b/src/compiler/dfo.lisp @@ -37,9 +37,9 @@ (delete-block block)))) (values)) -;;; Move all the code and entry points from Old to New. The code in -;;; Old is inserted at the head of New. This is also called during let -;;; conversion when we are about in insert the body of a let in a +;;; Move all the code and entry points from OLD to NEW. The code in +;;; OLD is inserted at the head of NEW. This is also called during LET +;;; conversion when we are about in insert the body of a LET in a ;;; different component. [A local call can be to a different component ;;; before FIND-INITIAL-DFO runs.] (declaim (ftype (function (component component) (values)) join-components)) @@ -82,8 +82,8 @@ (link-blocks head ep))) (values)) -;;; Do a depth-first walk from Block, inserting ourself in the DFO -;;; after Head. If we somehow find ourselves in another component, +;;; Do a depth-first walk from BLOCK, inserting ourself in the DFO +;;; after HEAD. If we somehow find ourselves in another component, ;;; then we join that component to our component. (declaim (ftype (function (cblock cblock component) (values)) find-dfo-aux)) (defun find-dfo-aux (block head component) @@ -99,22 +99,24 @@ (add-to-dfo block head)) (values)) -;;; This function is called on each block by Find-Initial-DFO-Aux before it -;;; walks the successors. It looks at the home lambda's bind block to see -;;; whether that block is in some other component: -;;; -- If the block is in the initial component, then do DFO-Walk-Call-Graph on -;;; the home function to move it into component. -;;; -- If the block is in some other component, join Component into it and -;;; return that component. -;;; -- If the home function is deleted, do nothing. Block must eventually be -;;; discovered to be unreachable as well. This can happen when we have a -;;; NLX into a function with no references. The escape function still has -;;; refs (in the deleted function). +;;; This function is called on each block by FIND-INITIAL-DFO-AUX +;;; before it walks the successors. It looks at the home lambda's bind +;;; block to see whether that block is in some other component: + +;;; -- If the block is in the initial component, then do +;;; DFO-WALK-CALL-GRAPH on the home function to move it +;;; into COMPONENT. +;;; -- If the block is in some other component, join COMPONENT into +;;; it and return that component. +;;; -- If the home function is deleted, do nothing. BLOCK must +;;; eventually be discovered to be unreachable as well. This can +;;; happen when we have a NLX into a function with no references. +;;; The escape function still has refs (in the deleted function). ;;; -;;; This ensures that all the blocks in a given environment will be in the same -;;; component, even when they might not seem reachable from the environment -;;; entry. Consider the case of code that is only reachable from a non-local -;;; exit. +;;; This ensures that all the blocks in a given environment will be in +;;; the same component, even when they might not seem reachable from +;;; the environment entry. Consider the case of code that is only +;;; reachable from a non-local exit. (defun walk-home-call-graph (block component) (declare (type cblock block) (type component component)) (let ((home (block-home-lambda block))) @@ -130,17 +132,19 @@ (join-components home-component component) home-component)))))) -;;; Somewhat similar to Find-DFO-Aux, except that it merges the current -;;; component with any strange component, rather than the other way around. -;;; This is more efficient in the common case where the current component -;;; doesn't have much stuff in it. +;;; This is somewhat similar to FIND-DFO-AUX, except that it merges +;;; the current component with any strange component, rather than the +;;; other way around. This is more efficient in the common case where +;;; the current component doesn't have much stuff in it. ;;; -;;; We return the current component as a result, allowing the caller to -;;; detect when the old current component has been merged with another. +;;; We return the current component as a result, allowing the caller +;;; to detect when the old current component has been merged with +;;; another. ;;; -;;; We walk blocks in initial components as though they were already in the -;;; current component, moving them to the current component in the process. -;;; The blocks are inserted at the head of the current component. +;;; We walk blocks in initial components as though they were already +;;; in the current component, moving them to the current component in +;;; the process. The blocks are inserted at the head of the current +;;; component. (defun find-initial-dfo-aux (block component) (declare (type cblock block) (type component component)) (let ((this (block-component block))) @@ -160,54 +164,62 @@ (add-to-dfo block (component-head current)) current))))) -;;; Return a list of all the home lambdas that reference Fun (may contain -;;; duplications). +;;; Return a list of all the home lambdas that reference FUN (may +;;; contain duplications). ;;; -;;; References to functions which local call analysis could not (or were -;;; chosen not) to local call convert will appear as references to XEP lambdas. -;;; We can ignore references to XEPs that appear in :TOP-LEVEL components, -;;; since environment analysis goes to special effort to allow closing over of -;;; values from a separate top-level component. All other references must -;;; cause components to be joined. +;;; References to functions which local call analysis could not (or +;;; were chosen not) to local call convert will appear as references +;;; to XEP lambdas. We can ignore references to XEPs that appear in +;;; :TOP-LEVEL components, since environment analysis goes to special +;;; effort to allow closing over of values from a separate top-level +;;; component. (And now that HAS-EXTERNAL-REFERENCES-P-ness +;;; generalizes :TOP-LEVEL-ness, we ignore those too.) All other +;;; references must cause components to be joined. ;;; -;;; References in deleted functions are also ignored, since this code will be -;;; deleted eventually. +;;; References in deleted functions are also ignored, since this code +;;; will be deleted eventually. (defun find-reference-functions (fun) (collect ((res)) (dolist (ref (leaf-refs fun)) (let* ((home (node-home-lambda ref)) - (home-kind (functional-kind home))) - (unless (or (and (eq home-kind :top-level) + (home-kind (functional-kind home)) + (home-externally-visible-p + (or (eq home-kind :top-level) + (functional-has-external-references-p home)))) + (unless (or (and home-externally-visible-p (eq (functional-kind fun) :external)) (eq home-kind :deleted)) (res home)))) (res))) -;;; Move the code for Fun and all functions called by it into Component. If -;;; Fun is already in Component, then we just return that component. +;;; Move the code for FUN and all functions called by it into +;;; COMPONENT. If FUN is already in COMPONENT, then we just return +;;; that component. ;;; -;;; If the function is in an initial component, then we move its head and -;;; tail to Component and add it to Component's lambdas. It is harmless to -;;; move the tail (even though the return might be unreachable) because if the -;;; return is unreachable it (and its successor link) will be deleted in the -;;; post-deletion pass. +;;; If the function is in an initial component, then we move its head +;;; and tail to COMPONENT and add it to COMPONENT's lambdas. It is +;;; harmless to move the tail (even though the return might be +;;; unreachable) because if the return is unreachable it (and its +;;; successor link) will be deleted in the post-deletion pass. ;;; -;;; We then do a Find-DFO-Aux starting at the head of Fun. If this -;;; flow-graph walk encounters another component (which can only happen due to -;;; a non-local exit), then we move code into that component instead. We then -;;; recurse on all functions called from Fun, moving code into whichever -;;; component the preceding call returned. +;;; We then do a FIND-DFO-AUX starting at the head of FUN. If this +;;; flow-graph walk encounters another component (which can only +;;; happen due to a non-local exit), then we move code into that +;;; component instead. We then recurse on all functions called from +;;; FUN, moving code into whichever component the preceding call +;;; returned. ;;; -;;; If Fun is in the initial component, but the Block-Flag is set in the -;;; bind block, then we just return Component, since we must have already -;;; reached this function in the current walk (or the component would have been -;;; changed). +;;; If FUN is in the initial component, but the BLOCK-FLAG is set in +;;; the bind block, then we just return COMPONENT, since we must have +;;; already reached this function in the current walk (or the +;;; component would have been changed). ;;; -;;; if the function is an XEP, then we also walk all functions that contain -;;; references to the XEP. This is done so that environment analysis doesn't -;;; need to cross component boundaries. This also ensures that conversion of a -;;; full call to a local call won't result in a need to join components, since -;;; the components will already be one. +;;; If the function is an XEP, then we also walk all functions that +;;; contain references to the XEP. This is done so that environment +;;; analysis doesn't need to cross component boundaries. This also +;;; ensures that conversion of a full call to a local call won't +;;; result in a need to join components, since the components will +;;; already be one. (defun dfo-walk-call-graph (fun component) (declare (type clambda fun) (type component component)) (let* ((bind-block (node-block (lambda-bind fun))) @@ -240,7 +252,8 @@ ((null funs) res) (declare (type component res)))))))) -;;; Return true if Fun is either an XEP or has EXITS to some of its ENTRIES. +;;; Return true if FUN is either an XEP or has EXITS to some of its +;;; ENTRIES. (defun has-xep-or-nlx (fun) (declare (type clambda fun)) (or (eq (functional-kind fun) :external) @@ -248,12 +261,13 @@ (and entries (find-if #'entry-exits entries))))) -;;; Compute the result of FIND-INITIAL-DFO given the list of all resulting -;;; components. Components with a :TOP-LEVEL lambda, but no normal XEPs or -;;; potential non-local exits are marked as :TOP-LEVEL. If there is a -;;; :TOP-LEVEL lambda, and also a normal XEP, then we treat the component as -;;; normal, but also return such components in a list as the third value. -;;; Components with no entry of any sort are deleted. +;;; Compute the result of FIND-INITIAL-DFO given the list of all +;;; resulting components. Components with a :TOP-LEVEL lambda, but no +;;; normal XEPs or potential non-local exits are marked as :TOP-LEVEL. +;;; If there is a :TOP-LEVEL lambda, and also a normal XEP, then we +;;; treat the component as normal, but also return such components in +;;; a list as the third value. Components with no entry of any sort +;;; are deleted. (defun find-top-level-components (components) (declare (list components)) (collect ((real) @@ -262,8 +276,22 @@ (dolist (com components) (unless (eq (block-next (component-head com)) (component-tail com)) (let* ((funs (component-lambdas com)) - (has-top (find :top-level funs :key #'functional-kind))) - (cond ((or (find-if #'has-xep-or-nlx funs) + (has-top (find :top-level funs :key #'functional-kind)) + (has-external-references + (some #'functional-has-external-references-p funs))) + (cond (;; The FUNCTIONAL-HAS-EXTERNAL-REFERENCES-P concept + ;; is newer than the rest of this function, and + ;; doesn't really seem to fit into its mindset. Here + ;; we mark components which contain such FUNCTIONs + ;; them as :COMPLEX-TOP-LEVEL, since they do get + ;; executed at run time, and since it's not valid to + ;; delete them just because they don't have any + ;; references from pure :TOP-LEVEL components. -- WHN + has-external-references + (setf (component-kind com) :complex-top-level) + (real com) + (real-top com)) + ((or (some #'has-xep-or-nlx funs) (and has-top (rest funs))) (setf (component-name com) (find-component-name com)) (real com) @@ -279,24 +307,25 @@ (values (real) (top) (real-top)))) -;;; Given a list of top-level lambdas, return three lists of components -;;; representing the actual component division: +;;; Given a list of top-level lambdas, return three lists of +;;; components representing the actual component division: ;;; 1. the non-top-level components, ;;; 2. and the second is the top-level components, and ;;; 3. Components in [1] that also have a top-level lambda. ;;; -;;; We assign the DFO for each component, and delete any unreachable blocks. -;;; We assume that the Flags have already been cleared. +;;; We assign the DFO for each component, and delete any unreachable +;;; blocks. We assume that the Flags have already been cleared. ;;; -;;; We iterate over the lambdas in each initial component, trying to put -;;; each function in its own component, but joining it to an existing component -;;; if we find that there are references between them. Any code that is left -;;; in an initial component must be unreachable, so we can delete it. Stray -;;; links to the initial component tail (due NIL function terminated blocks) -;;; are moved to the appropriate newc component tail. +;;; We iterate over the lambdas in each initial component, trying to +;;; put each function in its own component, but joining it to an +;;; existing component if we find that there are references between +;;; them. Any code that is left in an initial component must be +;;; unreachable, so we can delete it. Stray links to the initial +;;; component tail (due NIL function terminated blocks) are moved to +;;; the appropriate newc component tail. ;;; -;;; When we are done, we assign DFNs and call FIND-TOP-LEVEL-COMPONENTS to -;;; pull out top-level code. +;;; When we are done, we assign DFNs and call +;;; FIND-TOP-LEVEL-COMPONENTS to pull out top-level code. (defun find-initial-dfo (lambdas) (declare (list lambdas)) (collect ((components)) @@ -333,11 +362,11 @@ (defun merge-1-tl-lambda (result-lambda lambda) (declare (type clambda result-lambda lambda)) - ;; Delete the lambda, and combine the lets and entries. + ;; Delete the lambda, and combine the LETs and entries. (setf (functional-kind lambda) :deleted) (dolist (let (lambda-lets lambda)) (setf (lambda-home let) result-lambda) - (setf (lambda-environment let) (lambda-environment result-lambda)) + (setf (lambda-physenv let) (lambda-physenv result-lambda)) (push let (lambda-lets result-lambda))) (setf (lambda-entries result-lambda) (nconc (lambda-entries result-lambda) @@ -350,9 +379,9 @@ (block-component (node-block (lambda-bind result-lambda)))) (result-return-block (node-block (lambda-return result-lambda)))) - ;; Move blocks into the new component, and move any nodes directly in - ;; the old lambda into the new one (lets implicitly moved by changing - ;; their home.) + ;; Move blocks into the new COMPONENT, and move any nodes directly + ;; in the old LAMBDA into the new one (with LETs implicitly moved + ;; by changing their home.) (do-blocks (block component) (do-nodes (node cont block) (let ((lexenv (node-lexenv node))) @@ -360,9 +389,9 @@ (setf (lexenv-lambda lexenv) result-lambda)))) (setf (block-component block) result-component)) - ;; Splice the blocks into the new DFO, and unlink them from the old - ;; component head and tail. Non-return blocks that jump to the tail - ;; (NIL returning calls) are switched to go to the new tail. + ;; Splice the blocks into the new DFO, and unlink them from the + ;; old component head and tail. Non-return blocks that jump to the + ;; tail (NIL-returning calls) are switched to go to the new tail. (let* ((head (component-head component)) (first (block-next head)) (tail (component-tail component)) @@ -392,9 +421,9 @@ (link-blocks pred bind-block)) (unlink-node bind) - ;; If there is a return, then delete it (making the preceding node the - ;; last node) and link the block to the result return. There is always a - ;; preceding REF NIL node in top-level lambdas. + ;; If there is a return, then delete it (making the preceding node + ;; the last node) and link the block to the result return. There + ;; is always a preceding REF NIL node in top-level lambdas. (let ((return (lambda-return lambda))) (when return (let ((return-block (node-block return)) @@ -404,10 +433,10 @@ (delete-continuation result) (link-blocks return-block result-return-block)))))) -;;; Given a non-empty list of top-level lambdas, smash them into a top-level -;;; lambda and component, returning these as values. We use the first lambda -;;; and its component, putting the other code in that component and deleting -;;; the other lambdas. +;;; Given a non-empty list of top-level LAMBDAs, smash them into a +;;; top-level lambda and component, returning these as values. We use +;;; the first lambda and its component, putting the other code in that +;;; component and deleting the other lambdas. (defun merge-top-level-lambdas (lambdas) (declare (cons lambdas)) (let* ((result-lambda (first lambdas)) @@ -415,8 +444,8 @@ (cond (result-return - ;; Make sure the result's return node starts a block so that we can - ;; splice code in before it. + ;; Make sure the result's return node starts a block so that we + ;; can splice code in before it. (let ((prev (node-prev (continuation-use (return-result result-return)))))