;;; 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
(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)
(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.
(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.")