projects
/
sbcl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
0.8.0.78.vector-nil-string.3:
[sbcl.git]
/
src
/
compiler
/
copyprop.lisp
diff --git
a/src/compiler/copyprop.lisp
b/src/compiler/copyprop.lisp
index
f7062ca
..
cd5293d
100644
(file)
--- 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.
;;;
;;; 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
;;;
;;; 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,8
+83,10
@@
(primitive-type-scs
(tn-primitive-type arg-tn)))
(let ((leaf (tn-leaf tn)))
(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)
(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)))))))
(policy (vop-node vop)
(or (= speed 3) (< debug 2)))))
arg-tn)))))))
@@
-118,7
+120,7
@@
(sset-adjoin y kill))))))))))
(setf (block-out block) (copy-sset gen))
(sset-adjoin y kill))))))))))
(setf (block-out block) (copy-sset gen))
- (setf (block-kill-sset block) kill)
+ (setf (block-kill block) kill)
(setf (block-gen block) gen))
(values))
(setf (block-gen block) gen))
(values))
@@
-135,7
+137,7
@@
(setf (block-in block) in)
(sset-union-of-difference (block-out block)
in
(setf (block-in block) in)
(sset-union-of-difference (block-out block)
in
- (block-kill-sset block))))
+ (block-kill block))))
(defevent copy-deleted-move "Copy propagation deleted a move.")
(defevent copy-deleted-move "Copy propagation deleted a move.")