# Copyright (c) 2014-2017 by Kevin B. Kenny
# Copyright (c) 2014-2017 by Donal K. Fellows
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
#------------------------------------------------------------------------------



 
#############################################################################
#
# Test code definitions. These are all procedures; that's all we can currently
# compile.

proc cos {x {n 16}} {
................................................................................
proc impure {a b c} {
    set x 0
    for {set i $a} {$i < $b} {incr i $c} {
	set x [expr {$x + $i}]
    }
    return $x
}





proc impure-typecheck-int {a b c} {
    if {[string is int -strict $a]
	&& [string is int -strict $b]
	&& [string is int -strict $c]} {
	set x 0
	for {set i $a} {$i < $b} {incr i $c} {
................................................................................
    for {set i 0} {$i < 100} {incr i} {
	incr x $adder
	incr y $adder
	incr y $adder
    }
    list $x $y
}

















namespace eval ::regexptest {

    proc matchvar-1 {needle haystack} {
	regexp -indices -- $needle $haystack where
	return $where
    }
................................................................................
	    lappend results "n= $n\tCollisions= $col \t\t\tCurrent n_min= $n_min_col\tCurrent min_col=$min_col"
	}
	return [llength $results]
    }

}

proc wideimpure {x} {


























































    expr {wide($x)}
}






























































































































 
# A simple helper that is not compiled, but rather just shortens code below

proc cleanopt {script} {
    variable cleanopt
    set code [uplevel 1 [list catch $script cleanopt(msg) cleanopt(opt)]]
    set msg $cleanopt(msg)
................................................................................
    upvartest0::check2
    upvartest1::check1
    upvartest1::check2
    upvartest2::test1
    upvartest2::test2
    upvartest2::test3
    upvartest2::test4



    {hash::H9fast ultraantidisestablishmentarianistically}
    {hash::H9mid ultraantidisestablishmentarianistically}
    {hash::H9slow ultraantidisestablishmentarianistically}






    {cse-caller}
    {licm1 100}
    {licm2 100}
    {redundant-purify 2}
    {wideimpure 3.0}







}

set demos'slow' {
    {flightawarebench::test 5 5 2}
    {llength [hash::main]}
}
 
................................................................................
    upvar0a
    upvartest0::*
    upvartest1::*
    upvartest2::*
    flightawarebench::*
    hash::*
    redundant-purify

    licm1 licm2
    cse cse-caller
    wideimpure


}
set toCompile'slow' {
    parseBuiltinsTxt::main
}
 
#############################################################################
#

# Copyright (c) 2014-2017 by Kevin B. Kenny
# Copyright (c) 2014-2017 by Donal K. Fellows
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
#------------------------------------------------------------------------------

interp recursionlimit {} 4000

 
#############################################################################
#
# Test code definitions. These are all procedures; that's all we can currently
# compile.

proc cos {x {n 16}} {
................................................................................
proc impure {a b c} {
    set x 0
    for {set i $a} {$i < $b} {incr i $c} {
	set x [expr {$x + $i}]
    }
    return $x
}

proc wideimpure {x} {
    expr {wide($x)}
}

proc impure-typecheck-int {a b c} {
    if {[string is int -strict $a]
	&& [string is int -strict $b]
	&& [string is int -strict $c]} {
	set x 0
	for {set i $a} {$i < $b} {incr i $c} {
................................................................................
    for {set i 0} {$i < 100} {incr i} {
	incr x $adder
	incr y $adder
	incr y $adder
    }
    list $x $y
}

namespace eval ::inlinetwice {

    proc carry limb { 
        list [expr {$limb & 0x0FFFFFFF}] [expr {$limb >> 28}] 
    }

    proc test {a b} {
	set a [expr {int($a)}]
	set b [expr {int($b)}]
	lassign [carry $a] a0 a1
	lassign [carry $b] b0 b1
	list $a1 [expr {$a0 + $b1}] $b0

    }
}

namespace eval ::regexptest {

    proc matchvar-1 {needle haystack} {
	regexp -indices -- $needle $haystack where
	return $where
    }
................................................................................
	    lappend results "n= $n\tCollisions= $col \t\t\tCurrent n_min= $n_min_col\tCurrent min_col=$min_col"
	}
	return [llength $results]
    }

}

# Test case from Neil Madden
namespace eval ::poly1305 {
    namespace export compute verify
    namespace ensemble create

    #proc debug {msg args} { puts [format $msg {*}$args] }
    proc debug args {}
    
    proc clamp r {
        list [expr {[lindex $r 0] & 0x3ffffff}] \
             [expr {[lindex $r 1] & 0x3ffff03}] \
             [expr {[lindex $r 2] & 0x3ffc0ff}] \
             [expr {[lindex $r 3] & 0x3f03fff}] \
             [expr {[lindex $r 4] & 0x00fffff}]
    }
    
    proc verify {key data tag} {
        set expected [compute $key $data]
        equals $expected $tag
    }
    
    # constant time equality check
    proc equals {a b} {
        if {[string length $a] != [string length $b]} {
            return 0
        }
        set ret 0
        binary scan $a c* as
        binary scan $b c* bs
        foreach x $as y $bs {
            set ret [expr {$ret | ($x ^ $y)}]
        }
        expr {$ret == 0}
    }

    # Loads a 130-bit little-endian number and represents it as 5 26-bit limbs.
    # This internal format allows to delay carry propagation, resulting in a fast
    # and constant-time representation.
    proc load_130_le_26 bin {
        # Scan as 5 32-bit little-endian integers, rewinding (X) by one byte between each.
        # We then mask each down to a 26-bit integer.
        if {[binary scan $bin iuXiuXiuXiuXiu x0 x1 x2 x3 x4] != 5} {
            error "unable to parse data: [binary encode hex $bin]"
        }
        set x0 [expr {$x0           & 0x03ffffff}]
        set x1 [expr {($x1 >> 2)    & 0x03ffffff}]
        set x2 [expr {($x2 >> 4)    & 0x03ffffff}]
        set x3 [expr {($x3 >> 6)    & 0x03ffffff}]
        set x4 [expr {($x4 >> 8)    & 0x03ffffff}]

        list $x0 $x1 $x2 $x3 $x4
    }

    proc carry limb { 
        list [expr {$limb & 0x03FFFFFF}] [expr {$limb >> 26}] 
    }

    namespace eval tcl { namespace eval mathfunc {} }
    proc tcl::mathfunc::mul64 {x y} {
        expr {wide(wide($x) * wide($y))}
    }

    proc compute {key data} {
        variable INT32
        if {[string length $key] != 32} {
            error "key must be exactly 32 bytes"
        }
        set r [clamp [load_130_le_26 $key]]
        lassign $r r0 r1 r2 r3 r4

        binary scan $key iu4iu4 -> s

        set s1 [expr {$r1 * 5}]
        set s2 [expr {$r2 * 5}]
        set s3 [expr {$r3 * 5}]
        set s4 [expr {$r4 * 5}]

        lassign {0 0 0 0 0} a0 a1 a2 a3 a4

        set len [string length $data]
        for {set i 0} {$i < $len} {incr i 16} {
            set end [expr {min($i + 15, $len-1)}]

            set bytes [string range $data $i $end]\x01[string repeat \x00 [expr {15 - ($end - $i)}]]

            debug "block = %s" [binary encode hex [string reverse $bytes]]

            binary scan [string index $bytes 16] c c
            lassign [load_130_le_26 $bytes] n0 n1 n2 n3 n4

            incr a0 $n0
            incr a1 $n1
            incr a2 $n2
            incr a3 $n3
            incr a4 [expr {$n4 | ($c << 24)}]

            debug "a = %08x %08x %08x %08x %08x" $a0 $a1 $a2 $a3 $a4

            set d0 [expr {mul64($a0,$r0) + mul64($a1,$s4) + mul64($a2,$s3) + mul64($a3,$s2) + mul64($a4,$s1)}]
            set d1 [expr {mul64($a0,$r1) + mul64($a1,$r0) + mul64($a2,$s4) + mul64($a3,$s3) + mul64($a4,$s2)}]
            set d2 [expr {mul64($a0,$r2) + mul64($a1,$r1) + mul64($a2,$r0) + mul64($a3,$s4) + mul64($a4,$s3)}]
            set d3 [expr {mul64($a0,$r3) + mul64($a1,$r2) + mul64($a2,$r1) + mul64($a3,$r0) + mul64($a4,$s4)}]
            set d4 [expr {mul64($a0,$r4) + mul64($a1,$r3) + mul64($a2,$r2) + mul64($a3,$r1) + mul64($a4,$r0)}]

            debug "d = %08x %08x %08x %08x %08x" $d0 $d1 $d2 $d3 $d4

            # Reduce mod 2^130-5 (partially)
            lassign [carry $d0] a0 c
            incr d1 $c
            lassign [carry $d1] a1 c
            incr d2 $c
            lassign [carry $d2] a2 c
            incr d3 $c
            lassign [carry $d3] a3 c
            incr d4 $c
            lassign [carry $d4] a4 c
            incr a0 [expr {$c * 5}]
            lassign [carry $a0] a0 c
            incr a1 $c

            debug "a = %08x %08x %08x %08x %08x" $a0 $a1 $a2 $a3 $a4
        }

        # Final reduction mod 2^130-5
        lassign [carry $a1] a1 c
        incr a2 $c
        lassign [carry $a2] a2 c
        incr a3 $c
        lassign [carry $a3] a3 c
        incr a4 $c
        lassign [carry $a4] a4 c
        incr a0 [expr {$c * 5}]
        lassign [carry $a0] a0 c
        incr a1 $c

        debug "a = %08x %08x %08x %08x %08x" $a0 $a1 $a2 $a3 $a4

        # a-p
        set g0 [expr {$a0 + 5}]
        lassign [carry $g0] g0 c
        set g1 [expr {$a1 + $c}]
        lassign [carry $g1] g1 c
        set g2 [expr {$a2 + $c}]
        lassign [carry $g2] g2 c
        set g3 [expr {$a3 + $c}]
        lassign [carry $g3] g3 c
        set g4 [expr {$a4 + $c - (1 << 26)}]

        debug "g = %08x %08x %08x %08x %08x" $g0 $g1 $g2 $g3 $g4

        # Use bit-slicing to select a if a < p or a - p if a >= p
        set mask [expr {$g4 >> 63}]
        set a0 [expr {$a0 & $mask}]
        set a1 [expr {$a1 & $mask}]
        set a2 [expr {$a2 & $mask}]
        set a3 [expr {$a3 & $mask}]
        set a4 [expr {$a4 & $mask}]

        # a = a mod 2^128
        set a0 [expr {($a0         | ($a1 << 26)) & 0xFFFFFFFF}]
        set a1 [expr {(($a1 >> 6)  | ($a2 << 20)) & 0xFFFFFFFF}]
        set a2 [expr {(($a2 >> 12) | ($a3 << 14)) & 0xFFFFFFFF}]
        set a3 [expr {(($a3 >> 18) | ($a4 << 8 )) & 0xFFFFFFFF}]

        # mac = (a + s) mod 2^128
        set c [expr {$a0 + [lindex $s 0]}]
        set a0 [expr {$c & 0xFFFFFFFF}]
        set c [expr {$a1 + [lindex $s 1] + ($c >> 32)}]
        set a1 [expr {$c & 0xFFFFFFFF}]
        set c [expr {$a2 + [lindex $s 2] + ($c >> 32)}]
        set a2 [expr {$c & 0xFFFFFFFF}]
        set c [expr {$a3 + [lindex $s 3] + ($c >> 32)}]
        set a3 [expr {$c & 0xFFFFFFFF}]

        binary format iiii $a0 $a1 $a2 $a3
    }
}
proc fromHex hex {
    binary decode hex [regsub -all -nocase {[^a-f0-9]} $hex {}]
}
proc toHex bin {
    regsub -all {..(?=.)} [binary encode hex $bin] {&:}
}
set key [fromHex {85:d6:be:78:57:55:6d:33:7f:44:52:fe:42:d5:06:a8:01:0
      3:80:8a:fb:0d:b2:fd:4a:bf:f6:af:41:49:f5:1b}]
set msg "Cryptographic Forum Research Group"
set tag [fromHex {a8:06:1d:c1:30:51:36:c6:c2:2b:8b:af:0c:01:27:a9}]
 
# A simple helper that is not compiled, but rather just shortens code below

proc cleanopt {script} {
    variable cleanopt
    set code [uplevel 1 [list catch $script cleanopt(msg) cleanopt(opt)]]
    set msg $cleanopt(msg)
................................................................................
    upvartest0::check2
    upvartest1::check1
    upvartest1::check2
    upvartest2::test1
    upvartest2::test2
    upvartest2::test3
    upvartest2::test4

    {wideimpure 3.0}

    {hash::H9fast ultraantidisestablishmentarianistically}
    {hash::H9mid ultraantidisestablishmentarianistically}
    {hash::H9slow ultraantidisestablishmentarianistically}

    {toHex [poly1305 compute $key $msg]}
    {poly1305 verify $key $msg $tag}

    {wideimpure 3.0}

    {cse-caller}
    {licm1 100}
    {licm2 100}
    {redundant-purify 2}
    {inlinetwice::test 0x10000003 0x50000007}

    {hash::H9fast ultraantidisestablishmentarianistically}
    {hash::H9mid ultraantidisestablishmentarianistically}
    {hash::H9slow ultraantidisestablishmentarianistically}

    {toHex [poly1305 compute $key $msg]}
    {poly1305 verify $key $msg $tag}
}

set demos'slow' {
    {flightawarebench::test 5 5 2}
    {llength [hash::main]}
}
 
................................................................................
    upvar0a
    upvartest0::*
    upvartest1::*
    upvartest2::*
    flightawarebench::*
    hash::*
    redundant-purify
    inlinetwice::*
    licm1 licm2
    cse cse-caller
    wideimpure
    poly1305::*
    poly1305::tcl::mathfunc::*
}
set toCompile'slow' {
    parseBuiltinsTxt::main
}
 
#############################################################################
#

                                      $replacement and remove the instruction"
			    }
			    my removeUse $source $b
			    dict unset udchain $result
			    my replaceUses $result $replacement
			    set changed 1
			    continue; # delete the quad
			}			

		    }

		    "extractScalar" {
			my debug-constfold {
			    puts "$b:$pc: examine $q"
			}

................................................................................
			set source [lindex $argl 0]
			set have [typeOfLiteral $source]

			# Can I say sommething definitive?
			unset -nocomplain replacement
			if {[quadcode::dataType::isa $have $want]} {
			    set replacement {literal 1}
			} elseif {![quadcode::dataType::mightbea $have $want]} {
			    set replacement {literal 0}
			}
			if {[info exists replacement]} {
			    my debug-constfold {
				puts "$b:$pc: can replace $result with\
                                      $replacement and remove the instruction"
			    }
			    lset bbcontent $b $pc [list nop {}]
			    my removeUse $source $b
			    dict unset udchain $result
			    my replaceUses $result $replacement
			    set changed 1
			    continue; # delete the quad
			}			
		    }

		    "le" {
			lassign $argl x y
			set res [list literal [expr {$x <= $y}]]
			my debug-constfold {
			    puts "$b:$pc: $q"
			    puts "    replace $result with $res"
			}
................................................................................
			set changed 1
			continue; # delete the quad
		    }

		    "listRange" {
			set res [list literal [lrange {*}$argl]]
			my debug-constfold {













			    puts "$b:$pc: $q"
			    puts "    replace $result with $res"
			}
			dict unset udchain $result
			my replaceUses $result $res
			set changed 1
			continue; # delete the quad
................................................................................
			    puts "    replace $result with $res"
			}
			dict unset udchain $result
			my replaceUses $result $res
			set changed 1
			continue; # delete the quad
		    }			














		    "strcat" {
			set res [list literal [join $argl ""]]
			my debug-constfold {
			    puts "$b:$pc: $q"
			    puts "    replace $result with $res"
			}

                                      $replacement and remove the instruction"
			    }
			    my removeUse $source $b
			    dict unset udchain $result
			    my replaceUses $result $replacement
			    set changed 1
			    continue; # delete the quad
			}
			lset newbb [incr newpc] $q; # don't delete the quad
		    }

		    "extractScalar" {
			my debug-constfold {
			    puts "$b:$pc: examine $q"
			}

................................................................................
			set source [lindex $argl 0]
			set have [typeOfLiteral $source]

			# Can I say sommething definitive?
			unset -nocomplain replacement
			if {[quadcode::dataType::isa $have $want]} {
			    set replacement {literal 1}
			} else {
			    set replacement {literal 0}
			}

			my debug-constfold {
			    puts "$b:$pc: can replace $result with\
                            	  $replacement and remove the instruction"	
			}
			lset bbcontent $b $pc [list nop {}]
			my removeUse $source $b
			dict unset udchain $result
			my replaceUses $result $replacement
			set changed 1
			continue; # delete the quad
		    }
		    

		    "le" {
			lassign $argl x y
			set res [list literal [expr {$x <= $y}]]
			my debug-constfold {
			    puts "$b:$pc: $q"
			    puts "    replace $result with $res"
			}
................................................................................
			set changed 1
			continue; # delete the quad
		    }

		    "listRange" {
			set res [list literal [lrange {*}$argl]]
			my debug-constfold {
			    puts "$b:$pc: $q"
			    puts "    replace $result with $res"
			}
			dict unset udchain $result
			my replaceUses $result $res
			set changed 1
			continue; # delete the quad
		    }

		    "lshift" {
			lassign $argl x y
			set res [list literal [expr {$x << $y}]]
			my debug-constfold {
			    puts "$b:$pc: $q"
			    puts "    replace $result with $res"
			}
			dict unset udchain $result
			my replaceUses $result $res
			set changed 1
			continue; # delete the quad
................................................................................
			    puts "    replace $result with $res"
			}
			dict unset udchain $result
			my replaceUses $result $res
			set changed 1
			continue; # delete the quad
		    }			

		    "rshift" {
			lassign $argl x y
			set res [list literal [expr {$x >> $y}]]
			my debug-constfold {
			    puts "$b:$pc: $q"
			    puts "    replace $result with $res"
			}
			dict unset udchain $result
			my replaceUses $result $res
			set changed 1
			continue; # delete the quad
		    }

		    "strcat" {
			set res [list literal [join $argl ""]]
			my debug-constfold {
			    puts "$b:$pc: $q"
			    puts "    replace $result with $res"
			}

    namespace upvar ::quadcode::dataType FAIL FAIL

    my debug-inline {
	puts "Before attempting to expand inlines:"
	my dump-bb
    }





    set didSomething 0

    # Walk through all quadcodes, looking for 'invoke' of a literal.
    # 'bs' is a queue of basic block numbers to analyze. If a block
    # has potential calls following an inlined procedure, it will be
    # split, and the index of the new block that must be analyzed will
................................................................................
	    }

	    # Ready to inline, let's go!

	    my diagnostic note $b $pc "Inlining %s into %s" \
		[$toInline full-name] [my full-name]
	    my expandOneInline $b $bb $pc $q $toInline




	    set didSomething 1

	    # FIXME:
	    # We've just moved the rest of the code out of the basic block, but
	    # there might be another call in the same bb that this will miss.
	    # For that reason, this procedure needs refactoring to be able
	    # to continue with the rewritten continuation of the block.

	    break
	}
    }
    





    return $didSomething
    
}
 
# quadcode::transformer method expandOneInline --
#
#	Expands an inline procedure invocation.
................................................................................
    lappend bbpred {*}[lrepeat [llength $xbbcontent] {}]
    my debug-inline {
	puts "inline: [llength $xbbcontent] blocks added with inlined code"
    }
    
    # Unlink variables used in the 'invoke'

    foreach {- v} [lrange $q 2 end] {
	if {[lindex $v 0] in {"var" "temp"}} {
	    my removeUse $v $b
	}
    }
    my debug-inline {
	puts "inline: variables in 'invoke' unlinked from du-chains"
    }

    namespace upvar ::quadcode::dataType FAIL FAIL

    my debug-inline {
	puts "Before attempting to expand inlines:"
	my dump-bb
    }
    my debug-audit {
	my audit-duchain "entry to expandInlines"
	my audit-phis "entry to expandInlines"
    }

    set didSomething 0

    # Walk through all quadcodes, looking for 'invoke' of a literal.
    # 'bs' is a queue of basic block numbers to analyze. If a block
    # has potential calls following an inlined procedure, it will be
    # split, and the index of the new block that must be analyzed will
................................................................................
	    }

	    # Ready to inline, let's go!

	    my diagnostic note $b $pc "Inlining %s into %s" \
		[$toInline full-name] [my full-name]
	    my expandOneInline $b $bb $pc $q $toInline
	    my debug-audit {
		my audit-duchain "after expandOneInline [$toInline full-name]"
		my audit-phis "after expandOneInline"
	    }
	    set didSomething 1

	    # FIXME:
	    # We've just moved the rest of the code out of the basic block, but
	    # there might be another call in the same bb that this will miss.
	    # For that reason, this procedure needs refactoring to be able
	    # to continue with the rewritten continuation of the block.

	    break
	}
    }
    
    my debug-audit {
	my audit-duchain "exit from expandInlines"
	my audit-phis "exit from expandInlines"
    }

    return $didSomething
    
}
 
# quadcode::transformer method expandOneInline --
#
#	Expands an inline procedure invocation.
................................................................................
    lappend bbpred {*}[lrepeat [llength $xbbcontent] {}]
    my debug-inline {
	puts "inline: [llength $xbbcontent] blocks added with inlined code"
    }
    
    # Unlink variables used in the 'invoke'

    foreach v [lrange $q 2 end] {
	if {[lindex $v 0] in {"var" "temp"}} {
	    my removeUse $v $b
	}
    }
    my debug-inline {
	puts "inline: variables in 'invoke' unlinked from du-chains"
    }

	    if {[my ns_splittable $splitb]} {
		# Split a single basic block
		my ns_cloneBB $splitb
		my debug-nodesplit {
		    puts "After splitting:"
		    my dump-bb
		}


		my audit-phis "one split"

		return 1
	    }
	}
    }

    # Found nothing to split

	    if {[my ns_splittable $splitb]} {
		# Split a single basic block
		my ns_cloneBB $splitb
		my debug-nodesplit {
		    puts "After splitting:"
		    my dump-bb
		}
		my debug-audit {
		    my audit-duchain "nodesplit"
		    my audit-phis "nodesplit"
		}
		return 1
	    }
	}
    }

    # Found nothing to split

	my dump-bb
    }

    # 0. Initialize the global variable numbering tables.

    my pre_init

    if {[catch {
	my audit-duchain pre-0
	my audit-phis pre-0
    } trouble opts]} {
	puts stderr "TROUBLE: $trouble"
	return -options ${opts} $trouble
    }

    # 1. Perform a top-down traversal of the basic blocks (which has the
    #    effect that any block's dominators will have been processed before
    #    the block itself). Compute the global value numbering that maps
    #	 expressions to their values. Compute the expression generation
    #	 sets (EXP_GEN, PHI_GEN, TMP_GEN) and analyze available expressions
    #	 (AVAIL_OUT).

................................................................................
    variable ::quadcode::gvn_eliminable

    # Walk through basic blocks in the forward direction
    set b -1
    foreach bb $bbcontent {
	incr b

	my debug-pre {
	    puts "bb $b:"
	}

	# Clear the 'gen' sets and inherit the 'avail_out' set from
	# the basic block's immediate dominator (which must have been
	# visited already!)
	set exp_gen_b {}
................................................................................
	    set op [lindex $opcode 0]

	    # Ignore instructions that don't produce values
	    if {[lindex $result 0] ni {"temp" "var"}} {
		continue
	    }

	    my debug-pre {
		puts "  $pc: $q"
	    }

	    # Break down remaining  instructions into four types: phis,
	    # copies, instructions that might be processed by PRE, and
	    # others.
	    if {$op eq "phi"} {
................................................................................

	    if {![dict exists $avail_out_b $v]} {
		dict set avail_out_b $v $result
	    }
		
	}

	my debug-pre {
	    puts "generated:"
	    dict for {v expr} $exp_gen_b {
		puts "    value $v: $expr"
	    }
	    puts "phis:"
	    dict for {v srcs} $phi_gen_b {
		puts "    $v <- $srcs"
................................................................................

	# A block with a single predecessor has a trivial AVAIL_IN set
	dict for {p -} $preds break
	return [lindex $pre_avail_out $p]

    }

    my debug-pre {
	puts "  Compute available exprs at merge point $b"
    }

    # A merge point may need to have phi's inserted. Start with the values
    # that are available from the dominator.

    set avail_in [lindex $pre_avail_out [lindex $bbidom $b]]
    my debug-pre {
	puts "Available from dominator [lindex $bbidom $b]:\
              [dict keys $avail_in]"
    }
    
    # Merge in any values that arrive from all predecessors but
    # do not originate in the dominator
    set firsttime 1
    set newphis {}
    dict for {p -} $preds {
	set avout_p [lindex $pre_avail_out $p]
	my debug-pre {
	    puts "    Available from $p: [dict keys $avout_p]"
	}
	if {$firsttime} {
	    dict for {v e} $avout_p {
		if {![dict exists $avail_in $v]} {
		    dict set newphis $v [list bb $p] $e
		}
................................................................................
	    lappend newbb $insn
	    my pre_gvn_add [list {} $var] $v
	    dict set avail_in $v $var
	}
	set bb [linsert $bb[set bb ""] 0 {*}$newbb]
    }
	
    my debug-pre {
	puts "  Available on entry to $b: [dict keys $avail_in]"
    }
    return $avail_in
    
}

 
................................................................................
    # Calculate the retrograde order in which blocks are to be visited
    set bs [my bbrorder]

    # Iterate to convergence
    set changed 1
    while {$changed} {

	my debug-pre {
	    puts "Do one pass of anticipability analysis"
	} 

	set changed 0

	# Visit blocks in retrograde sequence
	foreach b $bs {

	    my debug-pre {
		puts "  bb $b:"
	    }
	    
	    set old [lindex $pre_antic_in $b]

	    # Calculate ANTIC_OUT by processing the block's successors
	    set succs [my bbsucc $b]
	    if {[llength $succs] == 0} {
	
		my debug-pre {
		    puts "    is an exit block"
		}
		# Exit block
		set antic_out {}
	    } elseif {[llength $succs] == 1} {

		# Single-successor block. The values anticipable
................................................................................
		# on entry to the successor must be translated through
		# phi's to the ones anticipated on exit from
		# this block. Note that there is a typo in [VanD04]
		# Figure 4.5 at this step: ANTIC_IN[b] should be
		# ANTIC_IN[succ(b)].
		set f [lindex $succs 0]

		my debug-pre {
		    puts "    has a single follower, $f"
		}
		set antic_in_f [lindex $pre_antic_in $f]
		my debug-pre {
		    puts "      which has anticipable values:"
		    dict for {vvv eee} $antic_in_f {
			puts "        value $vvv = $eee"
		    }
		}
		my debug-pre {
		    puts "      giving anticipable values on output of $b:"
		}
		set antic_out {}
		dict for {olde pair} [my pre_phi_translate $antic_in_f $b $f] {
		    lassign $pair newv newe
		    dict set antic_out $newv $newe
		    my debug-pre {
			puts "        value $newv: $newe"
		    }
		}
		
	    } else {

		my debug-pre {
		    puts "      has multiple successors: $succs"
		}		    

		# This block has fanout. Calculate the intersection of
		# ANTIC_IN from all successors
		lassign $succs first rest
		set antic_out [lindex $pre_antic_in $first]
................................................................................
		    dict for {v e} $antic_out {
			if {![dict exists $antic_in_bprime $v]} {
			    dict unset antic_out $v
			}
		    }
		}

		my debug-pre {
		    puts "      intersection of successors' anticipable exprs:"
		    dict for {vvv eee} $antic_out {
			puts "        value $vvv = $eee"
		    }
		}
	    }

................................................................................

	    # Remove anything from ANTIC_OUT that is a temporary
	    # computed in the block.
	    foreach x $tmp_gen_b {
		set e [list {} $x]
		set v [my pre_gvn_lookup $e]
		if {[dict exists $antic_out $v]} {
		    my debug-pre {
			puts "    remove value $v = $e because\
                                  it is computed here"
		    }
		    dict unset antic_out $v
		}
	    }

................................................................................
	    # EXP_GEN - TMP_GEN - PHI_GEN
	    set antic_in_b $exp_gen_b
	    foreach x $tmp_gen_b {
		set e [list {} $x]
		set v [my pre_gvn_lookup $e]
		if {[dict exists $antic_in_b $v]
		    && [dict get $antic_in_b $v] eq [list {} $x]} {
		    my debug-pre {
			puts "    remove value $v = $e because\
			          it is computed here"
		    }
		    dict unset antic_in_b $v
		}
	    }
	    my debug-pre {
		puts "    locally anticipable in block $b:"
		dict for {vvv eee} $antic_in_b {
		    puts "        value $vvv = $eee"
		}
	    }

	    # Add the antileaders from ANTIC_OUT to ANTIC_IN
	    my debug-pre {
		puts "    anticipable in block $b from downstream:"
	    }
	    dict for {v e} $antic_out {
		if {(![dict exists $tmp_gen_b $v]
		     || [dict get $tmp_gen_b $v] ne $e)
		    && ![dict exists $antic_in_b $v]} {
		    my debug-pre {
			puts "      value $v = $e is anticipable"
		    }
		    dict set antic_in_b $v $e
		} else {
		    my debug-pre {
			puts "      value $v = $e is killed here"
		    }
		}
	    }

	    # Clean any expressions from ANTIC_IN that depend on
	    # killed values
	    set antic_in_b [my pre_clean $antic_in_b]

	    # Test if anything has changed
	    if {$old ne $antic_in_b} {
		my debug-pre {
		    puts "  anticipable set has changed, need another pass."
		}
		lset pre_antic_in $b $antic_in_b
		set changed 1
	    }
	}
    }
................................................................................
	set changed 0

	# Iterate through the basic blocks
	set b -1
	foreach antin $pre_antic_in preds $bbpred dom $bbidom {
	    incr b

	    my debug-pre {
		puts "  bb $b:"
	    }

	    # Inherit the set of created phi's from the block's
	    # dominator, and make them available on the block's output
	    if {[llength $new_sets] == $b} {
		if {$b > 0} {
................................................................................
	    lset pre_avail_out $b $avail_out_b

	    # If the block has more than one predecessor, it's a potential
	    # place for a phi to be inserted

	    if {[dict size $preds] > 1} {

		my debug-pre {
		    puts "    bb $b is a merge point"
		}

		# What expressions are available from the block's dominator?
		set avail_out_d [lindex $pre_avail_out $dom]

		# Find the translations for the anticipable values
................................................................................
		# Potential phis correspond to all anticipable
		# expressions in the block. (We will downselect to
		# those that are partially available - that is,
		# complex expressions that are available in at least
		# one predecessor but not in all.)
		dict for {v e} $antin {

		    my debug-pre {
			puts "    examine anticipated value $v: $e"
		    }
		    lassign $e opcode argl

		    # A simple variable must be fully available
		    if {$opcode == {}} {
			my debug-pre {
			    puts "      it's a simple value, can't need a phi"
			}
			continue
		    }

		    # A value that is available from the dominator is
		    # fully available
		    if {[dict exists $avail_out_d $v]} {
			my debug-pre {
			    puts "      it's available in the dominator already\
                                        as [dict get $avail_out_b $v]"
			}
			continue
		    }

		    # A value that we made a phi for already is fully available
		   
		    if {[dict exists [lindex $new_sets $b] $v]} {
			my debug-pre {
			    puts "      it's already been processed as\
                                        [dict get [lindex $new_sets $b] $v]"
			}
			continue
		    }

		    # Go through the predecessors and find the leaders
................................................................................
		    set all_same 1
		    unset -nocomplain first_s
		    dict for {p trans} $translated_p {
			lassign [dict get $trans $v] v1 e1
			set avail_out_p [lindex $pre_avail_out $p]
			if {![dict exists $avail_out_p $v1]} {

			    my debug-pre {
				puts "      it's unavailable in predecessor $p"
			    }
			    # The value is unavailable in the predecessor
			    dict set avail $p [list $v1 $e1]

			    set all_same 0
			} else {

			    # The value is available as e2 in the predecessor
			    set var2 [dict get $avail_out_p $v1]
			    set e2 [list {} $var2]
			    my debug-pre {
				puts "      it's available as $var2 in\
                                            predecessor $p"
			    }
			    set e2 [list {} $var2]
			    dict set avail $p [list $v1 $e2]
			    set by_some 1
			    if {![info exists first_s]} {
................................................................................
			    }
			}
		    }

		    # If the value is fully available or not available,
		    # there's nothing to do
		    if {$all_same} {
			my debug-pre {
			    puts "    it's fully available in block $b"
			}
			continue
		    }
		    if {!$by_some} {
			my debug-pre {
			    puts "    it's unavailable in block $b"
			}
			continue
		    }

		    my debug-pre {
			puts "    it's partially available in block $b"
		    }

		    # Rewrite the code to make the value available
		    dict for {p pair} $avail {

			# Examine a predecessor block to see if the value is
................................................................................
			if {[lindex $e1 0] eq {}} {
			    # The value is available, we're done
			    continue
			}

			# Create a temp to hold the value in the predecessor
			set t [my pre_make_temp_for_expr $v $e]
			my debug-pre {
			    puts "    Created $t to hold $e1 in $p"
			}
			dict set udchain $t $p

			# Create an instruction to evaluate the value in
			# the predecessor
			set avail_out_p [lindex $pre_avail_out $p]
................................................................................

    set changed 0

    # Walk through the basic blocks and their AVAIL sets
    set b -1
    foreach bb $bbcontent avail_out_b $pre_avail_out {
	incr b
	my debug-pre {
	    puts "bb $b:"
	}
	set newbb {}

	# Walk through the instructions in the block
	set pc -1
	foreach q $bb {
	    incr pc
	    my debug-pre {
		puts "  $pc: $q"
	    }
	    set argl [lassign $q opcode result]
	    set op [lindex $opcode 0]

	    # Might this instruction have been eliminated?
	    if {[dict exists $gvn_eliminable $op]} {
................................................................................
		    # Replace this instruction with a copy
		    foreach a $argl {
			if {[lindex $a 0] in {"temp" "var"}} {
			    my removeUse $a $b
			}
		    }
		    my addUse $x $b



		    set q [list copy $result $x]
		    set changed 1
		    my debug-pre {
			puts "-------> $q"
		    }
		}
	    }
	    
	    lappend newbb $q
	}
	lset bbcontent $b $newbb
................................................................................
# Results:
#	Returns the result of the translation

oo::define quadcode::transformer method pre_phi_translate1 {es v e p s} {

    my variable pre_phi_gen
    
    my debug-pre {
	puts "        Translate value $v: $e on edge $p -> $s"
    }

    set phis [lindex $pre_phi_gen $s]
    ;			       # Phi operations at the successor block
    set pkey [list bb $p];     # Key for looking up predecessor value at a phi

................................................................................

	if {[dict exists $phis $t $pkey]} {

	    # temporary participates in a phi
	    set tprime [dict get $phis $t $pkey]
	    set eprime [list {} $tprime]
	    set vprime [my pre_gvn_lookup $eprime]
	    my debug-pre {
		puts "          value $v: $t in $s maps to\
                                value $vprime: $tprime in $p"
	    }
	    return [list $vprime $eprime]
	} else {
	    my debug-pre {
		puts "          value $v: $t does not appear in a phi in $s,\
                                so it maps to itself in $p"
	    }
	    return [list $v $e]
	}
    }
    
................................................................................
	    }
	}
    }

    set vout [my pre_gvn_lookup_or_add $eout]
    set result [list $vout $eout]

    my debug-pre {
	puts "          value $v: $e in $s maps to value $vout: $eout in $p"
    }
    
    return $result
}
 
# quadcode::transformer method pre_clean --
................................................................................
#	     are anticipable expressions, in dependency order
#
# Results:
#	Returns the dictionary with killed expressions pruned

oo::define quadcode::transformer method pre_clean {es} {

    my debug-pre {
	puts "    clean anticipated set"
    }
    dict for {v e} $es {
	set argl [lassign $e opcode]
	if {$opcode eq {}} continue; # temps have already been handled
	foreach a $argl {
	    if {[lindex $a 0] eq "value"} {
		set v2 [lindex $a 1]
		if {![dict exists $es $v2]} {
		    dict unset es $v
		    my debug-pre {
			puts "      remove $v = $e because value $v2 ($a)\
                                    is not anticipated"
		    }
		    break
		}
	    }
	}

	my dump-bb
    }

    # 0. Initialize the global variable numbering tables.

    my pre_init









    # 1. Perform a top-down traversal of the basic blocks (which has the
    #    effect that any block's dominators will have been processed before
    #    the block itself). Compute the global value numbering that maps
    #	 expressions to their values. Compute the expression generation
    #	 sets (EXP_GEN, PHI_GEN, TMP_GEN) and analyze available expressions
    #	 (AVAIL_OUT).

................................................................................
    variable ::quadcode::gvn_eliminable

    # Walk through basic blocks in the forward direction
    set b -1
    foreach bb $bbcontent {
	incr b

	my debug-pre-detail {
	    puts "bb $b:"
	}

	# Clear the 'gen' sets and inherit the 'avail_out' set from
	# the basic block's immediate dominator (which must have been
	# visited already!)
	set exp_gen_b {}
................................................................................
	    set op [lindex $opcode 0]

	    # Ignore instructions that don't produce values
	    if {[lindex $result 0] ni {"temp" "var"}} {
		continue
	    }

	    my debug-pre-detail {
		puts "  $pc: $q"
	    }

	    # Break down remaining  instructions into four types: phis,
	    # copies, instructions that might be processed by PRE, and
	    # others.
	    if {$op eq "phi"} {
................................................................................

	    if {![dict exists $avail_out_b $v]} {
		dict set avail_out_b $v $result
	    }
		
	}

	my debug-pre-detail {
	    puts "generated:"
	    dict for {v expr} $exp_gen_b {
		puts "    value $v: $expr"
	    }
	    puts "phis:"
	    dict for {v srcs} $phi_gen_b {
		puts "    $v <- $srcs"
................................................................................

	# A block with a single predecessor has a trivial AVAIL_IN set
	dict for {p -} $preds break
	return [lindex $pre_avail_out $p]

    }

    my debug-pre-detail {
	puts "  Compute available exprs at merge point $b"
    }

    # A merge point may need to have phi's inserted. Start with the values
    # that are available from the dominator.

    set avail_in [lindex $pre_avail_out [lindex $bbidom $b]]
    my debug-pre-detail {
	puts "Available from dominator [lindex $bbidom $b]:\
              [dict keys $avail_in]"
    }
    
    # Merge in any values that arrive from all predecessors but
    # do not originate in the dominator
    set firsttime 1
    set newphis {}
    dict for {p -} $preds {
	set avout_p [lindex $pre_avail_out $p]
	my debug-pre-detail {
	    puts "    Available from $p: [dict keys $avout_p]"
	}
	if {$firsttime} {
	    dict for {v e} $avout_p {
		if {![dict exists $avail_in $v]} {
		    dict set newphis $v [list bb $p] $e
		}
................................................................................
	    lappend newbb $insn
	    my pre_gvn_add [list {} $var] $v
	    dict set avail_in $v $var
	}
	set bb [linsert $bb[set bb ""] 0 {*}$newbb]
    }
	
    my debug-pre-detail {
	puts "  Available on entry to $b: [dict keys $avail_in]"
    }
    return $avail_in
    
}

 
................................................................................
    # Calculate the retrograde order in which blocks are to be visited
    set bs [my bbrorder]

    # Iterate to convergence
    set changed 1
    while {$changed} {

	my debug-pre-detail {
	    puts "Do one pass of anticipability analysis"
	} 

	set changed 0

	# Visit blocks in retrograde sequence
	foreach b $bs {

	    my debug-pre-detail {
		puts "  bb $b:"
	    }
	    
	    set old [lindex $pre_antic_in $b]

	    # Calculate ANTIC_OUT by processing the block's successors
	    set succs [my bbsucc $b]
	    if {[llength $succs] == 0} {
	
		my debug-pre-detail {
		    puts "    is an exit block"
		}
		# Exit block
		set antic_out {}
	    } elseif {[llength $succs] == 1} {

		# Single-successor block. The values anticipable
................................................................................
		# on entry to the successor must be translated through
		# phi's to the ones anticipated on exit from
		# this block. Note that there is a typo in [VanD04]
		# Figure 4.5 at this step: ANTIC_IN[b] should be
		# ANTIC_IN[succ(b)].
		set f [lindex $succs 0]

		my debug-pre-detail {
		    puts "    has a single follower, $f"
		}
		set antic_in_f [lindex $pre_antic_in $f]
		my debug-pre-detail {
		    puts "      which has anticipable values:"
		    dict for {vvv eee} $antic_in_f {
			puts "        value $vvv = $eee"
		    }
		}
		my debug-pre-detail {
		    puts "      giving anticipable values on output of $b:"
		}
		set antic_out {}
		dict for {olde pair} [my pre_phi_translate $antic_in_f $b $f] {
		    lassign $pair newv newe
		    dict set antic_out $newv $newe
		    my debug-pre-detail {
			puts "        value $newv: $newe"
		    }
		}
		
	    } else {

		my debug-pre-detail {
		    puts "      has multiple successors: $succs"
		}		    

		# This block has fanout. Calculate the intersection of
		# ANTIC_IN from all successors
		lassign $succs first rest
		set antic_out [lindex $pre_antic_in $first]
................................................................................
		    dict for {v e} $antic_out {
			if {![dict exists $antic_in_bprime $v]} {
			    dict unset antic_out $v
			}
		    }
		}

		my debug-pre-detail {
		    puts "      intersection of successors' anticipable exprs:"
		    dict for {vvv eee} $antic_out {
			puts "        value $vvv = $eee"
		    }
		}
	    }

................................................................................

	    # Remove anything from ANTIC_OUT that is a temporary
	    # computed in the block.
	    foreach x $tmp_gen_b {
		set e [list {} $x]
		set v [my pre_gvn_lookup $e]
		if {[dict exists $antic_out $v]} {
		    my debug-pre-detail {
			puts "    remove value $v = $e because\
                                  it is computed here"
		    }
		    dict unset antic_out $v
		}
	    }

................................................................................
	    # EXP_GEN - TMP_GEN - PHI_GEN
	    set antic_in_b $exp_gen_b
	    foreach x $tmp_gen_b {
		set e [list {} $x]
		set v [my pre_gvn_lookup $e]
		if {[dict exists $antic_in_b $v]
		    && [dict get $antic_in_b $v] eq [list {} $x]} {
		    my debug-pre-detail {
			puts "    remove value $v = $e because\
			          it is computed here"
		    }
		    dict unset antic_in_b $v
		}
	    }
	    my debug-pre-detail {
		puts "    locally anticipable in block $b:"
		dict for {vvv eee} $antic_in_b {
		    puts "        value $vvv = $eee"
		}
	    }

	    # Add the antileaders from ANTIC_OUT to ANTIC_IN
	    my debug-pre-detail {
		puts "    anticipable in block $b from downstream:"
	    }
	    dict for {v e} $antic_out {
		if {(![dict exists $tmp_gen_b $v]
		     || [dict get $tmp_gen_b $v] ne $e)
		    && ![dict exists $antic_in_b $v]} {
		    my debug-pre-detail {
			puts "      value $v = $e is anticipable"
		    }
		    dict set antic_in_b $v $e
		} else {
		    my debug-pre-detail {
			puts "      value $v = $e is killed here"
		    }
		}
	    }

	    # Clean any expressions from ANTIC_IN that depend on
	    # killed values
	    set antic_in_b [my pre_clean $antic_in_b]

	    # Test if anything has changed
	    if {$old ne $antic_in_b} {
		my debug-pre-detail {
		    puts "  anticipable set has changed, need another pass."
		}
		lset pre_antic_in $b $antic_in_b
		set changed 1
	    }
	}
    }
................................................................................
	set changed 0

	# Iterate through the basic blocks
	set b -1
	foreach antin $pre_antic_in preds $bbpred dom $bbidom {
	    incr b

	    my debug-pre-detail {
		puts "  bb $b:"
	    }

	    # Inherit the set of created phi's from the block's
	    # dominator, and make them available on the block's output
	    if {[llength $new_sets] == $b} {
		if {$b > 0} {
................................................................................
	    lset pre_avail_out $b $avail_out_b

	    # If the block has more than one predecessor, it's a potential
	    # place for a phi to be inserted

	    if {[dict size $preds] > 1} {

		my debug-pre-detail {
		    puts "    bb $b is a merge point"
		}

		# What expressions are available from the block's dominator?
		set avail_out_d [lindex $pre_avail_out $dom]

		# Find the translations for the anticipable values
................................................................................
		# Potential phis correspond to all anticipable
		# expressions in the block. (We will downselect to
		# those that are partially available - that is,
		# complex expressions that are available in at least
		# one predecessor but not in all.)
		dict for {v e} $antin {

		    my debug-pre-detail {
			puts "    examine anticipated value $v: $e"
		    }
		    lassign $e opcode argl

		    # A simple variable must be fully available
		    if {$opcode == {}} {
			my debug-pre-detail {
			    puts "      it's a simple value, can't need a phi"
			}
			continue
		    }

		    # A value that is available from the dominator is
		    # fully available
		    if {[dict exists $avail_out_d $v]} {
			my debug-pre-detail {
			    puts "      it's available in the dominator already\
                                        as [dict get $avail_out_b $v]"
			}
			continue
		    }

		    # A value that we made a phi for already is fully available
		   
		    if {[dict exists [lindex $new_sets $b] $v]} {
			my debug-pre-detail {
			    puts "      it's already been processed as\
                                        [dict get [lindex $new_sets $b] $v]"
			}
			continue
		    }

		    # Go through the predecessors and find the leaders
................................................................................
		    set all_same 1
		    unset -nocomplain first_s
		    dict for {p trans} $translated_p {
			lassign [dict get $trans $v] v1 e1
			set avail_out_p [lindex $pre_avail_out $p]
			if {![dict exists $avail_out_p $v1]} {

			    my debug-pre-detail {
				puts "      it's unavailable in predecessor $p"
			    }
			    # The value is unavailable in the predecessor
			    dict set avail $p [list $v1 $e1]

			    set all_same 0
			} else {

			    # The value is available as e2 in the predecessor
			    set var2 [dict get $avail_out_p $v1]
			    set e2 [list {} $var2]
			    my debug-pre-detail {
				puts "      it's available as $var2 in\
                                            predecessor $p"
			    }
			    set e2 [list {} $var2]
			    dict set avail $p [list $v1 $e2]
			    set by_some 1
			    if {![info exists first_s]} {
................................................................................
			    }
			}
		    }

		    # If the value is fully available or not available,
		    # there's nothing to do
		    if {$all_same} {
			my debug-pre-detail {
			    puts "    it's fully available in block $b"
			}
			continue
		    }
		    if {!$by_some} {
			my debug-pre-detail {
			    puts "    it's unavailable in block $b"
			}
			continue
		    }

		    my debug-pre-detail {
			puts "    it's partially available in block $b"
		    }

		    # Rewrite the code to make the value available
		    dict for {p pair} $avail {

			# Examine a predecessor block to see if the value is
................................................................................
			if {[lindex $e1 0] eq {}} {
			    # The value is available, we're done
			    continue
			}

			# Create a temp to hold the value in the predecessor
			set t [my pre_make_temp_for_expr $v $e]
			my debug-pre-detail {
			    puts "    Created $t to hold $e1 in $p"
			}
			dict set udchain $t $p

			# Create an instruction to evaluate the value in
			# the predecessor
			set avail_out_p [lindex $pre_avail_out $p]
................................................................................

    set changed 0

    # Walk through the basic blocks and their AVAIL sets
    set b -1
    foreach bb $bbcontent avail_out_b $pre_avail_out {
	incr b
	my debug-pre-detail {
	    puts "bb $b:"
	}
	set newbb {}

	# Walk through the instructions in the block
	set pc -1
	foreach q $bb {
	    incr pc
	    my debug-pre-detail {
		puts "  $pc: $q"
	    }
	    set argl [lassign $q opcode result]
	    set op [lindex $opcode 0]

	    # Might this instruction have been eliminated?
	    if {[dict exists $gvn_eliminable $op]} {
................................................................................
		    # Replace this instruction with a copy
		    foreach a $argl {
			if {[lindex $a 0] in {"temp" "var"}} {
			    my removeUse $a $b
			}
		    }
		    my addUse $x $b
		    my debug-pre {
			puts "   replace $b:$pc: $q"
		    }
		    set q [list copy $result $x]
		    set changed 1
		    my debug-pre {
			puts "   with    $b:$pc: $q"
		    }
		}
	    }
	    
	    lappend newbb $q
	}
	lset bbcontent $b $newbb
................................................................................
# Results:
#	Returns the result of the translation

oo::define quadcode::transformer method pre_phi_translate1 {es v e p s} {

    my variable pre_phi_gen
    
    my debug-pre-detail {
	puts "        Translate value $v: $e on edge $p -> $s"
    }

    set phis [lindex $pre_phi_gen $s]
    ;			       # Phi operations at the successor block
    set pkey [list bb $p];     # Key for looking up predecessor value at a phi

................................................................................

	if {[dict exists $phis $t $pkey]} {

	    # temporary participates in a phi
	    set tprime [dict get $phis $t $pkey]
	    set eprime [list {} $tprime]
	    set vprime [my pre_gvn_lookup $eprime]
	    my debug-pre-detail {
		puts "          value $v: $t in $s maps to\
                                value $vprime: $tprime in $p"
	    }
	    return [list $vprime $eprime]
	} else {
	    my debug-pre-detail {
		puts "          value $v: $t does not appear in a phi in $s,\
                                so it maps to itself in $p"
	    }
	    return [list $v $e]
	}
    }
    
................................................................................
	    }
	}
    }

    set vout [my pre_gvn_lookup_or_add $eout]
    set result [list $vout $eout]

    my debug-pre-detail {
	puts "          value $v: $e in $s maps to value $vout: $eout in $p"
    }
    
    return $result
}
 
# quadcode::transformer method pre_clean --
................................................................................
#	     are anticipable expressions, in dependency order
#
# Results:
#	Returns the dictionary with killed expressions pruned

oo::define quadcode::transformer method pre_clean {es} {

    my debug-pre-detail {
	puts "    clean anticipated set"
    }
    dict for {v e} $es {
	set argl [lassign $e opcode]
	if {$opcode eq {}} continue; # temps have already been handled
	foreach a $argl {
	    if {[lindex $a 0] eq "value"} {
		set v2 [lindex $a 1]
		if {![dict exists $es $v2]} {
		    dict unset es $v
		    my debug-pre-detail {
			puts "      remove $v = $e because value $v2 ($a)\
                                    is not anticipated"
		    }
		    break
		}
	    }
	}

		    if {[my mayInline $q]} {
			set mightInline 1
			break
		    }
		}
		if {$mightInline} {
		    set inf [dict get $typeInf $inst]



		    if {[catch {$inf expandInlines} result]} {
			lassign $inst procName argTypes
			my diagnostic $procName $argTypes \
			    "" 0 $procName \
			    fatal $result $procName $::errorInfo
		    } elseif {$result} {
			my AddToWorklist 0 {*}$inst
................................................................................
    set inf [dict get $typeInf $instance]

    my debug-specializer {
	set argTypeNames [lmap x $argTypes {nameOfType $x}]
	puts "DONESPLIT $procName ($argTypeNames):"
    }

    # TODO - This sequence should be a method on quadcode::transformer
    $inf removeSplitMarkers
    $inf removeCallFrameNop
    $inf uselessphis
    $inf eliminateCallFrame;
    ;   # TODO - Can callframe elimination happen sooner?

}
 
# quadcode::specializer method AddToWorklist --
#
#	Puts a procedure instance on the worklist of procedures to specialize.
#

		    if {[my mayInline $q]} {
			set mightInline 1
			break
		    }
		}
		if {$mightInline} {
		    set inf [dict get $typeInf $inst]
		    my debug-specializer {
			puts "INLINES [$inf full-name]"
		    }
		    if {[catch {$inf expandInlines} result]} {
			lassign $inst procName argTypes
			my diagnostic $procName $argTypes \
			    "" 0 $procName \
			    fatal $result $procName $::errorInfo
		    } elseif {$result} {
			my AddToWorklist 0 {*}$inst
................................................................................
    set inf [dict get $typeInf $instance]

    my debug-specializer {
	set argTypeNames [lmap x $argTypes {nameOfType $x}]
	puts "DONESPLIT $procName ($argTypeNames):"
    }

    $inf doneWithNodeSplitting






}
 
# quadcode::specializer method AddToWorklist --
#
#	Puts a procedure instance on the worklist of procedures to specialize.
#

	    }
	    my debug-tidy {
		lappend debugLine $result
	    }
	}
	my debug-tidy {
	    puts "$debugLine -- $changed"





	}
	if {$changed} {
	    set somethingChanged 1
	}
    }

    # If any of these changes actually changed anything, it may
................................................................................
	
    my debug-tidy {
	puts "tidy: did something change? $somethingChanged"
    }
    return $somethingChanged

}














































 
# quadcode::transformer method sourceFile --
#
#	Returns the source file that this module was compiled from
#
# Results:
#	Returns the file name.

	    }
	    my debug-tidy {
		lappend debugLine $result
	    }
	}
	my debug-tidy {
	    puts "$debugLine -- $changed"
	}
	my debug-timings {
	    foreach {pass usec} $timings {
		puts "$pass: $usec microseconds"
	    }
	}
	if {$changed} {
	    set somethingChanged 1
	}
    }

    # If any of these changes actually changed anything, it may
................................................................................
	
    my debug-tidy {
	puts "tidy: did something change? $somethingChanged"
    }
    return $somethingChanged

}
 
# quadcode::transformer method doneWithNodeSplitting --
#
#	Removes all of the bits and pieces that are used to track
#	node splitting.
#
# Results:
#	None.
#
# Side effects:
#	Removes the markers for which nodes have been split. Removes
#	any remaining 'callFrameNop' instructions. Cleans up useless phis,
#	and eliminates the use of the callframe entirely if possible.
#
# TODO: It is very likely that removeCallFrameNop and eliminateCallFrame
#       can appear much earlier in optimization than this. It might be
#       profitable to investigate this.

oo::define quadcode::transformer method doneWithNodeSplitting {} {

    foreach pass {
	removeSplitMarkers
	removeCallFrameNop
	uselessphis
	eliminateCallFrame
    } {
	set cmd [string map [list @pass $pass] {
	    set result [my @pass]
	}]
	lappend timings $pass [lindex [time $cmd] 0]
	my debug-audit {
	    my audit-duchain $pass
	    my audit-phis $pass
	}
    }
    my debug-audit {
	my audit-duchain "exit from donesplit"
	my audit-phis "exit from donesplit"
    }
    my debug-timings {
	foreach {pass usec} $timings {
	    puts "$pass: $usec microseconds"
	}
    }
    return
}
 
# quadcode::transformer method sourceFile --
#
#	Returns the source file that this module was compiled from
#
# Results:
#	Returns the file name.

oo::define quadcode::transformer method inferTypes {} {

    my debug-inferTypes {
	puts "Before type inference:"
	my dump-bb
    }





    namespace upvar ::quadcode::dataType BOTTOM BOTTOM FAIL FAIL STRING STRING

    # Initialize all types to BOTTOM
    set types {}
    dict for {v -} $udchain {
	dict set types $v $BOTTOM
................................................................................
    } elseif {[string is entier -strict $x]} {
	set y [expr {entier($x)}]
	if {$y eq $x} {
	    set impure 0
	} else {
	    set impure $dataType::IMPURE
	}
	if {$x >= -0x80000000 && $x <= 0x7fffffff} {
	    if {$x == 0} {
		return [dataType::typeUnion $dataType::CONST0 $impure]
	    } elseif {$x == 1} {
		return [dataType::typeUnion $dataType::CONST1 $impure]
	    } else {
		return [dataType::typeUnion $dataType::INT $impure]
	    }
	} else {
	    return [dataType::typeUnion $dataType::ENTIER $impure]
	}
    } elseif {[string is double -strict $x]} {
	set y [expr {double($x)}]
	if {$y eq $x} {
	    return $dataType::DOUBLE
	} else {
	    return [dataType::typeUnion $dataType::DOUBLE $dataType::IMPURE]

oo::define quadcode::transformer method inferTypes {} {

    my debug-inferTypes {
	puts "Before type inference:"
	my dump-bb
    }
    my debug-audit {
	my audit-duchain "entry to inferTypes"
	my audit-phis "entry to inferTypes"
    }

    namespace upvar ::quadcode::dataType BOTTOM BOTTOM FAIL FAIL STRING STRING

    # Initialize all types to BOTTOM
    set types {}
    dict for {v -} $udchain {
	dict set types $v $BOTTOM
................................................................................
    } elseif {[string is entier -strict $x]} {
	set y [expr {entier($x)}]
	if {$y eq $x} {
	    set impure 0
	} else {
	    set impure $dataType::IMPURE
	}
	if {$x >= -0x8000000000000000 && $x <= 0x7fffffffffffffff} {
	    if {$x == 0} {
		return [dataType::typeUnion $dataType::CONST0 $impure]
	    } elseif {$x == 1} {
		return [dataType::typeUnion $dataType::CONST1 $impure]
	    } else {
		return [dataType::typeUnion $dataType::INT $impure]
	    }
	} else {
	    return [dataType::typeUnion $dataType::BIGINT $impure]
	}
    } elseif {[string is double -strict $x]} {
	set y [expr {double($x)}]
	if {$y eq $x} {
	    return $dataType::DOUBLE
	} else {
	    return [dataType::typeUnion $dataType::DOUBLE $dataType::IMPURE]

oo::define quadcode::transformer method analyzeUpvar {} {

    my debug-upvar {
        puts "Before \[upvar\] analysis:"
        my dump-bb
    }





    my bbidom
    my bblevel

    # 1. Walk from the entry block, and analyze what variables contain
    #    the values of passed parameters.

................................................................................

    set upvarState [my upvarFindAliases $argPos]

    # 3. Walk 'moveToCallFrame', 'moveFromCallFrame' and 'invoke' to
    #    determine the procedure's effect on variables.

    set procEffect [my upvarProcEffect $upvarState]






    return $procEffect
}
 
# quadcode::transformer method upvarAnalyzeArgs --
#
#       Determines what named variables in SSA-based quadcode are known to

oo::define quadcode::transformer method analyzeUpvar {} {

    my debug-upvar {
        puts "Before \[upvar\] analysis:"
        my dump-bb
    }
    my debug-audit {
	my audit-duchain "entry to analyzeUpvar"
	my audit-phis "entry to analyzeUpvar"
    }

    my bbidom
    my bblevel

    # 1. Walk from the entry block, and analyze what variables contain
    #    the values of passed parameters.

................................................................................

    set upvarState [my upvarFindAliases $argPos]

    # 3. Walk 'moveToCallFrame', 'moveFromCallFrame' and 'invoke' to
    #    determine the procedure's effect on variables.

    set procEffect [my upvarProcEffect $upvarState]

    my debug-audit {
	my audit-duchain "exit from analyzeUpvar"
	my audit-phis "exit from analyzeUpvar"
    }

    return $procEffect
}
 
# quadcode::transformer method upvarAnalyzeArgs --
#
#       Determines what named variables in SSA-based quadcode are known to