X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fdfo.lisp;h=7739e602151a5c76aaf73caf12e08868b3a4312b;hb=784b195743728436795b90f95273c3535ebee9a5;hp=d1280117fdf8db26ce113886c749a1c14ff4b37a;hpb=47bcbbb709e9e35e38e34ef2ea658f5a8eb0804d;p=sbcl.git diff --git a/src/compiler/dfo.lisp b/src/compiler/dfo.lisp index d128011..7739e60 100644 --- a/src/compiler/dfo.lisp +++ b/src/compiler/dfo.lisp @@ -32,7 +32,7 @@ (setf (block-number block) (incf num)) (setf (block-delete-p block) t))) (do-blocks (block component) - (unless (block-flag block) + (when (block-delete-p block) (delete-block block)))) (values)) @@ -59,7 +59,7 @@ (unless (eq old-next old-tail) (setf (block-next head) old-next) (setf (block-prev old-next) head) - + (setf (block-prev next) old-last) (setf (block-next old-last) next)) @@ -69,9 +69,10 @@ (setf (component-lambdas new) (nconc (component-lambdas old) (component-lambdas new))) (setf (component-lambdas old) nil) - (setf (component-new-funs new) (nconc (component-new-funs old) - (component-new-funs new)) - (component-new-funs old) nil) + (setf (component-new-functionals new) + (nconc (component-new-functionals old) + (component-new-functionals new))) + (setf (component-new-functionals old) nil) (dolist (xp (block-pred old-tail)) (unlink-blocks xp old-tail) @@ -100,7 +101,7 @@ ;;; before it walks the successors. It looks at the home CLAMBDA'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-DEPENDENCY-GRAPH on the home function to move it +;;; DFO-SCAVENGE-DEPENDENCY-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. @@ -186,7 +187,7 @@ (res home)))) (res))) -;;; If CLAMBDA is not already in COMPONENT, just return that +;;; If CLAMBDA is already in COMPONENT, just return that ;;; component. Otherwise, move the code for CLAMBDA and all lambdas it ;;; physically depends on (either because of calls or because of ;;; closure relationships) into COMPONENT, or possibly into another @@ -198,13 +199,6 @@ ;;; oversight, not by design, as per the bug reported by WHN on ;;; cmucl-imp ca. 2001-11-29 and explained by DTC shortly after.) ;;; -;;; FIXME: Very likely we should be scavenging NLX-based dependencies -;;; here too. OTOH, there's a lot of global weirdness in NLX handling, -;;; so it might be taken care of some other way that I haven't figured -;;; out yet. Perhaps the best way to address this would be to try to -;;; construct a NLX-based test case which fails in the same way as the -;;; closure-based test case on cmucl-imp 2001-11-29.) -;;; ;;; 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 @@ -353,8 +347,8 @@ (values (real) (top) (real-top)))) -;; COMPONENTs want strings for names, LEAF-DEBUG-NAMEs mightn't be -;; strings.. +;;; COMPONENTs want strings for names, LEAF-DEBUG-NAMEs mightn't be +;;; strings... (defun component-name-from-functional-debug-name (functional) (declare (type functional functional)) (let ((leaf-debug-name (leaf-debug-name functional))) @@ -381,7 +375,7 @@ ;; 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) + ;; initial component tail (due to NIL function terminated blocks) ;; are moved to the appropriate new component tail. (dolist (toplevel-lambda toplevel-lambdas) (let* ((old-component (lambda-component toplevel-lambda)) @@ -494,12 +488,9 @@ ;; is always a preceding REF NIL node in top level lambdas. (let ((return (lambda-return lambda))) (when return - (let ((return-block (node-block return)) - (result (return-result return))) - (setf (block-last return-block) (continuation-use result)) - (flush-dest result) - (delete-continuation result) - (link-blocks return-block result-return-block)))))) + (link-blocks (node-block return) result-return-block) + (flush-dest (return-result return)) + (unlink-node return))))) ;;; Given a non-empty list of top level LAMBDAs, smash them into a ;;; top level lambda and component, returning these as values. We use