X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fdfo.lisp;h=6d5d6a7c733b38b7e10f9c70352c2e774d4a23fe;hb=d131dfb49a3e6522d2358d14252f3f52cfcd202a;hp=a22339d662d44c5cfc2a8cdbdc006c7f62dd2c69;hpb=34dd23563d2f5cf05c72b971da0d0b065a09bf2a;p=sbcl.git diff --git a/src/compiler/dfo.lisp b/src/compiler/dfo.lisp index a22339d..6d5d6a7 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)) @@ -187,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 @@ -347,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))) @@ -375,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)) @@ -445,7 +445,7 @@ ;; 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) + (do-nodes (node nil block) (let ((lexenv (node-lexenv node))) (when (eq (lexenv-lambda lexenv) lambda) (setf (lexenv-lambda lexenv) result-lambda)))) @@ -488,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 @@ -509,14 +506,9 @@ ;; 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))))) - (when (continuation-use prev) - (node-ends-block (continuation-use prev))) - (do-uses (use prev) - (let ((new (make-continuation))) - (delete-continuation-use use) - (add-continuation-use use new)))) + (lvar-uses (return-result result-return))))) + (when (ctran-use prev) + (node-ends-block (ctran-use prev)))) (dolist (lambda (rest lambdas)) (merge-1-toplevel-lambda result-lambda lambda)))