X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fcopyprop.lisp;h=cd5293da3e649c66004246b0678d415235d5e8f5;hb=403bacffd903f8c5787a182f4133cffc69b55dc0;hp=41f886c6911a0ed68e537e4f729f9681cf5d8694;hpb=9f926721993baa5711eaf00d7c314924f269f3d2;p=sbcl.git diff --git a/src/compiler/copyprop.lisp b/src/compiler/copyprop.lisp index 41f886c..cd5293d 100644 --- a/src/compiler/copyprop.lisp +++ b/src/compiler/copyprop.lisp @@ -55,8 +55,8 @@ ;;; The TN must be a :NORMAL TN. Other TNs might have hidden ;;; references or be otherwise bizarre. ;;; -;;; A TN is also inelegible if it has interned name, policy is such -;;; that we would dump it in the debug vars, and speed is not 3. +;;; A TN is also inelegible if we want to preserve it to facilitate +;;; debugging. ;;; ;;; The SCs of the TN's primitive types is a subset of the SCs of the ;;; copied TN. Moves between TNs of different primitive type SCs may @@ -83,15 +83,17 @@ (primitive-type-scs (tn-primitive-type arg-tn))) (let ((leaf (tn-leaf tn))) + ;; Do we not care about preserving this this + ;; TN for debugging? (or (not leaf) - (not (symbol-package (leaf-name leaf))) + (not (symbol-package (leaf-debug-name leaf))) (policy (vop-node vop) (or (= speed 3) (< debug 2))))) arg-tn))))))) -;;; Init the sets in Block for copy propagation. To find Gen, we just +;;; Init the sets in BLOCK for copy propagation. To find GEN, we just ;;; look for MOVE vops, and then see whether the result is a eligible -;;; copy TN. To find Kill, we must look at all VOP results, seeing +;;; copy TN. To find KILL, we must look at all VOP results, seeing ;;; whether any of the reads of the written TN are copies for eligible ;;; TNs. (defun init-copy-sets (block) @@ -122,7 +124,7 @@ (setf (block-gen block) gen)) (values)) -;;; Do the flow analysis step for copy propagation on Block. We rely +;;; Do the flow analysis step for copy propagation on BLOCK. We rely ;;; on OUT being initialized to GEN, and use SSET-UNION-OF-DIFFERENCE ;;; to incrementally build the union in OUT, rather than replacing OUT ;;; each time. @@ -133,7 +135,9 @@ (dolist (pred-block (rest pred)) (sset-intersection in (block-out pred-block))) (setf (block-in block) in) - (sset-union-of-difference (block-out block) in (block-kill block)))) + (sset-union-of-difference (block-out block) + in + (block-kill block)))) (defevent copy-deleted-move "Copy propagation deleted a move.")