Posted to tcl by kbk at Mon Jan 13 20:12:06 GMT 2014view pretty

# revprop --
#	"Reverse copy propagation"
# Parameters:
#	quads - Sequence of quadruples (three-address instructions)
#	vnames - List of variable names in order by variable indices
# Results:
#	Returns the given bytecode sequence, with unneeded code
#	elided.
# This pass functions as a cleanup for sequences that look like:
#	v := ...			A
#	v2 := v				B
#	... code that uses v2 ...
# The conditions for the optimization are:
#	all reachable uses of A: v:=... are copies of the form v2:=v
#	all reachable uses of A: v:=... copy to the same variable v2
#	no reachable use of A: v:=... has a reaching definition of v other than
#	A.
# In this case, the operation at A can be replaced with v2 :- ...,
# and all the copies B can be elided

proc revprop {quads vnames} [bdd::datalog::compileProgram db {
    set dead {}
} {

    % An assignment of variable v at statement st can be replaced with
    % variable v2 to eliminate a copy of v to v2 at statement st2 if
    % there's no reason not to do so.

    revprop(v, v2, st, st2) :- reaches(v, st, st2),
                               writes0(st2, v2),
                               !cantRevprop(v, v2, st).

    % We cannot replace v with v2 in st if that would spoil any reachable
    % use of v or v2 from st.

    cantRevprop(v, v2, st) :- reaches(v, st, st2), cantRevprop2(v, v2, st ,st2).
    cantRevprop(_, v2, st) :- flowsPast(v2, st, st2), reads0(st2, v2).

    % A use of v in st2 is spoilt by this optimization if:
    %   st2 isn't a copy,
    %   st2 doesn't copy v to v2
    %   st2 has a reaching definition of v that isn't st.

    cantRevprop2(_, _, _, st2) :- !isCopy(st2).
    cantRevprop2(_, v2, _, st2) :- !writes0(st2, v2).
    cantRevprop2(v, _, st, st2) :- reaches(v, st3, st2), st3 != st.

    revprop(v, v2, st, st2)?

} d {
    set v [lindex $vnames [dict get $d v]]
    set v2 [lindex $vnames [dict get $d v2]]
    set st [dict get $d st]
    set st2 [dict get $d st2]
    set q [lindex $quads $st]
    lset quads $st 1 $v2
    dict set dead $st2 {}
} {
    # Remove the instructions that this optimization has killed
    tailcall quads-remove-dead $quads $dead