Index: demos/perftest/tester.tcl
==================================================================
--- demos/perftest/tester.tcl
+++ demos/perftest/tester.tcl
@@ -10,10 +10,13 @@
 #
 # 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.
@@ -79,10 +82,16 @@
     set r [expr {hypot($v,$u)}]
     set u2 [expr {$r * cos($th)}]
     set v2 [expr {$r * sin($th)}]
     return [expr {hypot($v2-$v, $u2-$u)}]
 }
+
+proc lmapconsttest {} {
+    lmap y {10 20 30} {
+	lmap x {1 2 3} {expr {$x + $y}}
+    }
+}
 
 # This is a cut-down version of the version in Tcllib's math package
 namespace eval math {}
 proc ::math::ln_Gamma { x } {
 
@@ -1780,10 +1789,81 @@
 	return $pq
     }
 
 }
 
+proc licm1 {a} {
+    set a [expr {int($a)}]
+    set s 0
+    for {set i 0} {$i < $a} {incr i} {
+	incr s [expr {2*$a + $i}]
+    }
+    return $s
+}
+
+proc licm2 {a} {
+    set a [expr {int($a)}]
+    set s 0
+    for {set i 0} {$i < $a} {incr i} {
+	incr s [expr {(2*$a + 1) + $i}]
+    }
+    return $s
+}
+
+proc cse {x a} {
+    set s 0
+    for {set i 0} {$i < $a} {incr i} {
+	if {($i & 1) == 0} {
+	    incr s [expr {2*$x + 1}]
+	} else {
+	    incr s [expr {2*$x + 2}]
+	}
+    }
+    return $s
+}
+
+proc cse-caller {} {
+    for {set x 0} {$x < 3} {incr x} {
+	for {set y 0} {$y < 2} {incr y} {
+	    lappend result [cse $x $y]
+	}
+    }
+    return $result
+}
+
+proc redundant-purify {adder} {
+    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
+    }
+}
 
 namespace eval ::flightawarebench {
     # See https://github.com/flightaware/tclbench/blob/master/math/bench.tcl
     proc degrees_radians {degrees} {
 	return [expr {$degrees * 3.14159265358979323846 / 180.0}]
@@ -2186,10 +2266,11 @@
     {cos 1.2}
     # Fails on a roundoff error: {tantest 1.2}
     {inttest 345}
     {math::ln_Gamma 1.3}
     {polartest 0.6 0.8}
+    {lmapconsttest}
     {powmul1 13 3}
     {powmul2 13 3}
     {zerodiv}
     {uplustest 123 456}
     {uplustest 01 010}
@@ -2446,10 +2527,12 @@
     {linesearch::getAllLines2 2}
     # {flightawarebench::test 5 5 2}
     # {flightawarebench::clockscan 5 5 5}
     parseBuiltinsTxt::main
 
+    {regexptest::matchvar-1 bra abracadabra}
+
     vartest::check
     vartest::throwcheck
     nsvartest::check
     directtest::check
     directtest::alias
@@ -2475,11 +2558,20 @@
     {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}
 }
+
 set demos'slow' {
     {flightawarebench::test 5 5 2}
     {llength [hash::main]}
 }
 
@@ -2495,10 +2587,11 @@
     ::cos
     tantest
     inttest
     math::ln_Gamma
     polartest
+    lmapconsttest
     shift
     powmul1 powmul2
     zerodiv
     uplustest
     # String operations
@@ -2634,10 +2727,11 @@
     singleton::*
     linesearch::colinear
     linesearch::sameline
     linesearch::getAllLines1
     linesearch::getAllLines2
+    regexptest::*
     vartest::*
     nsvartest::*
     directtest::*
     upvar0
     upvar0a
@@ -2644,10 +2738,14 @@
     upvartest0::*
     upvartest1::*
     upvartest2::*
     flightawarebench::*
     hash::*
+    redundant-purify
+    inlinetwice::*
+    licm1 licm2
+    cse cse-caller
     wideimpure
     poly1305::*
     poly1305::tcl::mathfunc::*
 }
 set toCompile'slow' {

Index: quadcode/bb.tcl
==================================================================
--- quadcode/bb.tcl
+++ quadcode/bb.tcl
@@ -350,10 +350,36 @@
 	# Link $to to the new block
 	my bblink $newb $to
 
 	return $newb
     }
+
+    # bbcopy --
+    #
+    #	Makes a copy of a basic block
+    #
+    # Parameters:
+    #	b - Block number to copy
+    #
+    # Results:
+    #	Returns the copied block
+    #
+    # Side effects:
+    #	The copied block has no predecessors - it is assumed that the
+    #	caller will relink it in the correct context.  The copied block
+    #	has as successors the successors of the original block.
+
+    method bbcopy {b} {
+	# Create the block
+	set newb [llength $bbcontent]
+	lappend bbcontent [lindex $bbcontent $b]
+	lappend bbpred {}
+	foreach s [my bbsucc $newb] {
+	    my bblink $newb $s
+	}
+	return $newb
+    }
 
     # bbindex --
     #
     #	Look up a basic block index given the program counter
     #
@@ -496,6 +522,55 @@
 	    lappend nodelist $node
 	}
 
 	return
     }
+    
+    # bbrorder --
+    #
+    #	List the basic blocks in the program in reverse depth-first
+    #	postorder of the minimum spanning tree of the flowgraph, starting
+    #	from the exit nodes
+    #
+    # Results:
+    #	Returns the ordered list of basic block indices
+    #
+    # This method is used in cases where an iteration needs to be conducted
+    # in such a way that a node's postdominators are visited before
+    # the node itself.
+    #
+    # This method must attempt to deal with infinite loops, so all nodes
+    # must be visited eventually. It therefore runs two passes. The first
+    # visits exit nodes, and the second visits everything else.
+
+    method bbrorder {} {
+	set l [llength $bbcontent]
+	set visited [lrepeat $l 0]
+	set nodelist {}
+	for {set i [expr {$l-1}]} {$i >= 0} {incr i -1} {
+	    if {[llength [my bbsucc $i]] == 0} {
+		my bbrorder-worker visited nodelist $i
+	    }
+	}
+	for {set i [expr {$l-1}]} {$i >= 0} {incr i -1} {
+	    my bbrorder-worker visited nodelist $i
+	}
+	return [lreverse $nodelist]
+    }
+
+    method bbrorder-worker {visitedVar nodelistVar node} {
+
+	upvar 1 $visitedVar visited
+	upvar 1 $nodelistVar nodelist
+
+	if {![lindex $visited $node]} {
+	    lset visited $node 1
+	    dict for {p -} [lindex $bbpred $node] {
+		my bbrorder-worker visited nodelist $p
+	    }
+	    lappend nodelist $node
+	}
+
+	return
+    }
+
 }

Index: quadcode/builtin_specials.tcl
==================================================================
--- quadcode/builtin_specials.tcl
+++ quadcode/builtin_specials.tcl
@@ -111,11 +111,11 @@
 
     incr ind 2
 
     # Anything remaining on the line must be a match variable
 
-    if {$ind < [llength $q]} {
+    if {$ind >= [llength $q]} {
 	return {killable Inf noCallFrame {} pure {}}
     } else {
 	return [list writes [expr {3-$ind}]]
     }
 

Index: quadcode/callframe.tcl
==================================================================
--- quadcode/callframe.tcl
+++ quadcode/callframe.tcl
@@ -761,10 +761,11 @@
 		my debug-callframe {
 		    puts "    no variables to move, delete this quad\
                               and replace $cfout with $cfin"
 		}
 		my replaceUses $cfout $cfin
+		my removeUse $cfin $b
 		dict unset duchain $cfout
 	    } else {
 		my debug-callframe {
 		    puts "    new quad: $newq"
 		}
@@ -1296,18 +1297,16 @@
 		    } else {
 			return {0 {}};
 		    }
 		}
 	    } else {
-		set i [expr {-$ind}]
 		foreach p [lrange $params [expr {-1 - $ind}] end] {
 		    if {[lindex $p 0] eq "literal"} {
 			dict set  written [lindex $p 1] {}
 		    } else {
 			return {0 {}};
 		    }
-		    incr i
 		}
 	    }
 	}
     }
 

Index: quadcode/constfold.tcl
==================================================================
--- quadcode/constfold.tcl
+++ quadcode/constfold.tcl
@@ -38,19 +38,21 @@
     for {set b 0} {$b < [llength $bbcontent]} {incr b} {
 	set newbb {}
 	set newpc -1
 	for {set pc 0} {$pc < [llength [lindex $bbcontent $b]]} {incr pc} {
 	    set q [lindex $bbcontent $b $pc]
+	    lset bbcontent $b $pc [list nop {}]
 	    set mightfold 1
 	    set argl {}
 	    foreach arg [lrange $q 2 end] {
 		if {[lindex $arg 0] ne "literal"} {
 		    set mightfold 0
 		    break
 		}
 		lappend argl [lindex $arg 1]
 	    }
+	    set result [lindex $q 1]
 	    if {$mightfold} {
 
 		switch -exact -- [lindex $q 0 0] {
 
 		    "@debug-file" - "@debug-context" -
@@ -61,11 +63,13 @@
 		    "directGet" - "directLappend" - "directLappendList" -
 		    "directSet" - "directUnset" - "directIsArray" -
 		    "directMakeArray" - "foreachStart" - "entry" -
 		    "extractExists" - "extractFail" -
 		    "extractMaybe" - "initException" -
-		    "jump" - "jumpFalse" - "jumpMaybe" - "jumpTrue" - "purify" -
+		    "jump" - "jumpFalse" - "jumpMaybe" - "jumpTrue" -
+		    "narrowToType" -
+		    "procLeave" - "purify" -
 		    "split" - "unshareList" -
 		    "initArray" - "setReturnCode" - "resolveCmd" - "originCmd" {
 			# do nothing - these insns are not killable
 			# this case goes away once I have a better handle
 			# on what's killable.
@@ -78,25 +82,113 @@
 		    "add" {
 			lassign $argl x y
 			set res [list literal [expr {$x + $y}]]
 			my debug-constfold {
 			    puts "$b:$pc: $q"
-			    puts "    replace [lindex $q 1] with $res"
+			    puts "    replace $result with $res"
+			}
+			dict unset udchain $result
+			my replaceUses $result $res
+			set changed 1
+			continue; # delete the quad
+		    }
+
+		    "arrayExists" {
+			my debug-constfold {
+			    puts "$b:$pc: examine $q"
+			}
+
+			# What type do I want?
+			set want $quadcode::dataType::ARRAY
+
+			# What type do I have?
+			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"
+			    }
+			    my removeUse $source $b
+			    dict unset udchain $result
+			    my replaceUses $result $replacement
+			    set changed 1
+			    continue; # delete the quad
+			}			
+		    }
+
+		    "bitand" {
+			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
+		    }
+
+		    "bitnot" {
+			lassign $argl x
+			set res [list literal [expr {~$x}]]
+			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
+		    }
+
+		    "bitor" {
+			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
+		    }
+
+		    "bitxor" {
+			lassign $argl x y
+			set res [list literal [expr {$x ^ $y}]]
+			my debug-constfold {
+			    puts "$b:$pc: $q"
+			    puts "    replace $result with $res"
 			}
-			my replaceUses [lindex $q 1] $res
+			dict unset udchain $result
+			my replaceUses $result $res
 			set changed 1
+			continue; # delete the quad
 		    }
 
 		    "copy" {
 			lassign $argl res
 			set res [list literal $res]
 			my debug-constfold {
 			    puts "$b:$pc: $q"
-			    puts "    replace [lindex $q 1] with $res"
+			    puts "    replace $result with $res"
 			}
-			my replaceUses [lindex $q 1] $res
+			dict unset udchain $result
+			my replaceUses $result $res
 			set changed 1
+			continue; # delete the quad
 		    }
 
 		    "dictExists" {
 			set argl [lassign $argl d]
 			if {[llength $argl] == 0} {
@@ -105,51 +197,59 @@
 			    set res [dict exists $d {*}[lreverse $argl]]
 			}
 			set res [list literal $res]
 			my debug-constfold {
 			    puts "$b:$pc: $q"
-			    puts "    replace [lindex $q 1] with $res"
+			    puts "    replace $result with $res"
 			}
-			my replaceUses [lindex $q 1] $res
+			dict unset udchain $result
+			my replaceUses $result $res
 			set changed 1
+			continue; # delete the quad
 		    }
 
 		    "dictGet" - "dictGetOrNexist" {
 			set argl [lassign $argl d]
 			set res [dict get $d {*}[lreverse $argl]]
 			set res [list literal $res]
 			my debug-constfold {
 			    puts "$b:$pc: $q"
-			    puts "    replace [lindex $q 1] with $res"
+			    puts "    replace $result with $res"
 			}
-			my replaceUses [lindex $q 1] $res
+			dict unset udchain $result
+			my replaceUses $result $res
 			set changed 1
+			continue; # delete the quad
 		    }
 
 		    "dictIncr" {
 			set argl [lassign $argl res]
 			dict incr res {*}$argl
 			set res [list literal $res]
 			my debug-constfold {
 			    puts "$b:$pc: $q"
-			    puts "    replace [lindex $q 1] with $res"
+			    puts "    replace $result with $res"
 			}
-			my replaceUses [lindex $q 1] $res
+			dict unset udchain $result
+			my replaceUses $result $res
 			set changed 1
+			continue; # delete the quad
 		    }
 
 
 		    "dictSet" - "dictSetOrUnset" {
 			set argl [lassign $argl d]
 			dict set d {*}[lreverse $argl]
 			set res [list literal $d]
 			my debug-constfold {
 			    puts "$b:$pc: $q"
-			    puts "    replace [lindex $q 1] with $res"
+			    puts "    replace $result with $res"
 			}
-			my replaceUses [lindex $q 1] $res
+			dict unset udchain $result
+			my replaceUses $result $res
 			set changed 1
+			continue; # delete the quad
 		    }
 
 		    "div" {
 			lassign $argl x y
 			if {[catch {expr {$x / $y}} res]} {
@@ -158,55 +258,154 @@
 			    lset bbcontent $b [incr newpc] $q
 			} else {
 			    set res [list literal $res]
 			    my debug-constfold {
 				puts "$b:$pc: $q"
-				puts "    replace [lindex $q 1] with $res"
+				puts "    replace $result with $res"
 			    }
-			    my replaceUses [lindex $q 1] $res
+			    dict unset udchain $result
+			    my replaceUses $result $res
 			    set changed 1
+			    continue; # delete the quad
 			}
 		    }
 
 		    "eq" {
 			lassign $argl x y
 			set res [list literal [expr {$x == $y}]]
 			my debug-constfold {
 			    puts "$b:$pc: $q"
-			    puts "    replace [lindex $q 1] with $res"
+			    puts "    replace $result with $res"
 			}
-			my replaceUses [lindex $q 1] $res
+			dict unset udchain $result
+			my replaceUses $result $res
 			set changed 1
+			continue; # delete the quad
 		    }
 
 		    "exists" {
 			lassign $argl x
 			my debug-constfold {
 			    puts "$b:$pc: $q"
-			    puts "    replace [lindex $q 1] with {literal 1}"
+			    puts "    replace $result with {literal 1}"
 			}
-			my replaceUses [lindex $q 1] {literal 1}
+			dict unset udchain $result
+			my replaceUses $result {literal 1}
 			set changed 1
+			continue; # delete the quad
+		    }
+
+		    "extractArray" {
+			my debug-constfold {
+			    puts "$b:$pc: examine $q"
+			}
+
+			# What type do I want?
+			set want $quadcode::dataType::ARRAY
+
+			# What type do I have?
+			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 [list literal $source]
+			} elseif {![quadcode::dataType::mightbea $have $want]} {
+			    # This is dead code, but we don't know it yet
+			}
+			if {[info exists replacement]} {
+			    my debug-constfold {
+				puts "$b:$pc: can replace $result with\
+                                      $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"
+			}
+
+			# What type do I want?
+			set want $quadcode::dataType::ARRAY
+
+			# What type do I have?
+			set source [lindex $argl 0]
+			set have [typeOfLiteral $source]
+
+			# Can I say sommething definitive?
+			unset -nocomplain replacement
+			if {[quadcode::dataType::isa $have $want]} {
+			    # This is dead code, but we don't know it yet
+			} elseif {![quadcode::dataType::mightbea $have $want]} {
+			    set replacement [list literal $source]
+			}
+			if {[info exists replacement]} {
+			    my debug-constfold {
+				puts "$b:$pc: can replace $result with\
+                                      $replacement and remove the instruction"
+			    }
+			    my removeUse $source $b
+			    dict unset udchain $result
+			    my replaceUses $result $replacement
+			    set changed 1
+			    continue; # delete the quad
+			}			
 		    }
 
 		    "ge" {
 			lassign $argl x y
 			set res [list literal [expr {$x >= $y}]]
 			my debug-constfold {
 			    puts "$b:$pc: $q"
-			    puts "    replace [lindex $q 1] with $res"
+			    puts "    replace $result with $res"
 			}
-			my replaceUses [lindex $q 1] $res
+			dict unset udchain $result
+			my replaceUses $result $res
 			set changed 1
+			continue; # delete the quad
 		    }
 
 		    "gt" {
 			lassign $argl x y
 			set res [list literal [expr {$x > $y}]]
 			my debug-constfold {
 			    puts "$b:$pc: $q"
-			    puts "    replace [lindex $q 1] with $res"
+			    puts "    replace $result with $res"
+			}
+			dict unset udchain $result
+			my replaceUses $result $res
+			set changed 1
+			continue; # delete the quad
+		    }
+
+		    "initIfNotExists" {
+			set res [list literal [lindex $argl 0]]
+			my debug-constfold {
+			    puts "$b:$pc: $q"
+			    puts "    replace $result with $res"
 			}
-			my replaceUses [lindex $q 1] $res
+			dict unset udchain $result
+			my replaceUses $result $res
 			set changed 1
+			continue; # delete the quad
 		    }
 
+		    "instanceOf" {
+			my debug-constfold {
+			    puts "$b:$pc: examine $q"
+			}
+
+			# What type do I want?
+			set want [lindex $q 0 1]
+
+			# What type do I have?
+			set source [lindex $argl 0]
+			set have [typeOfLiteral $source]
+
@@ -213,150 +412,299 @@
+			# 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 [lindex $q 1] with $res"
+			    puts "    replace $result with $res"
 			}
-			my replaceUses [lindex $q 1] $res
+			dict unset udchain $result
+			my replaceUses $result $res
 			set changed 1
+			continue; # delete the quad
 		    }
 
 		    "list" {
 			set res [list literal [list {*}$argl]]
 			my debug-constfold {
 			    puts "$b:$pc: $q"
-			    puts "    replace [lindex $q 1] with $res"
+			    puts "    replace $result with $res"
 			}
-			my replaceUses [lindex $q 1] $res
-			dict unset udchain [lindex $q 1]
+			dict unset udchain $result
+			my replaceUses $result $res
 			set changed 1
+			continue; # delete the quad
 		    }
 
 		    "listAppend" {
 			set res [lindex $argl 0]
 			lappend res {*}[lrange $argl 1 end]
 			set res [list literal $res]
 			my debug-constfold {
 			    puts "$b:$pc: $q"
-			    puts "    replace [lindex $q 1] with $res"
+			    puts "    replace $result with $res"
+			}
+			dict unset udchain $result
+			my replaceUses $result $res
+			set changed 1
+			continue; # delete the quad
+		    }
+
+		    "listConcat" {
+			set res [list literal [concat {*}$argl]]
+			my debug-constfold {
+			    puts "$b:$pc: $q"
+			    puts "    replace $result with $res"
 			}
-			my replaceUses [lindex $q 1] $res
+			dict unset udchain $result
+			my replaceUses $result $res
 			set changed 1
+			continue; # delete the quad
 		    }
 
 		    "listIndex" {
 			set res [list literal [lindex {*}$argl]]
 			my debug-constfold {
 			    puts "$b:$pc: $q"
-			    puts "    replace [lindex $q 1] with $res"
+			    puts "    replace $result with $res"
 			}
-			my replaceUses [lindex $q 1] $res
+			dict unset udchain $result
+			my replaceUses $result $res
 			set changed 1
+			continue; # delete the quad
 		    }
 
 		    "listLength" {
 			set res [list literal [llength {*}$argl]]
 			my debug-constfold {
 			    puts "$b:$pc: $q"
-			    puts "    replace [lindex $q 1] with $res"
+			    puts "    replace $result with $res"
 			}
-			my replaceUses [lindex $q 1] $res
+			dict unset udchain $result
+			my replaceUses $result $res
 			set changed 1
+			continue; # delete the quad
 		    }
 
 		    "listRange" {
 			set res [list literal [lrange {*}$argl]]
 			my debug-constfold {
 			    puts "$b:$pc: $q"
-			    puts "    replace [lindex $q 1] with $res"
+			    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"
 			}
-			my replaceUses [lindex $q 1] $res
+			dict unset udchain $result
+			my replaceUses $result $res
 			set changed 1
+			continue; # delete the quad
 		    }
 
 		    "lt" {
 			lassign $argl x y
 			set res [list literal [expr {$x < $y}]]
 			my debug-constfold {
 			    puts "$b:$pc: $q"
-			    puts "    replace [lindex $q 1] with $res"
+			    puts "    replace $result with $res"
 			}
-			my replaceUses [lindex $q 1] $res
+			dict unset udchain $result
+			my replaceUses $result $res
 			set changed 1
+			continue; # delete the quad
+		    }
+
+		    "mod" {
+			lassign $argl x y
+			if {[catch {expr {$x % $y}} res]} {
+			    my diagnostic warning $b $pc \
+				"expression will divide by zero at run time"
+			    lset bbcontent $b [incr newpc] $q
+			} else {
+			    set res [list literal $res]
+			    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
+			}
 		    }
 
-		    "mul" {
+		    "mult" {
 			lassign $argl x y
 			set res [list literal [expr {$x * $y}]]
 			my debug-constfold {
 			    puts "$b:$pc: $q"
-			    puts "    replace [lindex $q 1] with $res"
+			    puts "    replace $result with $res"
 			}
-			my replaceUses [lindex $q 1] $res
+			dict unset udchain $result
+			my replaceUses $result $res
 			set changed 1
+			continue; # delete the quad
+		    }
+
+		    "narrowToType" {
+			my debug-constfold {
+			    puts "$b:$pc: examine $q"
+			}
+
+			# What type do I want?
+			set want [lindex $q 0 1]
+
+			# What type do I have?
+			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 [lindex $q 0]
+			} elseif {![quadcode::dataType::mightbea $have $want]} {
+			    # this is dead code, but we don't know it yet
+			}
+			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
+			}			
 		    }
 
 		    "ne" {
 			lassign $argl x y
 			set res [list literal [expr {$x != $y}]]
 			my debug-constfold {
 			    puts "$b:$pc: $q"
-			    puts "    replace [lindex $q 1] with $res"
+			    puts "    replace $result with $res"
+			}
+			dict unset udchain $result
+			my replaceUses $result $res
+			set changed 1
+			continue; # delete the quad
+		    }
+
+		    "not" {
+			lassign $argl x
+			set res [list literal [expr {!$x}]]
+			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
+		    }			
+
+		    "rshift" {
+			lassign $argl x y
+			set res [list literal [expr {$x >> $y}]]
+			my debug-constfold {
+			    puts "$b:$pc: $q"
+			    puts "    replace $result with $res"
 			}
-			my replaceUses [lindex $q 1] $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 [lindex $q 1] with $res"
+			    puts "    replace $result with $res"
 			}
-			my replaceUses [lindex $q 1] $res
+			dict unset udchain $result
+			my replaceUses $result $res
 			set changed 1
+			continue; # delete the quad
 		    }
 
 		    "strrange" {
 			set res [list literal [string range {*}$argl]]
 			my debug-constfold {
 			    puts "$b:$pc: $q"
-			    puts "    replace [lindex $q 1] with $res"
+			    puts "    replace $result with $res"
 			}
-			my replaceUses [lindex $q 1] $res
+			dict unset udchain $result
+			my replaceUses $result $res
 			set changed 1
+			continue; # delete the quad
 		    }
 
 		    "sub" {
 			lassign $argl x y
 			set res [list literal [expr {$x - $y}]]
 			my debug-constfold {
 			    puts "$b:$pc: $q"
-			    puts "    replace [lindex $q 1] with $res"
+			    puts "    replace $result with $res"
 			}
-		 	my replaceUses [lindex $q 1] $res
+			dict unset udchain $result
+		 	my replaceUses $result $res
 			set changed 1
+			continue; # delete the quad
 		    }
 
 		    "uminus" {
 			set res [list literal [expr {- [lindex $argl 0]}]]
 			my debug-constfold {
 			    puts "$b:$pc: $q"
-			    puts "    replace [lindex $q 1] with $res"
+			    puts "    replace $result with $res"
 			}
-			my replaceUses [lindex $q 1] $res
+			dict unset udchain $result
+			my replaceUses $result $res
 			set changed 1
+			continue; # delete the quad
 		    }
 
 		    "unset" {
 			my debug-constfold {
 			    puts "$b:$pc: $q"
-			    puts "    replace [lindex $q 1] with Nothing"
+			    puts "    replace $result with Nothing"
 			}
-			my replaceUses [lindex $q 1] Nothing
+			dict unset udchain $result
+			my replaceUses $result Nothing
 			set changed 1
+			continue; # delete the quad
 		    }
 
 		    default {
 			my debug-constfold {
 			    puts "$b:$pc: $q"

Index: quadcode/copyprop.tcl
==================================================================
--- quadcode/copyprop.tcl
+++ quadcode/copyprop.tcl
@@ -39,11 +39,15 @@
     # Walk thorough all the instructions, looking for copies
     foreach b [my bborder] {
 	set outpc -1
 	for {set pc 0} {$pc < [llength [lindex $bbcontent $b]]} {incr pc} {
 	    set q [lindex $bbcontent $b $pc]
+
 	    if {[lindex $q 0] eq "copy"} {
+		my debug-copyprop {
+		    puts "$b:$pc: $q"
+		}
 		lassign $q - to from
 
 		# Is this copy killable?
 		if {[lindex $to 0] eq "temp"
 		    || [lrange $from 0 1] eq [lrange $to 0 1]} {
@@ -50,41 +54,59 @@
 		    # Kill a copy
 		    my debug-copyprop {
 			puts "Fold copy:"
 			puts "  $b:$pc: $q"
 		    }
+		    lset bbcontent $b $pc {nop {}}
 		    my removeUse $from $b
 		    my replaceUses $to $from
 		    dict unset udchain $to
 		    set changed 1
 		    continue;	# delete the quad
 
-		} elseif {[lindex $to 0] eq "var"
-			  && [lindex $from 0] eq "temp"
-			  && $outpc >= 0
-			  && [lindex $bbcontent $b $outpc 1] eq $from
-			  && [lindex $bbcontent $b $outpc 0] ne "phi"
-			  && [my hasUniqueUse $from]} {
+		}
+
+		# Can a copy to a var from a temp be promoted?
+		# It may be promoted if the temp is created in the same
+		# basic block as the copy. Promoting it will cause uses
+		# of the temp to be replaced by the variable, so we
+		# will see no further copies from the temp to any
+		# other var.
+
+		if {[lindex $to 0] eq "var"
+		    && [lindex $from 0] eq "temp"
+		    && [dict get $udchain $from] == $b} {
+		    
+		    lassign [my findDef $from] - frompc -
 
 		    # unique use of a temporary copies it to a variable
 		    # immediately following creating it. Peephole optimize
 		    # by coalescing the two quads.
 		    my debug-copyprop {
 			puts "Peephole-optimize copy:"
-			puts "  $b:$outpc:\
-                                [lindex $bbcontent $b $outpc]"
+			puts "  $b:$frompc:\
+                                     [lindex $bbcontent $b $frompc]"
 			puts "  $b:$pc: $q"
 		    }
-
+		    lset bbcontent $b $pc {nop {}}
+		    
 		    # Put the variable in place of the temp. No need
 		    # to repair its du- and ud-chains, since it's not
 		    # moving from block to block
-		    lset bbcontent $b $outpc 1 $to
-
-		    # the temp is now irrelevant
-		    dict unset duchain $from
+		    lset bbcontent $b $frompc 1 $to
+		    my debug-copyprop {
+			puts "   Rewrite $b:$frompc: [lindex $bbcontent $b $frompc]"
+		    }
 		    dict unset udchain $from
+		    dict set udchain $to $b
+		    
+		    # Replace all uses of the temp with uses of the variable
+
+		    my removeUse $from $b
+		    my replaceUses $from $to
+
+		    # the temp is now irrelevant
 		    set changed 1
 		    continue;	# delete the copy
 		}
 
 	    }

Index: quadcode/dbginfo.tcl
==================================================================
--- quadcode/dbginfo.tcl
+++ quadcode/dbginfo.tcl
@@ -67,11 +67,10 @@
 		break
 	    }
 
 	}
     }
-
     return [list $sourcefile $debugLines $debugScript $debugContext]
 }
 
 # quadcode::transformer method propDebugInfo --
 #

Index: quadcode/deadcode.tcl
==================================================================
--- quadcode/deadcode.tcl
+++ quadcode/deadcode.tcl
@@ -435,11 +435,11 @@
     # uselessphis --
     #
     #	Removes dead phi operations from the basic blocks
     #
     # Results:
-    #	None.
+    #	Returns 1 if anything was removed, 0 otherwise
     #
     # Side effects:
     #	Removes code and rewrites variable references.
     #
     # Precondition:
@@ -451,22 +451,18 @@
 
     method uselessphis {} {
 	my debug-uselessphis {
 	    puts "uselessphis:"
 	    my dump-bb
-	    dict for {v def} $udchain {
-		puts "$v is defined in [dict get $udchain $v]"
-		if {[dict exists $duchain $v]} {
-		    puts "    and used in [dict keys [dict get $duchain $v]]"
-		}
-	    }
 	}
+
+	set changed 0
 
 	# Add all basic blocks to the worklist, with the entry at the end
 
 	set worklist {}
-	for {set b [expr {[llength $bbcontent]-1}]} {$b >= 0} {incr b -1} {
+	for {set b [expr {[llength $bbcontent] - 1}]} {$b > 0} {incr b -1} {
 	    lappend worklist $b
 	}
 
 	# Process blocks from the worklist
 
@@ -473,19 +469,22 @@
 	while {[llength $worklist] > 0} {
 	    set b [lindex $worklist end]
 	    set worklist [lrange $worklist[set worklist {}] 0 end-1]
 
 	    # Do not use foreach here - each iteration might see data
-	    # from the iteration befor it.
+	    # from the iteration before it.
 	    set j 0
 	    for {set i 0} {$i < [llength [lindex $bbcontent $b]]} {incr i} {
 		set q [lindex $bbcontent $b $i]
 		if {[lindex $q 0] ne "phi"} break
 
 		# Examine a phi operation for whether all its vars come
 		# from the same place
 
+		my debug-uselessphis {
+		    puts "Examine $b:$i: $q"
+		}
 		set dest [lindex $q 1]
 		set source {}
 		set dead 1
 		foreach {from var} [lrange $q 2 end] {
 		    if {$var ne $source && $var ne $dest} {
@@ -497,19 +496,31 @@
 			}
 		    }
 		}
 
 		if {$dead} {
+
+		    my debug-uselessphis {
+			puts "    The phi at $b:$i is useless"
+			puts "    dest = $dest source = $source"
+			puts "    $dest is used at [dict get $duchain $dest]"
+			puts "    $source is used at [dict get $duchain $source]"
+		    }
 
 		    # This phi is dead. Remove all its operands from
-		    # du-chains
+		    # du-chains. Also zap them in the instruction so that
+		    # 'replaceUses' won't find them
+		    set indx 1
 		    foreach {from var} [lrange $q 2 end] {
+			incr indx 2
 			my removeUse $var $b
+			lset bbcontent $b $i $indx Nothing
+			
 		    }
 
 		    # Add any blocks that use the phi's value back on the
-		    # worklist for reexamination
+		    # worklist for reexamination (USE PQ HERE?)
 		    dict for {use -} [dict get $duchain $dest] {
 			set idx [lsearch -sorted -integer -decreasing -bisect \
 				     $worklist $use]
 			if {[lindex $worklist $idx] != $use} {
 			    set worklist [linsert $worklist[set worklist {}] \
@@ -523,13 +534,21 @@
 		    # Get rid of the destination variable
 
 		    dict unset udchain $dest
 		    dict unset duchain $dest
 		    dict unset types $dest
+
+		    set changed 1
 
 		    # delete the quad
+		    
 		} else {
+
+		    my debug-uselessphis {
+			puts "The phi at $b:$j is still useful"
+		    }
+
 		    # Quad is not a dead phi, put it back in the list
 		    lset bbcontent $b $j $q
 		    incr j
 		}
 	    }
@@ -544,18 +563,13 @@
 	}
 
 	my debug-uselessphis {
 	    puts "after uselessphis:"
 	    my dump-bb
-	    dict for {v def} $udchain {
-		puts "$v is defined in [dict get $udchain $v]"
-		if {[dict exists $duchain $v]} {
-		    puts "    and used in [dict keys [dict get $duchain $v]]"
-		}
-	    }
-	}
-	return
+	}
+
+	return $changed
     }
 
     # unkillable --
     #
     #	Tests whether a quadcode instruction is unkillable

Index: quadcode/duchain.tcl
==================================================================
--- quadcode/duchain.tcl
+++ quadcode/duchain.tcl
@@ -26,10 +26,28 @@
 # 'removeUse' and 'renameUses' to do the job. A few make sufficiently
 # violent changes to the control flow that it is more effective simply
 # to discard and rebuild the relations.
 
 oo::define quadcode::transformer {
+    
+    # reset_ud_du_chains --
+    #
+    #	Resets the ud- and du-chains
+    #
+    # Results:
+    #	None.
+    #
+    # When a pass such as partial redundancy elimination runs, it
+    # renames all variables. Rather than unlinking individual variables,
+    # it simply blows the ud- and du-chains away and starts afresh.
+
+    method reset_ud_du_chains {} {
+
+	set duchain {}
+	set udchain {}
+
+    }
     
     # ud_du_chain --
     #
     #	Records ud- and du-chains for quadcode in SSA form
     #
@@ -55,12 +73,11 @@
 	my debug-duchain {
 	    puts "before duchain"
 	    my dump-bb
 	}
 
-	set duchain {}
-	set udchain {}
+	my reset_ud_du_chains
 
 	# Walk through the basic blocks, and the instructions in each block
 	set b -1
 	foreach content $bbcontent {
 	    incr b
@@ -459,36 +476,43 @@
 
     set trouble 0
     set keys1 [lsort [dict keys $udchain]]
     set keys2 [lsort [dict keys $UDchain]]
     if {$keys1 ne $keys2} {
-	puts stderr "$name: defined variables are $keys1 s/b $keys2"
+	puts stderr "[my full-name]: $name:"
+	puts stderr "    defined variables are $keys1"
+	puts stderr "                      s/b $keys2"
 	set trouble 1
     }
     foreach v $keys1 {
 	if {[dict exists $UDchain $v]
 	    && [dict get $UDchain $v] ne [dict get $udchain $v]} {
-	    puts stderr "$name: $v ud-chain is [dict get $udchain $v] \
-                                s/b [dict get $UDchain $v]"
+	    puts stderr "[my full-name]: $name: $v:"
+	    puts stderr "    ud-chain is [dict get $udchain $v]"
+	    puts stderr "            s/b [dict get $UDchain $v]"
 	    set trouble 1
 	}
     }
 
     set keys1 [lsort [dict keys $duchain]]
     set keys2 [lsort [dict keys $DUchain]]
     if {$keys1 ne $keys2} {
-	puts stderr "$name: used variables are $keys1 s/b $keys2"
+	puts stderr "[my full-name]: $name:"
+	puts stderr "    used variables are $keys1"
+	puts stderr "                   s/b $keys2"
 	set trouble 1
     }
 	
     foreach v $keys1 {
 	set chain1 [lsort -integer -stride 2 -index 0 [dict get $duchain $v]]
 	if {[dict exists $DUchain $v]} {
 	    set chain2 \
 		[lsort -integer -stride 2 -index 0 [dict get $DUchain $v]]
 	    if {$chain1 ne $chain2} {
-		puts stderr "$name: $v du-chain is $chain1 s/b $chain2"
+		puts stderr "[my full-name]: $name: $v:"
+		puts stderr "    du-chain is $chain1"
+		puts stderr "            s/b $chain2"
 		set trouble 1
 	    }
 	}
     }
 

Index: quadcode/heap.tcl
==================================================================
--- quadcode/heap.tcl
+++ quadcode/heap.tcl
@@ -138,10 +138,161 @@
 		}
 
 		# If y is less than the smaller child, then i is a suitable
 		# place to insert y
 		if {[$y < $xj]} break
+
+		# Place the smaller child at entry i, moving the gap to
+		# entry j.
+		lset content $i $xj
+		set i $j
+	    }
+
+	    # Reinsert y into the heap, and return z.
+	    lset content $i $y
+	}
+
+	return $z
+    }
+
+    # size --
+    #
+    #	Determines the length of the queue
+    #
+    # Results:
+    #	Returns the queue length
+
+    method size {} {
+	llength $content
+    }
+}
+
+# quadcode::numheap --
+#
+#	Heap object used for managing priority queues of simple numbers
+
+oo::class create ::quadcode::numheap {
+
+    # Instance variables:
+    #
+    #	content - List of objects, organized as a binary heap.
+
+    variable content
+
+    # Constructor
+    #
+    #	Heap is initailly empty
+
+    constructor {} {
+	set content {}
+    }
+
+    # add --
+    #
+    #	Adds an object to the heap.
+    #
+    # Parameters:
+    #	y - Object to add
+    #
+    # Results:
+    #	None
+    #
+    # Side effects:
+    #	Queue content is altered.
+
+    method add {y} {
+
+	# Add a slot to the end of the worklist
+	set i [llength $content]
+	lappend content {}
+
+	# Sift up entries in the heap until we find the insertion point
+	while {$i > 0} {
+	    set j [expr {($i - 1) / 2}]
+	    set xj [lindex $content $j]
+	    if {$xj < $y} break
+	    lset content $i $xj
+	    set i $j
+	}
+
+	# Insert the new item at the insertion point
+	lset content $i $y
+
+	return
+    }
+
+    # empty --
+    #
+    #	Tests whether the queue is empty
+    #
+    # Results:
+    #	Returns 0 if the queue is nonempty, 1 if it is empty
+
+    method empty {} {
+	expr {[my size] == 0}
+    }
+
+    # first --
+    #
+    #	Inspects the object at the head of the queue
+    #
+    # Results:
+    #	Returns the object without altering the queue
+    #	Returns the empty string if the queue is empty
+
+    method first {} {
+	if {[llength $content] == 0} {
+	    return {}
+	} else {
+	    return [lindex $content 0]
+	}
+    }
+
+    # removeFirst --
+    #
+    #	Removes the first object from the queue, and returns it.
+    #
+    # Results:
+    #	Returns the removed object. Returns the empty string if the
+    #	queue is empty.
+    #
+    # Side effects:
+    #	Queue content is altered.
+
+    method removeFirst {} {
+	if {[llength $content] == 0} {
+	    return {}
+	}
+
+	# Set aside the return value. Let i be the index of the gap in the heap
+	set z [lindex $content 0]
+	set i 0
+
+	# Remove the last element, y, from the heap
+	set y [lindex $content end]
+	set content [lrange $content 0 end-1]
+	if {[llength $content] > 0} {
+
+	    # Sift the elements in the heap upward, finding a place
+	    # where y can be reinserted
+	    while {1} {
+		# Find the smaller of element i's two children
+		set j [expr {2*$i + 1}]
+		if {$j >= [llength $content]} break
+		set xj [lindex $content $j]
+		set jp1 [expr {$j + 1}]
+		if {$jp1 < [llength $content]} {
+		    set xjp1 [lindex $content $jp1]
+		    if {$xjp1 < $xj} {
+			set j $jp1
+			set xj $xjp1
+		    }
+		}
+
+		# If y is less than the smaller child, then i is a suitable
+		# place to insert y
+		if {$y < $xj} break
 
 		# Place the smaller child at entry i, moving the gap to
 		# entry j.
 		lset content $i $xj
 		set i $j

Index: quadcode/inline.tcl
==================================================================
--- quadcode/inline.tcl
+++ quadcode/inline.tcl
@@ -92,10 +92,14 @@
 
     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
@@ -159,10 +163,14 @@
 	    # 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.
@@ -171,10 +179,15 @@
 
 	    break
 	}
     }
     
+    my debug-audit {
+	my audit-duchain "exit from expandInlines"
+	my audit-phis "exit from expandInlines"
+    }
+
     return $didSomething
     
 }
 
 # quadcode::transformer method expandOneInline --
@@ -274,11 +287,11 @@
 	puts "inline: [llength $xbbcontent] blocks added with inlined code"
     }
     
     # Unlink variables used in the 'invoke'
 
-    foreach {- v} [lrange $q 2 end] {
+    foreach v [lrange $q 2 end] {
 	if {[lindex $v 0] in {"var" "temp"}} {
 	    my removeUse $v $b
 	}
     }
     my debug-inline {

ADDED   quadcode/loopinv.tcl
Index: quadcode/loopinv.tcl
==================================================================
--- quadcode/loopinv.tcl
+++ quadcode/loopinv.tcl
@@ -0,0 +1,436 @@
+# loopinv.tcl --
+#
+#	Methods that perform loop inversion on quadcode
+#
+# Copyright (c) 2018 by Kevin B. Kenny
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+#------------------------------------------------------------------------------
+
+# quadcode::transformer method loopinv --
+#
+#	Performs loop inversion on a quadcode sequence.
+#
+# Results:
+#	None.
+#
+# This pass happens very early in the translation. It must come before
+# SSA creation, but after the peephole optimization for jumps.
+#
+# The idea of this method is to make sure that every loop is executed
+# at least once, by surrounding it with a guard on the loop condition,
+# Thus, a loop such as:
+#	while ($x) {
+#	    do something
+#	}
+# would be replaced with
+#	if ($x) {
+#           do {
+#		do something
+#	    } while ($x)
+#       }
+#
+# Without this transformation, loop-invariant code motion is impossible,
+# because no calculations are loop-invariant (because they may not be
+# calculated at all if the loop is executed zero times). Moreover, this
+# unwrapping gives a head start on jump threading/path splitting, because
+# many of the tests that need to be threaded are the ones in the loop
+# condition, and these will be split in advance with this transformation.
+#
+# The way that the method operates is that it calculates the dominance
+# relation and level numbering of the basic blocks. It then walks
+# through basic blocks in depth-first order, looking for flowgraph
+# edges whose destinations dominate their origins (back edges).  It
+# groups back edges by destination.
+#
+# The natural loops are then processed in reverse order by destination
+# so that inner loops will be handled first.  For each natural loop,
+# let the common destination of the back edges be called the head node
+# of the loop and be denoted H.
+#
+# A connected component is assembled by marking H 'visited' and then
+# walking from the source nodess of the back edges to all their
+# predecessors until a visited node is reached. (Since the loop head
+# dominates all these nodes, all these walks must terminate there, if
+# not before. Call this set of nodes A.
+#
+# A second walk is then done, from all nodes in A that have successors
+# outside A.  Successors that begin with 'initException' are ignored,
+# because they are likely not normal loop exits. If there is no successor,
+# that makes a normal exit, the loop is an infinite loop
+# and is left unchanged.  Once again, H is marked 'visited' and the
+# walk proceeds from nodes to their predecessors until a visited node
+# is reached. Call all the visited nodes in this set B, and let the
+# set C = A - B.
+#
+# If the set C is empty, there is nothing to be gained in this
+# optimization and we move to the next loop, Otherwise, we do the
+# following:
+#
+# For each node in B, we create a copy B'.
+#
+# All the jumps in C that go to the head node H are replaced by jumps to
+# H', the copy H in B'.
+#
+# Every jump from a basic block P' in {B' U C} to a basic block Q in B
+# is replaced with a jump to the copy, Q', in B'.
+#
+# The result is that when control passes to the loop head, it continues
+# in the original set B until it reaches the loop body C. At that point,
+# B will never be reached again. Code running in the loop body C will
+# go to the copy of the loop header (conceptually, the bottom of the
+# 'do' loop in the example), from which the original loop header
+# (the 'if' part in the example) is unreachable.
+#
+# If any jump in B' is the back edge of an outer loop, it is added
+# to the list of edges for that loop header, which must precede this
+# loop in depth-first order.
+#
+# This rewriting spoils the dominance relations, but we don't care; once
+# the back edges have been identified, dominators are not used. The rewriting
+# also introduces new critical edges, so critical edges must be split again
+# after it's completed for all loops. (We do not introduce any new code
+# on edges, so critical edges are not a concern when this pass is running.)
+# For this reason, we resplit critical edges at the end of this pass,
+# and the 'ssa' pass must rerun 'bbidom' and 'bblevel' before it begins
+# constructing SSA form.
+
+oo::define quadcode::transformer method loopinv {} {
+
+    my debug-loopinv {
+	puts "Perform loop inversion:"
+	my dump-bb
+    }
+
+    # Calculate dominance relations
+
+    my bbidom
+    my bblevel
+
+    # Find the loop headers, and enumerate the nodes that close the loops.
+
+    set loops [my loopinv_loops]
+
+    my debug-loopinv {
+	puts "Head\tBack edges"
+	puts "----\t----------"
+	foreach {H back} [lsort -integer -stride 2 -index 0 $loops] {
+	    puts "$H\t[lsort -integer [dict keys $back]]"
+	}
+    }
+    
+    # Invert each loop in turn. Be careful here with value management
+    # because inverting one loop may add back edges to an earlier loop
+
+    foreach H [lsort -integer -decreasing [dict keys $loops]] {
+
+	set backedges [dict get $loops $H]
+	my loopinv_invert $H $backedges $loops
+
+    }
+
+    my debug-loopinv {
+	puts "Finished loop inversion:"
+	my dump-bb
+    }
+
+
+    # Resplit critical edges
+
+    my splitCritical
+    my sortbb
+
+}
+
+# quadcode::transformer method loopinv_loops --
+#
+#	Identifies the natural loops in a quadcode sequence
+#
+# Results:
+#
+#	Returns a dictionary whose keys are the basic block numbers
+#	of the head nodes of the loops, and whose values are second-level
+#	dictionaries. In these dictionaries the keys are the basic
+#	block numbers of blocks that jump back to the head node, and
+#	the values are immaterial.
+
+oo::define quadcode::transformer method loopinv_loops {} {
+
+    set loops {}
+
+    # Iterate over basic blocks
+
+    set b -1
+    foreach bb $bbcontent {
+	incr b
+
+	# Find the successor nodes of the current block, and
+	# list as a back edge any jump to a dominating node.
+
+	foreach s [my bbsucc $b] {
+	    if {[my dom $s $b]} {
+		dict set loops $s $b $s
+	    }
+	}
+    }
+
+    return $loops
+
+}
+
+# quadcode::transformer method loopinv_invert --
+#
+#	Inverts one loop in a quadcode sequence
+#
+# Parameters:
+#	H - Head node of the loop being inverted
+#	backedges - Back edges that participate in the loop, expressed
+#	            as a dictionary whose keys are the target nodes and
+#		    whose values are dictionaries, whose keys in turn are
+#	            the nodes that jump to them and whose values are
+#	            immaterial
+#	loops - Set of all loops in the sequence, expressed as
+#	        a dictionary whose keys are the head nodes and whose values
+#	        are corresponding values of 'backedges'.
+#
+# Results:
+#	None.
+#
+# Side effects:
+#	The blocks that form the loop header are duplicated, and the
+#	duplicates are relinked according to the rules stated in the comments
+#	for the 'loopinv' method.
+
+oo::define quadcode::transformer method loopinv_invert {H backedges loops} {
+
+    # Identify all the loop nodes by walking up to their predecessors
+    set loopnodes [dict create $H {}]
+    dict for {N -} $backedges {
+	my loopinv_visit1 loopnodes $N
+    }
+    my debug-loopinv {
+	puts "Nodes in loop with header $H: \
+              [lsort -integer [dict keys $loopnodes]]"
+    }
+
+    # Identify the nodes in the loop that jump out of the loop.
+    set jumpouts [my loopinv_jumpouts $loopnodes]
+    my debug-loopinv {
+	puts "Nodes that jump out of the loop: \
+	      [lsort -integer $jumpouts]"
+    }
+    if {[llength $jumpouts] == 0} {
+	return
+    }
+
+    # Partition the loop prelude from the rest of the loop
+
+    set headnodes [dict create $H {}]
+    foreach N $jumpouts {
+	my loopinv_visit1 headnodes $N
+    }
+    set bodynodes $loopnodes
+    dict for {N -} $headnodes {
+	dict unset bodynodes $N
+    }
+    my debug-loopinv {
+	puts "Nodes in the loop prelude: \
+              [lsort -integer [dict keys $headnodes]]"
+	puts "Nodes in the loop body: \
+              [lsort -integer [dict keys $bodynodes]]"
+    }
+
+    # Make copies of the header nodes in the loop
+
+    my loopinv_dupheader headnodes
+
+    # For all nodes in the duplicate header, reroute jumps inside the header
+    # to refer to the duplicate. Also, if there are back edges from the header
+    # to an outer loop, add the copies of the back edges to 'backedges'
+
+    my loopinv_reroutejumps $headnodes loops [dict values $headnodes]
+
+    # For all nodes in the loop body, reroute jumps back to the header so
+    # that they target the duplicate instead. There cannot be back edges
+    # here, but it's harmless to check for them
+
+    my loopinv_reroutejumps $headnodes loops [dict keys $bodynodes]
+
+    # TODO - If loop peeling is to be done, to separate the problematic
+    #        first iteration of a loop (which does all the typechecking)
+    #        from the loop body, this would be the place to do it.
+    
+}
+
+# quadcode::transformer method loopinv_visit1 --
+#
+#	Visit a node that is a possible member of a loop when
+#	enumerating the complete set of loop members.
+#
+# Parameters:
+#	loopnodesVar - Name of a variable in caller's scope holding the
+#	               dictionary of already-identified loop members
+#	N - Basic block number of a possible loop member
+#
+# Results:
+#	None.
+#
+# Side effects:
+#	If the node has not yet been seen, adds it to the loop members,
+#	and visits its predecessors.
+
+oo::define quadcode::transformer method loopinv_visit1 {loopnodesVar N} {
+    upvar 1 $loopnodesVar loopnodes
+    if {![dict exists $loopnodes $N]} {
+	dict set loopnodes $N {}
+	dict for {P -} [lindex $bbpred $N] {
+	    my loopinv_visit1 loopnodes $P
+	}
+    }
+}
+
+# quadcode::transformer method loopinv_jumpouts --
+#
+#	Identify the nodes in a loop that jump out of the loop.
+#
+# Parameters:
+#	loopnodes - Dictionary whose keys are the nodes in the loop.
+#
+# Results:
+#	Returns a list of the nodes that jump out.
+
+oo::define quadcode::transformer method loopinv_jumpouts {loopnodes} {
+    set jumpouts {}
+    dict for {N -} $loopnodes {
+	foreach S [my bbsucc $N] {
+	    if {![dict exists $loopnodes $S]
+		&& [lindex $bbcontent $N end-1 0 0] ne "jumpMaybe"
+		&& ![my loopinv_initsException $S]} {
+		lappend jumpouts $N
+		continue
+	    }
+	}
+    }
+    return $jumpouts
+}
+
+# quadcode::transformer method loopinv_initsException --
+#
+#	Tests whether a basic block contains 'initException'
+#	or some variant thereof.
+#
+# Parameters:
+#	b - Basic block index
+#
+# Results:
+#	Returns 1 if such an instruction is found, 0 otherwise.
+
+oo::define quadcode::transformer method loopinv_initsException {b} {
+    foreach q [lindex $bbcontent $b] {
+	if {[lindex $q 0 0] in {"initException" "initParamTypeException"}} {
+	    return 1
+	}
+    }
+    return 0
+}
+
+# quadcode::transformer method loopinv_dupheader --
+#
+#	Duplicates the header of a loop in order to perform
+#	loop inversion on it.
+#
+# Parameters:
+#	headnodesVar - Dictionary whose keys are the basic block numbers of
+#	               the loop header nodes and whose values are immaterial
+#
+# Results:
+#	None.
+#
+# Side effects:
+#	The dictionary in 'headnodesVar' is altered so that its values
+#	are the basic block numbers of the copied nodes.
+#
+# Performing this operation keeps 'bbpred' and 'bbsucc' usable, but
+# spoils the dominance hierarchy ('bbidom', 'bblevel', 'bbkids'), and
+# the depth-first numbering of basic blocks, which must both be reconstructed
+# after this pass runs.
+
+oo::define quadcode::transformer method loopinv_dupheader {headnodesVar} {
+    upvar 1 $headnodesVar headnodes
+    dict for {N -} $headnodes {
+	dict set headnodes $N [my bbcopy $N]
+	my debug-loopinv {
+	    puts "Copied basic block $N to [dict get $headnodes $N]"
+	    puts "There are now [llength $bbcontent] blocks"
+	}
+    }
+}
+
+# quadcode::transformer method loopinv_reroutejumps --
+#
+#	Reroutes jumps in a loop so that jumps to the loop header refer
+#	to a duplicate of the header and not to the original header.
+#	Also detects jumps that are back edges to outer loops and
+#	adds the copies to the 'backedges' dictionary for further
+#	processing.
+#
+# Parameters:
+#	headnodes - Dictionary whose keys are the basic block numbers of
+#	            nodes in the loop header and whose values are
+#	            the basic block numbers of copies of the nodes.
+#	backedges - Two-level dictionary. First level keys are the head
+#	            nodes of loops and second level keys are the nodes
+#	            that jump to them.
+#	ns - List of basic block numbers whose jumps are to be rerouted.
+#
+# Results:
+#	None.
+#
+# Side effects:
+#	Jumps are rewritten and the basic blocks are relinked.
+#
+# Performing this operation keeps 'bbpred' and 'bbsucc' usable, but
+# spoils the dominance hierarchy ('bbidom', 'bblevel', 'bbkids'), and
+# the depth-first numbering of basic blocks, which must both be reconstructed
+# after this pass runs.
+
+oo::define quadcode::transformer method loopinv_reroutejumps {headnodes
+							      backedgesVar
+							      ns} {
+
+    upvar 1 $backedgesVar backedges
+
+    # Walk through the nodes that must be altered
+
+    foreach b $ns {
+	set bb [lindex $bbcontent $b]
+	lset bbcontent $b {}
+	for {set pc [expr {max(0, [llength $bb] - 2)}]} \
+	    {$pc < [llength $bb]} \
+	    {incr pc} {
+		set q [lindex $bb $pc]
+		if {[lindex $q 1 0] eq "bb"} {
+		    set target [lindex $bb $pc 1 1]
+		    if {[dict exists $headnodes $target]} {
+			my removePred $target $b
+			set newtarget [dict get $headnodes $target]
+			lset bb $pc 1 1 $newtarget
+			my bblink $b $newtarget
+			my debug-loopinv {
+			    puts "Redirected jump at $b:$pc:$q\
+                                  to proceed to $newtarget"
+			}
+		    } elseif {[dict exists $backedges $target]} {
+			my debug-loopinv {
+			    puts "Jump at $b:$pc:$q becomes a back edge"
+			    puts "Previous edges: [dict get $backedges $target]"
+			}
+			dict set backedges $target $b {}
+		    }
+		}
+	    }
+	lset bbcontent $b $bb
+    }
+}

Index: quadcode/narrow.tcl
==================================================================
--- quadcode/narrow.tcl
+++ quadcode/narrow.tcl
@@ -191,13 +191,12 @@
 #	spoilt data type analysis, 0 if the analysis is still stable.
 #
 # This procedure does not depend on having dominance information.
 # It is expected to make wholesale changes to the flow graph, so it
 # also does not attempt to maintain dominance information. Instead, it
-# expects that deadcode, deadvars, uselessphis, bbidom, bblevel,
-# udchain and duchain will be run after it is done to reconstruct the
-# structure.
+# expects that deadcode, deadvars, uselessphis, bbidom, and bblevel
+# will be run after it is done to reconstruct the structure.
 
 oo::define quadcode::transformer method cleanupNarrow {} {
 
     namespace upvar ::quadcode::dataType IMPURE IMPURE ARRAY ARRAY \
 	NEXIST NEXIST STRING STRING FOREACH FOREACH DICTITER DICTITER
@@ -221,14 +220,13 @@
     # It is tempting to use a 'foreach' loop, but we want always to be
     # working on the current instance of each basic block, since
     # basic blocks remote from the current block will be rewritten as
     # instructions are removed.
 
+    set changed 0
     for {set b 0} {$b < [llength $bbcontent]} {incr b} {
 
-	set changed 0
-
 	set newpc 0
 	for {set pc 0} {$pc < [llength [lindex $bbcontent $b]]} {incr pc} {
 	    set q [lindex $bbcontent $b $pc]
 
 	    switch -exact [lindex $q 0 0] {
@@ -255,12 +253,13 @@
 		    }
 		    if {[info exists replacer]} {
 			my debug-cleanupNarrow {
 			    puts "$b:$pc: Able to remove $q because $source is\
 			          [quadcode::nameOfType $inputType]\
-				  and hence result is $result"
+				  and hence result is $replacer"
 			}
+			lset bbcontent $b $pc {nop {}}
 			my removeUse $source $b
 			my replaceUses $result $replacer
 			dict unset udchain $result
 			set changed 1
 			continue; # delete the quad
@@ -271,17 +270,19 @@
 		    set result [lindex $q 1]
 		    set source [lindex $q 2]
 		    set flag [quadcode::dataType::existence $types $source]
 		    switch -exact -- $flag {
 			"yes" {
+			    lset bbcontent $b $pc {nop {}}
 			    my removeUse $source $b
 			    my replaceUses $result {literal 1}
 			    dict unset udchain $result
 			    set changed 1
 			    continue; # delete the quad
 			}
 			"no" {
+			    lset bbcontent $b $pc {nop {}}
 			    my removeUse $source $b
 			    my replaceUses $result {literal 0}
 			    dict unset udchain $result
 			    set changed 1
 			    continue; # delete the quad
@@ -293,10 +294,11 @@
 		    set result [lindex $q 1]
 		    set source [lindex $q 2]
 		    set inputType [quadcode::typeOfOperand $types $source]
 		    set flag [quadcode::dataType::existence $types $source]
 		    if {$flag eq "no" || (!($inputType & $NONARRAY) && ($inputType & $ARRAY))} {
+			lset bbcontent $b $pc {nop {}}
 			my removeUse $source $b
 			my replaceUses $result $source
 			dict unset udchain $result
 			set changed 1
 			continue; # delete the quad
@@ -307,10 +309,11 @@
 		    set result [lindex $q 1]
 		    set source [lindex $q 2]
 		    set flag [quadcode::dataType::existence $types $source]
 		    switch -exact -- $flag {
 			"yes" {
+			    lset bbcontent $b $pc {nop {}}
 			    my removeUse $source $b
 			    my replaceUses $result $source
 			    dict unset udchain $result
 			    set changed 1
 			    continue; #delete the quad
@@ -326,10 +329,11 @@
 			"no" { # unconditional failure - this is a FAIL already
 			    my debug-cleanupNarrow {
 				puts "$b:$pc: delete $q"
 				puts "$b:$pc: replace $result with $source"
 			    }
+			    lset bbcontent $b $pc {nop {}}
 			    my removeUse $source $b
 			    my replaceUses $result $source
 			    dict unset udchain $result
 			    set changed 1
 			    continue; # delete the quad
@@ -345,10 +349,11 @@
 			"yes" { # unconditional success - this isn't a FAIL
 			    my debug-cleanupNarrow {
 				puts "$b:$pc: delete $q"
 				puts "$b:$pc: replace $result with $source"
 			    }
+			    lset bbcontent $b $pc {nop {}}
 			    my removeUse $source $b
 			    my replaceUses $result $source
 			    dict unset udchain $result
 			    set changed 1
 			    continue; # delete the quad
@@ -360,10 +365,11 @@
 		    set result [lindex $q 1]
 		    set source [lindex $q 2]
 		    set inputType [quadcode::typeOfOperand $types $source]
 		    set flag [quadcode::dataType::existence $types $source]
 		    if {$flag eq "no" || (!($inputType & $ARRAY) && ($inputType & $NONARRAY))} {
+			lset bbcontent $b $pc {nop {}}
 			my removeUse $source $b
 			my replaceUses $result $source
 			dict unset udchain $result
 			set changed 1
 			continue; # delete the quad
@@ -375,18 +381,22 @@
 		    set source [lindex $q 2]
 		    set default [lindex $q 3]
 		    set flag [quadcode::dataType::existence $types $source]
 		    switch -exact -- $flag {
 			"yes" {
+			    lset bbcontent $b $pc {nop {}}
+			    my removeUse $source $b
 			    my removeUse $default $b
 			    my replaceUses $result $source
 			    dict unset udchain $result
 			    set changed 1
 			    continue; # delete the quad
 			}
 			"no" {
+			    lset bbcontent $b $pc {nop {}}
 			    my removeUse $source $b
+			    my removeUse $default $b
 			    my replaceUses $result $default
 			    dict unset udchain $result
 			    set changed 1
 			    continue; # delete the quad
 			}
@@ -394,22 +404,23 @@
 		}
 
 		initArrayIfNotExists {
 		    set result [lindex $q 1]
 		    set source [lindex $q 2]
-		    set default [lindex $q 3]
 		    set flag [quadcode::dataType::existence $types $source]
 		    switch -exact -- $flag {
 			"yes" {
-			    my removeUse $default $b
+			    lset bbcontent $b $pc {nop {}}
+			    my removeUse $source $b
 			    my replaceUses $result $source
 			    dict unset udchain $result
 			    set changed 1
 			    continue; # delete the quad
 			}
 			"no" {
 			    set q [list initArray $result]
+			    my removeUse $source $b
 			    set changed 1
 			}
 		    }
 		}
 
@@ -422,16 +433,18 @@
 				$typecode]
 		    set maybe [quadcode::dataType::mightbea \
 				   [quadcode::typeOfOperand $types $source] \
 				   $typecode]
 		    if {$is} {
+			lset bbcontent $b $pc {nop {}}
 			my removeUse $source $b
 			my replaceUses $result {literal 1}
 			dict unset udchain $result
 			set changed 1
 			continue; # delete the quad
 		    } elseif {!$maybe} {
+			lset bbcontent $b $pc {nop {}}
 			my removeUse $source $b
 			my replaceUses $result {literal 0}
 			dict unset udchain $result
 			set changed 1
 			continue; # delete the quad
@@ -514,10 +527,11 @@
 		    set typecode [lindex $q 0 1]
 		    set is [quadcode::dataType::isa \
 				[quadcode::typeOfOperand $types $source] \
 				$typecode]
 		    if {$is} {
+			lset bbcontent $b $pc {nop {}}
 			my removeUse $source $b
 			my replaceUses $result $source
 			dict unset udchain $result
 			set changed 1
 			continue; # delete the quad
@@ -527,10 +541,11 @@
 		purify {
 		    set result [lindex $q 1]
 		    set source [lindex $q 2]
 		    set inputType [quadcode::typeOfOperand $types $source]
 		    if {!($inputType & $IMPURE)} {
+			lset bbcontent $b $pc {nop {}}
 			my removeUse $source $b
 			my replaceUses $result $source
 			dict unset udchain $result
 			set changed 1
 			continue; # delete the quad
@@ -548,10 +563,11 @@
 
 			    my debug-cleanupNarrow {
 				puts "$b:$pc: delete $q"
 				puts "$b:$pc replace result with $source"
 			    }
+			    lset bbcontent $b $pc {nop {}}
 			    my removeUse $source $b
 			    my replaceUses $result $source
 			    dict unset udchain $result
 			    set changed 1
 			    continue; # delete the quad
@@ -567,10 +583,11 @@
 			"yes" { # unconditional success - return code must be 0
 			    my debug-cleanupNarrow {
 				puts "$b:$pc: delete $q"
 				puts "$b:$pc: replace result with {literal 0}"
 			    }
+			    lset bbcontent $b $pc {nop {}}
 			    my removeUse $source $b
 			    my replaceUses $result {literal 0}
 			    dict unset udchain $result
 			    set changed 1
 			    continue; # delete the quad
@@ -586,10 +603,11 @@
 			my debug-cleanupNarrow {
 			    puts "$b:$pc: delete $q"
 			    puts "$b:$pc: replace $result with\
                                           '-code 0 -level 0'"
 			}
+			lset bbcontent $b $pc {nop {}}
 			my removeUse $source $b
 			my replaceUses $result \
 			    {literal {-code 0 -level 0}}
 			dict unset udchain $result
 			set changed 1

Index: quadcode/nodesplit.tcl
==================================================================
--- quadcode/nodesplit.tcl
+++ quadcode/nodesplit.tcl
@@ -531,11 +531,14 @@
 		my ns_cloneBB $splitb
 		my debug-nodesplit {
 		    puts "After splitting:"
 		    my dump-bb
 		}
-		my audit-phis "one split"
+		my debug-audit {
+		    my audit-duchain "nodesplit"
+		    my audit-phis "nodesplit"
+		}
 		return 1
 	    }
 	}
     }
 

ADDED   quadcode/pre.tcl
Index: quadcode/pre.tcl
==================================================================
--- quadcode/pre.tcl
+++ quadcode/pre.tcl
@@ -0,0 +1,1510 @@
+# pre.tcl --
+#
+#	Methods that do Partial Redundancy Elimination in quadcode
+#
+# Copyright (c) 2018 by Kevin B. Kenny
+#
+# See the file "license.terms" for information on usage and
+# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+#-------------------------------------------------------------------------
+
+# The algorithms in this file are composed from multiple sources.
+# The basic idea behind this optimization is that quadcode results are
+# partitioned into a set of equivalence classes, corresponding with
+# the values that they compute. Variables in the same class are known
+# to be equal, and so code that computes them can be removed if the values
+# are already available; loop-invariant values can be hoisted out of the
+# corresponding loops, and so on.
+#
+# Sources of particular note include:
+#
+# [Chow97] Chow, Fred, Sun Chan, Robert Kennedy, Shin-Ming Liu,
+# Raymond Lu, and Peng Tu. "A new algorithm for partial redundancy
+# elimination based on SSA form. Proc. ACM SIGPLAN 1997 Conf. on Programming
+# Language Design and Implementation (PLDI '97), Las Vegas, Nevada,
+# 1997, pp. 273-286. https://dl.acm.org/citation.cfm?id=258940
+#
+# [Dres93] Drechsler, Karl-Heinz, and Manfred P. Stadel. "A variation of
+# Knoop, Rüthing and Steffen's _Lazy Code Motion._ _SIGPLAN Notices_ 28:5
+# (May, 1993), pp. 29-38. https://dl.acm.org/citation.cfm?id=152823
+#
+# [MoRe76] Morel, Étienne, and Claude Renvoise. "Global optimization
+# by suppression of partial redundancies." Proc. 2d Intl. Symp. on
+# Programming, Paris, April 1976, pp. 147-159. (A more accessible but
+# less detailed reference is [MoRe79].)
+# https://dl.acm.org/citation.cfm?id=359069
+#
+# [MoRe79] Morel, Étienne, and Claude Renvoise. "Global optimization
+# by suppression of partial redundancies." Communications of the ACM 22:2
+# (February, 1979), pp. 96-103.
+# 
+# [Simp96] Simpson, Loren Taylor. "Value-driven redundancy elimination."
+# PhD thesis, Rice University, Houston, Texas (April 1996)
+# https://www.clear.rice.edu/comp512/Lectures/Papers/SimpsonThesis.pdf
+#
+# [VaHo03] VanDrunen, Thomas J. and Antony L. Hosking. "Corner cases in
+# value-based partial redundancy elimination." CSD Technical Report 03-032,
+# Purdue University, West Lafayette, Indiana (November, 2003)
+# https://cs.wheaton.edu/~tvandrun/writings/tech03032.ps
+#
+# [VanD04] VanDrunen, Thomas J. "Partial redundancy elimination for
+# global value numbering." PhD thesis, Purdue University, West
+# Lafayette, Indiana  (August, 2004)
+# ftp://ftp.cs.purdue.edu/pub/hosking/papers/vandrunen.pdf
+
+
+namespace eval quadcode {
+
+    variable gvn_eliminable
+    proc _init {} {
+	variable gvn_eliminable {}
+	foreach opcode {
+	    add
+	    arrayExists arrayElementExists arrayGet arraySet arrayUnset
+	    bitand bitnot bitor bitxor
+	    concat
+	    dictAppend dictExists dictGet dictGetOrNexist
+	    dictLappend dictSet dictSetOrUnset dictSize dictUnset
+	    div
+	    eq expand exists expon extractArray extractCallFrame extractExists
+	    extractFail extractMaybe extractScalar
+	    frameArgs frameDepth
+	    ge gt
+	    initIfNotExists
+	    instanceOf isBoolean
+	    le
+	    listAppend listConcat listIn listIndex listLength listRange
+	    listSet
+	    lshift lt
+	    maptoint mod moveFromCallFrame mult
+	    narrowToType neq not
+	    purify
+	    regexp retrieveResult rshift
+	    strcase strcat strclass strcmp streq strfind strindex strlen
+	    strmap strmatch strrange strreplace strrfind strtrim
+	    sub
+	    uminus
+	    verifyList
+	    widenTo
+	} {
+	    dict set gvn_eliminable $opcode {}
+	}
+    }
+    _init
+    rename _init {}
+}
+
+# quadcode::transformer method partialredundancy --
+#
+#	Performs partial redundancy elimination on a quadcode sequence.
+#
+# Results:
+#	Returns 1 if modifications were made, 0 if the method
+#	accomplished nothing.
+#
+# Side effects:
+#	Redundant calculations are removed.
+#
+# The removal of redundant calculations may expose additional
+# opportunities for optimization. In particular, it is possible that
+# phi operations will have become worthless, either because two such
+# operations become the same operation, or because all inputs to a phi
+# become the same input. It may be necessary to repeat this
+# optimization after cleaning up useless phi's.
+
+oo::define quadcode::transformer method partialredundancy {} {
+
+    variable ::quadcode::pre_iteration
+    #puts "[my full-name] attempt [incr pre_iteration]"
+
+    my debug-pre {
+	puts "Before partial redundancy elimination:"
+	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).
+
+    my pre_buildsets1
+
+    if {[catch {
+	my audit-duchain pre-1
+	my audit-phis pre-1
+    } trouble opts]} {
+	puts stderr "TROUBLE: $trouble"
+	return -options ${opts} $trouble
+    }
+
+    # 2. Perform a traversal of the basic blocks in the retrograde direction
+    #    (ensuring that a block's postdominators are processed before the
+    #    block itself). Compute the anticipability of expressions in the
+    #    blocks (ANTIC_IN).
+
+    my pre_buildsets2
+
+    my debug-pre {
+	my variable pre_antic_in
+	puts "Anticipable values:"
+	set b -1
+	foreach d $pre_antic_in {
+	    puts "   block [incr b]: [dict keys $d]"
+	}
+    }
+
+    if {[catch {
+	my audit-duchain pre-2
+	my audit-phis pre-2
+    } trouble opts]} {
+	puts stderr "TROUBLE: $trouble"
+	return -options ${opts} $trouble
+    }
+
+    # 3. Perform code motion by inserting evaluations and phis at
+    #    merge points.
+
+    if {[catch {
+	my audit-duchain pre-3
+	my audit-phis pre-3
+    } trouble opts]} {
+	puts stderr "TROUBLE: $trouble"
+	return -options ${opts} $trouble
+    }
+    set did_something [my pre_insert]
+
+    # 4. Rewrite the program to replace calculations of available values
+    #    with copies from the temps that hold the values
+
+    if {[catch {
+	my audit-duchain pre-4
+	my audit-phis pre-4
+    } trouble opts]} {
+	puts stderr "TROUBLE: $trouble"
+	return -options ${opts} $trouble
+    }
+    if {[my pre_eliminate]} {
+	set did_something 1
+    }
+
+    # 5. If we inserted any phis speculatively, and we didn't use any of them,
+    #    clean them up so that we can return 'false' for did_something and
+    #    not fight with dead code removal. Then clean up working storage
+
+    if {!$did_something} {
+	my pre_remove_speculative_phis
+    }
+    my pre_cleanup
+
+    # 6. Now, dead code elimination and copy propagation will eliminate
+    #    any messes that step 4 left behind.
+    
+    return $did_something
+
+}
+
+# quadcode::transformer method pre_init --
+#
+#	Initializes the tables for global value numbering and partial
+#	redundancy elimination
+#
+# Results:
+#	None.
+#
+# Side effects:
+#	The 'vn' table is cleared.
+
+oo::define quadcode::transformer method pre_init {} {
+
+    my variable pre_vn
+    my variable pre_vexprs
+
+    set pre_vn {}
+    set pre_vexprs {}
+
+    return
+}
+
+# quadcode::transformer method pre_buildsets1
+#
+#	Performs global value numbering and available expression analysis
+#
+# Results:
+#	None.
+#
+# Side effects:
+#	Constructs the global value numbering (pre_vn), the generated
+#	expression tables (pre_exp_gen, pre_phi_gen, pre_tmp_gen) and
+#	the available values table.
+
+oo::define quadcode::transformer method pre_buildsets1 {} {
+
+    my variable pre_exp_gen
+    my variable pre_phi_gen
+    my variable pre_tmp_gen
+    my variable pre_avail_out
+    my variable pre_speculative_phis
+
+    set pre_exp_gen {}
+    set pre_phi_gen {}
+    set pre_tmp_gen {}
+    set pre_avail_out [lrepeat [llength $bbcontent] {}]
+    set pre_speculative_phis {}
+
+    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 phi_gen_b {}
+	set tmp_gen_b {}
+
+	# Determine values available on entry to the block. They will,
+	# of course, continue to be available. We may need speculative
+	# phis to be inserted.
+
+	set avail_out_b [my pre_avail_in $b bb]
+
+	# Walk through instructions in the basic block
+	set pc -1
+	foreach q $bb {
+	    incr pc
+	    set argl [lassign $q opcode result]
+	    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"} {
+
+		# phi - give the result a unique value number, and add it
+		#       to phi_gen
+		set expr [list {} $result]
+		set v [my pre_gvn_lookup_or_add $expr]
+		dict set phi_gen_b $result $argl
+
+	    } elseif {$op eq "copy"} {
+
+		# copy - give the result the same value number as the source.
+		set src [lindex $argl 0]
+		set expr [list {} $result]
+		set srcexpr [list {} $src]
+		set v [my pre_gvn_lookup_or_add $srcexpr]
+		my pre_gvn_add $expr $v
+		if {![dict exists $exp_gen_b $v]} {
+		    dict set exp_gen_b $v $expr
+		}
+		lappend tmp_gen_b $result
+
+	    } elseif {[dict exists $gvn_eliminable $op]} {
+
+		# Eliminable operation. Make an expression with the
+		# values of the operation, rather than the temporaries
+		# TODO - Some 'invoke's are also eliminable!
+		set expr [list $opcode]
+		foreach a $argl {
+		    if {[lindex $a 0] in {"temp" "var"}} {
+			set aexpr [list {} $a]
+			set av [my pre_gvn_lookup $aexpr]
+			if {![dict exists $exp_gen_b $av]} {
+			    dict set exp_gen_b $av $aexpr
+			}
+			lappend expr [list value $av]
+		    } else {
+			lappend expr $a
+		    }
+		}
+		set rexpr [list {} $result]
+		set v [my pre_gvn_lookup_or_add $expr]
+		my pre_gvn_add $rexpr $v
+		if {![dict exists $exp_gen_b $v]} {
+		    dict set exp_gen_b $v $expr
+		}
+		lappend tmp_gen_b $result
+		
+	    } else {
+
+		# Anything else - make a unique value
+		set expr [list {} $result]
+		set v [my pre_gvn_lookup_or_add $expr]
+		lappend tmp_gen_b $result
+		
+	    }
+
+	    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"
+	    }
+	    puts "written: $tmp_gen_b"
+	    puts "available on output:"
+	    dict for {v expr} $avail_out_b {
+		puts "    value $v: $expr"
+	    }
+	}
+
+	lappend pre_exp_gen $exp_gen_b
+	lappend pre_phi_gen $phi_gen_b
+	lappend pre_tmp_gen $tmp_gen_b
+	lset pre_avail_out $b $avail_out_b
+	lset bbcontent $b $bb
+
+    }
+
+    return
+	
+}
+
+# quadcode::transformer method pre_avail_in --
+#
+#	Calculates the AVAIL_IN set for a basic block
+#
+# Parameters:
+#	b - Basic block number
+#	bbVar - Variable in caller's scope containing the instructions
+#	        in the block
+#
+# Results:
+#	Returns the available expression set as a dictionary whose keys
+#	are global value numbers and whose values are the leaders.
+#
+# Side effects:
+#	May modify the basic block to insert speculative phi instructions.
+#
+# This procedure works around a limitation in [VanD04] that is not present
+# in [MoRe76] or in [Simp96]. THe case that [VanD04] overlooks
+# is a combination like
+#
+# 1: c1 = a1 + b1
+#    jump 3
+#
+# 2: c2 = a1 + b1
+#    jump 3
+#
+# 3: d1 = a1 + b1
+#
+# In this sequence, a1+b1 is fully available at block 3, requiring the
+# insertion of a zero-cost phi operation. It may be only partially
+# anticipable there, but [Simp96] would have found it, as would [MoRe79].
+#
+# The fix is to insert a speculative phi instruction at the head of (3:)
+#
+#    c3 = phi(c1, c2)
+#
+# which then makes c3 fully available to downstream calculations.
+#
+# This is less general than the phi-insertion step of [Chow97], but
+# the case of values that are both partially available and partially
+# anticipable is more complex than we are attempting yet.
+
+oo::define quadcode::transformer method pre_avail_in {b bbVar} {
+
+    my variable pre_avail_out
+    my variable pre_speculative_phis
+
+    upvar 1 $bbVar bb
+
+    set preds [lindex $bbpred $b]
+    set n [dict size $preds]
+    if {$n == 0} {
+
+	# The entry block has no available values at its start
+	return {}
+	
+    } elseif {$n == 1} {
+
+	# 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
+		}
+	    }
+	    set firsttime 0
+	} else {
+	    dict for {v phi} $newphis {
+		if {![dict exists $avout_p $v]} {
+		    dict unset newphis $v
+		} else {
+		    dict set newphis $v [list bb $p] [dict get $avout_p $v]
+		}
+	    }
+	}
+    }
+
+    if {[dict size $newphis] > 0} {
+
+	# Create any speculative phis
+	set newbb {}
+	dict for {v argl} $newphis {
+	    dict for {- var} $argl break
+	    set var [my newVarInstance $var]
+	    dict for {frombb in} $argl {
+		my addUse $in $b
+	    }
+	    set insn [linsert $argl 0 phi $var]
+	    my debug-pre {
+		puts "  Speculative: $b:[llength $newbb]: $insn"
+	    }
+	    dict set udchain $var $b
+	    dict set pre_speculative_phis $b $var {}
+	    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
+    
+}
+
+
+# quadcode::transformer method pre_buildsets2 --
+#
+#	Perform anticipable expression analysis.
+#
+# Results:
+#	None.
+#
+# Side effects:
+#	The 'pre_antic_loc' variable is initialized to a list, indexed
+#	by basic block number, of dictionaries that describe values that
+#	are anticipable LOCALLY on entry to the block, that is,
+#	ones that are calculated locally but not dependent on temporaries
+#	in the block (EXP_GEN-TMP_GEN).
+#
+#	The 'pre_antic_in' variable is initialized to a list, indexed
+#	by basic block number, of dictionaries that describe values that
+#	are anticipable on entry to the block.
+#
+# This procedure follows the general plan of 'iterate until convergence'
+# with the iteration being performed over basic blocks in the retrograde
+# direction - that is, postdominators are visited before the blocks that
+# flow to them. It accumulates from back to front the description of values
+# that are anticipable on entry to eacn block ($pre_antic_in), together
+# with their 'antileaders'--that is, exemplars of computations that may
+# be anticipated.
+#
+# The basic outline of the iteration is given in Figure 4.5 on page 75
+# of [VanD04]. The 'find_leader', 'phi_translate' and 'clean' procedures
+# are somewhat sketchy in VanDrunen's thesis. There is a little bit more
+# information in [VaHo03], where dataflow equations for 'clean' and
+# 'phi_translate' are shown. 'find_leader' is a simple lookup by global
+# value number of an already-known antileader in the given set.
+
+oo::define quadcode::transformer method pre_buildsets2 {} {
+
+    my variable pre_exp_gen
+    my variable pre_tmp_gen
+    my variable pre_phi_gen
+
+    my variable pre_avail_out
+
+    my variable pre_antic_in
+    
+    # Initialize anticipable sets to empty. This initial value should
+    # be accessed only in the case of an infinite loop, whose blocks will
+    # have no postdominators.
+    set pre_antic_in [lrepeat [llength $bbcontent] {}]
+
+    # 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]
+		foreach bprime $rest {
+		    set antic_in_bprime [lindex $pre_antic_in $bprime]
+		    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"
+		    }
+		}
+	    }
+
+	    set exp_gen_b [lindex $pre_exp_gen $b]
+	    set tmp_gen_b [lindex $pre_tmp_gen $b]
+
+	    # 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
+		}
+	    }
+
+	    # Start with ANTIC_IN of this block being
+	    # 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
+	    }
+	}
+    }
+
+    return
+}
+
+# quadcode::transformer method pre_insert --
+#
+#	Inserts new calculations for redundant expressions as
+#	part of partial redundancy elimination.
+#
+# Results:
+#	Returns 1 if any code was changed, 0 otherwise
+#
+# Side effects:
+#
+#	'copy' and 'phi' instructions are inserted in the quadcode
+#	to make fully anticipable expressions available at merge
+#	points where they are only partially available. This process
+#	involves inserting computation of the needed expressions
+#	on any predecessors where they are not available, and then
+#	introducing a phi operation to combine the new expressions.
+#
+# Figures 4.8-4.9 on pp. 78-79 of [VanD04]. Note that the logic in
+# [VanD04], despite the length of the algorithm, is pretty sketchy. In
+# particular, there's no indication of how 'new_sets' is used - it's
+# constructed, but not referred to.  In addition, the information for
+# 'phi_translate' is also unclear. We try to replicate here from
+# first principles.
+
+oo::define quadcode::transformer method pre_insert {} {
+
+    my variable pre_antic_in
+    my variable pre_avail_out
+    
+    my debug-pre {
+	puts "Try to find code insertion points"
+    }
+
+    # new_sets contains the newly introduced phi's. It is a list indexed
+    # by basic block number, whose elements are dictionaries mapping
+    # global value number to the term in the phi operation.
+    set new_sets {}
+
+    # This procedure iterates to convergence. 'changed' tracks whether
+    # we did anything on a single pass.
+    set did_something 0
+    set changed 1
+    set did_phis {}
+    while {$changed} {
+	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} {
+		    set new_phis [lindex $new_sets $dom]
+		} else {
+		    set new_phis {}
+		}
+		lappend new_sets $new_phis
+	    }
+	    set avail_out_b [lindex $pre_avail_out $b]
+	    lset pre_avail_out $b {}
+	    dict for {v e} [lindex $new_sets $b] {
+		dict set avail_out_b $v $e
+	    }
+	    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
+		set translated_p {}
+		dict for {p -} $preds {
+		    dict set translated_p $p [my pre_phi_translate $antin $p $b]
+		}
+
+		# 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
+		    # that supply the value. Set avail to the
+		    # expressions that compute the value in the
+		    # predecessors; by_some to indicate whether any
+		    # predecessor has the value available, and
+		    # all_same to indicate whether all predecessors
+		    # have the value available in the same place.
+		    set avail {}
+		    set by_some 0
+		    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]} {
+				set first_s $e2
+			    } elseif {$first_s ne $e2} {
+				set all_same 0
+			    }
+			}
+		    }
+
+		    # 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
+			# available
+			lassign $pair v1 e1
+			set argl [lassign $e1 opcode]
+			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 insn [list $opcode $t]
+			foreach a $argl {
+			    if {[lindex $a 0] ne "value"} {
+				lappend insn $a
+			    } else {
+				set s1 [dict get $avail_out_p [lindex $a 1]]
+				lappend insn $s1
+				my addUse $s1 $p
+			    }
+			}
+			my debug-pre {
+			    puts "    Add $insn at the end of block $p"
+			}
+			set bb [lindex $bbcontent $p]
+			lset bbcontent $p {}
+			set bb [linsert $bb[set bb ""] end-1 $insn]
+			lset bbcontent $p $bb
+
+			# Track that the new instruction is the leader for
+			# the value,
+			set texpr [list {} $t]
+			my pre_gvn_add $texpr $v1
+			set avail_out_p [lindex $pre_avail_out $p]
+			lset pre_avail_out $p {}
+			dict set avail_out_p $v1 $t
+			lset pre_avail_out $p $avail_out_p
+			dict set avail $p [list $v1 $texpr]
+
+		    }
+
+		    # Make the temporary to hold the phi result
+		    set t [my pre_make_temp_for_expr $v $e]
+		    dict set udchain $t $b
+
+		    # Make the phi instruction
+		    set insn [list phi $t]
+		    dict for {p pair} $avail {
+			lassign $pair v1 e1
+			set invar [lindex $e1 1]
+			my addUse $invar $b
+			lappend insn [list bb $p] $invar
+		    }
+		    my debug-pre {
+			puts "insert $insn at the start of $b"
+		    }
+		    set bb [lindex $bbcontent $b]
+		    lset bbcontent $b {}
+		    set bb [linsert $bb[set bb ""] 0 $insn]
+		    lset bbcontent $b $bb
+		    
+		    # Record the phi result in the avail set and the
+		    # new_sets 
+		    set texpr [list {} $t]
+		    my pre_gvn_add $texpr $v
+		    set avail_out_b [lindex $pre_avail_out $b]
+		    lset pre_avail_out $b {}
+		    dict set avail_out_b $v $t
+		    lset pre_avail_out $b $avail_out_b
+		    set new_sets_b [lindex $new_sets $b]
+		    lset new_sets $b {}
+		    dict set new_sets_b $v $t
+		    lset new_sets $b $new_sets_b
+
+		    # Record that we modified the code
+
+		    set changed 1
+		    set did_something 1
+		}
+
+	    }
+	}
+    }
+
+    return $did_something
+}
+
+# quadcode::transformer method pre_eliminate --
+#
+#	Eliminates redundant code once partial availability has been
+#	resolved
+#
+# Results:
+#	Returns 1 if anything was eliminated
+#
+# Side effects:
+#	Rewrites quadcode to eliminate redundant operations.
+#
+# Figure 4.10 on page 80 of [VanD04].
+
+oo::define quadcode::transformer method pre_eliminate {} {
+
+    variable ::quadcode::gvn_eliminable
+
+    my variable pre_avail_out
+
+    my debug-pre {
+	puts "Rewrite to eliminate redundant computations:"
+    }
+
+    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]} {
+
+		# Is there an earlier computation whose result can
+		# replace the result of this instruction?
+		set v [my pre_gvn_lookup [list {} $result]]
+		set x [dict get $avail_out_b $v]
+		if {$x ne $result} {
+
+		    # 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
+    }
+
+    return $changed
+}
+
+# quadcode::transformer method pre_remove_speculative_phis --
+#
+#	Removes any speculatively-inserted phis after partial redundancy
+#	elimination is complete
+#
+# Results:
+#	None.
+#
+# Side effects:
+#	Speculative phis are removed.
+#
+# This method must execute if and only if the partial reduncancy
+# elimination modified no code other than the speculatively-inserted
+# phi operations. They are _ipso facto_ unused.
+#
+# If this step were not to take place, we'd have to return 'changed' in
+# order to recalculate types, which would check for further optimizations,
+# remove the speculative phis in dead code removal, and then reinvoke
+# this method, which would put them back in.
+
+oo::define quadcode::transformer method pre_remove_speculative_phis {} {
+
+    my variable pre_speculative_phis
+
+    my debug-pre {
+	puts "Remove any speculative phi instructions"
+	dict for {b vars} $pre_speculative_phis {
+	    puts "$b: [dict keys $vars]"
+	}
+    }
+
+    # Walk through the speculative phis, grouped by block
+    dict for {b phis} $pre_speculative_phis {
+
+	# Get the basic block content and walk through the instructions
+	set bb [lindex $bbcontent $b]
+	set newbb {}
+	lset bbcontent $b {}
+	set pc -1
+	foreach q $bb {
+	    incr pc
+	    set res [lindex $q 1]
+
+	    # Delete any instruction that is a speculative phi
+	    if {![dict exists $phis $res]} {
+		lappend newbb $q
+	    } else {
+		my debug-pre {
+		    puts "  $b:$pc: $q"
+		}
+		dict unset udchain $res
+		foreach {- v} [lrange $q 2 end] {
+		    my removeUse $v $b
+		}
+	    }
+	}
+
+	# Put the new basic block content back
+	lset bbcontent $b $newbb
+    }
+    return
+}
+
+# quadcode::transformer method pre_cleanup --
+#
+#	Cleans up globals left behind by partial redundancy elimination
+#
+# Results:
+#	None
+
+oo::define quadcode::transformer method pre_cleanup {} {
+
+    my variable pre_antic_in
+    my variable pre_avail_out
+    my variable pre_exp_gen
+    my variable pre_phi_gen
+    my variable pre_speculative_phis
+    my variable pre_tmp_gen
+    my variable pre_vexprs
+    my variable pre_vn
+
+    unset -nocomplain pre_antic_in
+    unset -nocomplain pre_avail_out
+    unset -nocomplain pre_exp_gen
+    unset -nocomplain pre_phi_gen
+    unset -nocomplain pre_speculative_phis
+    unset -nocomplain pre_tmp_gen
+    unset -nocomplain pre_vexprs
+    unset -nocomplain pre_vn
+
+    return
+}
+
+# quadcode::transformer method pre_make_temp_for_expr --
+#
+#	Creates a temporary variable to hold the value of an expression
+#
+# Parameters:
+#	v - Global value number
+#	e - Expression being evaluated
+#
+# Results:
+#	Returns the name of the newly-created temp
+
+oo::define quadcode::transformer method pre_make_temp_for_expr {v e} {
+
+    my variable pre_vexprs
+
+    set tempname [list temp $v]
+    foreach c [lindex $pre_vexprs $v] {
+	if {[lindex $c 0] eq {}} {
+	    set cname [lindex $c 1]
+	    if {[lindex $cname 0] eq "var" || [lindex $tempname 0] ne "var"} {
+		set tempname $cname
+	    }
+	}
+    }
+
+    return [my newVarInstance $tempname]
+}
+
+# quadcode::transformer method pre_phi_translate --
+#
+#	Translates a set of expressions that are valid in a successor
+#	block to ones that are valid in the predecessor block
+#
+# Parameters:
+#	es - Dictionary whose keys are global value numbers and
+#	     whose values are expressions in the successor block
+#	p - Predecessor block
+#	s - Successor block
+#
+# Results:
+#	Returns the translated expressions as a dictionary. The keys are
+#	value numbers in the successor block, and the values are ordered
+#	pairs giving the value number in the predecessor and the expression
+#	in the predecessor.
+#
+
+# Described on page 1 of [VaHo03].
+
+oo::define quadcode::transformer method pre_phi_translate {es p s} {
+
+    # Translate each expression in turn
+    set translated {}
+    dict for {v e} $es {
+	lassign [my pre_phi_translate1 $translated $v $e $p $s] newv newe
+	dict set translated $v [list $newv $newe]
+    }
+    return $translated
+}
+
+# quadcode::transformer method pre_phi_translate1 --
+#
+#	Translates an expression that is valid in a successof block to
+#	one that is valid in a predecessor block.
+#
+# Parameters:
+#	translated - Expressions translated already in the current block
+#	             Keys are value numbers, values are the translations
+#	v - The expression's global value number
+#	e - The expression being translated
+#	p - The predecessor block
+#	s - The successor block
+#
+# 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
+
+    # Handle temporaries by mapping them through any phis
+    if {[lindex $e 0] eq {}} {
+	set t [lindex $e 1]
+
+	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]
+	}
+    }
+    
+    # Handle complex expressions by finding them in the set that have
+    # already been translated
+    if {[dict exists $es $v]} {
+	return [dict get $es $v]
+    }
+
+    # Take apart the expression
+    set argl [lassign $e opcode]
+    set eout [list $opcode]
+
+    # Translate the args to the expression.
+    foreach a $argl {
+	if {[lindex $a 0] ne "value"} {
+	    lappend eout $a
+	} else {
+	    # The arg is 'value N', and we must have already translated
+	    # it. Retrieve it from the cache
+	    set vprime [lindex $a 1]
+	    if {[dict exists $es $vprime]} {
+		lassign [dict get $es $vprime] v2 e2
+		if {$v2 < 0} {
+		    lappend eout [lindex $e2 1]
+		} else {
+		    lappend eout [list value $v2]
+		}
+	    } else {
+		error "$p->$s Value $vprime is not cached, but $e depends on it?"
+	    }
+	}
+    }
+
+    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 --
+#
+#	Filters out killed dependent expressions from a set of anticipable
+#	expressions
+#
+# Parameters:
+#	es - Dictionary whose keys are value numbers and whose values
+#	     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
+		}
+	    }
+	}
+    }
+    return $es
+}
+
+# quadcode::transformer method pre_gvn_add --
+#
+#	Adds a given expression to the value tables for GVNPRE
+#
+# Parameters:
+#	e - Expression to add
+#	v - Value number that it will take, or -1 if the value is not yet known
+#
+# Results:
+#	None
+#
+# Side effects:
+#	The value $v will be provided as the value of expression $e,
+#	and $e will be added to the set of expressions that the given
+#	value represents.
+#
+# Figure 4.1, page 65 of [VAND04]
+
+oo::define quadcode::transformer method pre_gvn_add {e v} {
+
+    my variable pre_vn;		# Value numbers
+    my variable pre_vexprs;	# Sets of expressions corresponding to
+    ;				# numbered values
+
+    dict set pre_vn $e $v
+    set es [lindex $pre_vexprs $v]
+    lset pre_vexprs $v {}
+    lappend es $e
+    lset pre_vexprs $v $es
+
+    return
+}
+
+# quadcode::transformer method pre_gvn_lookup --
+#
+#	Looks up the value number of an expression and returns it. If the
+#	expression has not been assigned a value number, returns -1.
+#
+# Parameters:
+#	e - Expression to look up
+#
+# Results:
+#	Returns the value number or -1
+#
+# If any sort of algebraic simplification (e.g., recognizing that a+0==a
+# or 0*a==0) is to happen in Global Value Numbering, this method is where
+# it must happen. Right now, there is no such work being done in this pass.
+
+oo::define quadcode::transformer method pre_gvn_lookup {e} {
+
+    my variable pre_vn
+
+    if {[dict exists $pre_vn $e]} {
+	return [dict get $pre_vn $e]
+    } else {
+	return -1
+    }
+}
+
+# quadcode::transformer method pre_gvn_lookup_or_add --
+#
+#	Looks up a given expression in the global value numbering. If it
+#	is not found, makes a new entry for it. 
+#
+# Parameters:
+#	e - Expression to add.
+#
+# Results:
+#	Returns the value number
+#
+# Side effects:
+#	May add the expression to the table of expressions and value numbers.
+#	Does not create any exemplar for the expression.
+
+oo::define quadcode::transformer method pre_gvn_lookup_or_add {e} {
+
+    my variable pre_vn
+    my variable pre_vexprs
+
+    set x [my pre_gvn_lookup $e]
+    if {$x == -1} {		# We haven't seen the expression yet
+	set x [llength $pre_vexprs]
+	lappend pre_vexprs {}
+	my pre_gvn_add $e $x
+    }
+    return $x
+}
+
+# quadcode::transformer method pre_gvn_is_literal --
+#
+#	Determines whether a given value represents a literal.
+#
+# Parameters:
+#	v - Value number to examine
+#	litVar - Name of a variable in caller's scope that should receive
+#	         the literal that the value number represents
+#
+# Results:
+#	Returns 1 if the value represents a literal, 0 otherwise.
+#
+# Side effects:
+#	Stores the name in 'litVar' if the value represents a literal
+
+oo::define quadcode::transformer method pre_gvn_is_literal {v litVar} {
+    upvar 1 $litVar lit
+
+    my variable pre_vexprs
+
+    foreach expr [lindex $pre_vexprs $v] {
+	if {[lindex $expr 0] eq "literal"} {
+	    set lit $expr
+	    return 1
+	}
+    }
+
+    return 0
+}

Index: quadcode/specializer.tcl
==================================================================
--- quadcode/specializer.tcl
+++ quadcode/specializer.tcl
@@ -263,10 +263,13 @@
     namespace upvar ::quadcode::dataType STRING STRING
     # Do the initial bytecode-to-quads transformation for all
     # registered procedures
 
     dict for {procName db} $database {
+	my debug-specializer {
+	    puts "TRANSFORM: $procName"
+	}
 	if {[catch {$db transform} result]} {
 	    set atypes [lrepeat [llength [info args $procName]] $STRING]
 	    my diagnostic $procName $atypes "" 0 $procName \
 		fatal "Cannot analyze %s:\n%s" \
 		$procName $::errorInfo
@@ -357,11 +360,19 @@
 			break
 		    }
 		}
 		if {$mightInline} {
 		    set inf [dict get $typeInf $inst]
-		    if {[$inf expandInlines]} {
+		    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
 		    }
 		}
 	    }
 	}
@@ -1127,16 +1138,11 @@
     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?
+    $inf doneWithNodeSplitting
 
 }
 
 # quadcode::specializer method AddToWorklist --
 #

Index: quadcode/ssa.tcl
==================================================================
--- quadcode/ssa.tcl
+++ quadcode/ssa.tcl
@@ -65,11 +65,11 @@
 # bbidom --
 #
 #	Compute the immediate dominators of the basic blocks
 #
 # Results:
-#	None.
+#	Returns zero.
 #
 # Side effects:
 #	Sets 'bbidom' to a list of immediate dominators, indexed by
 #	basic block number.
 #	Sets 'bbkids' to a list indexed by basic block numbers of the
@@ -177,11 +177,11 @@
 	set i -1
 	foreach id $bbidom kid $bbkids {
 	    puts "[incr i]: idom $id kids $kid"
 	}
     }
-    return
+    return 0
 }
 
 # quadcode::transformer method bblevel -
 #
 #	Calculate level numbering in the dominance tree
@@ -189,11 +189,11 @@
 # Preconditions:
 #	The 'bbkids' relation must contain the lists of blocks immediately
 #	dominated (the inverse of the 'idom' relationship).
 #
 # Results:
-#	None.
+#	Returns zero.
 #
 # Side effects:
 #	'bblevel' is updated for the current block's subtree
 
 oo::define quadcode::transformer method bblevel {} {
@@ -201,10 +201,11 @@
     set bbnlevels -1
     my bblevel-worker 0 0
     my debug-ssa {
 	puts "bblevel $bblevel"
     }
+    return 0
 }
 oo::define quadcode::transformer method bblevel-worker {blk level} {
     lset bblevel $blk $level
     if {$level > $bbnlevels} {
 	set bbnlevels $level
@@ -663,10 +664,26 @@
     }
     set nv  [my newVarInstance $v]
     dict set r $v $nv
     return $nv
 }
+
+# quadcode::transformer method resetVarCounts
+#
+#	Resets all instance counts of all variables.
+#
+# Results:
+#	None.
+#
+# When a pass such as partial redundancy elimination runs, it rewrites
+# all variable names throughout the program. Rather than having runaway
+# variable indices, it calls this routine to reset all counts for
+# variable names.
+
+oo::define quadcode::transformer method resetVarCounts {} {
+    set varcount {}
+}
 
 # quadcode::transformer method newVarInstance
 #
 #	Creates a new instance of the given variable
 #

Index: quadcode/transformer.tcl
==================================================================
--- quadcode/transformer.tcl
+++ quadcode/transformer.tcl
@@ -307,14 +307,19 @@
 	}
 
 	# varargs needs 'deadbb', 'bbidom', 'bblevel' after it because it
 	# may have introduced unreachable code.
 
+	# After 'ssa' comes 'renameTemps' - which is very, very slow.
+	# Do we actually need it at all?
+#	    renameTemps
+
 	foreach pass {
 	    bbpartition
 	    constJumpPeephole
 	    sortbb
+	    loopinv
 	    callFrameMotion
 	    ssa
 	    renameTemps
 	    ud_du_chain
 	    copyprop
@@ -340,10 +345,14 @@
 	}
 	my debug-transform {
 	    puts "after initial transform:"
 	    my dump-bb
 	}
+	my debug-audit {
+	    my audit-duchain exit-from-transform
+	    my audit-phis exit-from-transform
+	}
     }
 
     # variant --
     #
     #	Makes a specialized version of this quadcode, once parameter types
@@ -522,17 +531,20 @@
 #       Types must have already been inferred, including the requirement
 #       that the return types of commands must be stable (or at least
 #       conservative).
 #
 # Results:
-#       None.
+#       Returns 1 if type inference must be repeated, 0 if the code
+#	is thought to be ready to try jump threading.
 #
 # Side effects:
-#       Type-dependent operations (for example, narrowing, type checking)
-#       are eliminated where the input types are known. Dead code (unconditional
-#       jumps on noncritical edges, unreachable code, unused variables,
-#       useless phi operations, useless copies) is removed.
+#
+#       Type-dependent operations (for example, narrowing, type
+#       checking) are eliminated where the input types are known. Dead
+#       code (unconditional jumps on noncritical edges, unreachable
+#       code, unused variables, useless phi operations, useless
+#       copies) is removed.
 #
 #       The dominator tree is rebuilt.
 #
 #       This method may narrow the types of parameters to called functions,
 #       or the result type of the function being processed. In this case,
@@ -539,66 +551,150 @@
 #       type specialization may have been made invalid and will have to be
 #       repaired.
 
 oo::define quadcode::transformer method tidy {} {
 
-    # Remove useless type checking
-    set changed [my cleanupNarrow]
-
-    # The following optimizations have no data type dependency.
-    # They depend only on control and data flows, and so are safe
-    # even though earlier operations may have spoilt type information.
-    # 'deadjump' can cause data type analysis to be spoilt.
-    # 'deadbb' can also cause it to be spoilt, because it could be that
-    # a variable receives a particular type only in unreachable code.
-    # 'bbidom' and 'bblevel' do not modify the program.
-    # 'deadvars' removes unused values. This cannot affect data types,
-    # but it affects dependencies if an entire procedure invocation can be
-    # killed.
-    # 'deadphis' and 'copyprop' remove only 'copy' and 'phi' operations,
-    # 'and any operand that they replace hav exactly the same types
-    # as the operands being replaced.
-
-    # Remove useless data motion from callframes
-    set changed [expr {[my cleanupMoveFromCallFrame] || $changed}]
-
-    # Remove useless data motion into callframes
-    set changed [expr {[my cleanupMoveToCallFrame] || $changed}]
-
-    # Remove any totally irrelevant callframe use/defs
-    set changed [expr {[my cleanupCallFrameUse] || [my deadvars] || $changed}]
-
-    # Remove conditional jumps that depend on constants
-    set changed [expr {[my deadjump] || $changed}]
-
-    # Remove unreachable code and coalesce basic blocks where possible
-    set changed [expr {[my deadbb] || $changed}]
-
-    # Restore the dominator tree if it has been spoilt.
-    if {$changed} {
-	my bbidom
-	my bblevel
-    }
-
-    # Remove assignments to unused values
-    set changed [expr {[my deadvars] || $changed}]
-
-    # Remove useless phi operations
-    my uselessphis;             # Remove useless phi operations
-
-    # Do copy propagation
-    if {[my copyprop] || [my constfold]} {
-	set changed 1
-
-	# Copy propagation may have destroyed the only references to
-	# certain values. Hunt them down and kill them.
-	my deadvars
-	my uselessphis
-    }
-
-    return $changed
-
+    my debug-audit {
+	my audit-duchain entry-to-tidy
+	my audit-phis entry-to-tidy
+    }
+
+    # There's a distinct order of passes here.
+
+    # We come in with type inference having been run, and 'cleanupNarrow'
+    # depends on the types being right.
+    #
+    # 'cleanupMoveFromCallFrame'. 'cleanupMoveToCallFrame' and
+    # 'cleanupCallFrameUse' can follow. They remove unneeded callframe
+    # references. This change may make additional typing information
+    # available, so we will want to rerun type analysis and try again
+    # if any of these passes actually changes the code.
+    #
+    # Copy propagation and constant folding can follow. These operations
+    # should not change the type of anything, they only simplify the code.
+    #
+    # When we kill conditional jumps and remove dead code, we can
+    # destroy the basic block dominance relations, so we rebuild them
+    # before getting into any further optimizations that need them.
+    #
+    # We can now try partial redundancy elimination, which cannot change
+    # data types but only moves around operations of known type.
+    # It can leave a mess to clean up, with dead variables, useless phis,
+    # and the possibility that it's given rise to empty basic blocks,
+    # allowing deadbb/deadjump possibly to do further restructuring.
+
+    my debug-tidy {
+	puts "tidy: [my full-name]"
+    }
+
+    set somethingChanged 0
+    set changed 1
+
+    while {$changed} {
+	set changed 0
+	my debug-tidy {
+	    set debugLine {tidy:}
+	}
+	foreach pass {
+	    copyprop
+	    cleanupMoveFromCallFrame
+	    cleanupMoveToCallFrame
+	    cleanupCallFrameUse
+	    cleanupNarrow
+	    deadjump
+	    deadbb
+	    bbidom
+	    bblevel
+	    constfold
+	    deadvars
+	    uselessphis
+	    constfold
+	    partialredundancy
+	} {
+	    set cmd [string map [list @pass $pass] {
+		set result [my @pass]
+	    }]
+	    lappend timings $pass [lindex [time $cmd] 0]
+	    if {$result} {
+		set changed 1
+	    }
+	    my debug-audit {
+		my audit-duchain $pass
+		my audit-phis $pass
+	    }
+	    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
+    # have narrowed types, so we need to return for more interprocedural
+    # type analysis
+	
+    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
@@ -680,12 +776,14 @@
 source [file join $quadcode::libdir flatten.tcl]
 source [file join $quadcode::libdir fqcmd.tcl]
 source [file join $quadcode::libdir inline.tcl]
 source [file join $quadcode::libdir invoke.tcl]
 source [file join $quadcode::libdir liveranges.tcl]
+source [file join $quadcode::libdir loopinv.tcl]
 source [file join $quadcode::libdir narrow.tcl]
 source [file join $quadcode::libdir nodesplit.tcl]
+source [file join $quadcode::libdir pre.tcl]
 source [file join $quadcode::libdir renameTemps.tcl]
 source [file join $quadcode::libdir ssa.tcl]
 source [file join $quadcode::libdir translate.tcl]
 source [file join $quadcode::libdir typecheck.tcl]
 source [file join $quadcode::libdir types.tcl]

Index: quadcode/typecheck.tcl
==================================================================
--- quadcode/typecheck.tcl
+++ quadcode/typecheck.tcl
@@ -257,53 +257,90 @@
 	    set q [lindex $bbcontent $b $i]
 
 	    switch -exact [lindex $q 0 0] {
 
 		"initParamTypeException" {
+		    my debug-rewriteParamChecks {
+			puts "$b:$i: $q"
+		    }
 		    lassign $q op result src fref
 		    set t [my determineFunctionParamType $op $fref]
 		    if {$t != $quadcode::dataType::STRING} {
 			set msg [format "can't use non-numeric value as\
                                          operand of \"%s\"" [lindex $fref 1]]
 			set msgLit [list literal $msg]
 			set exn {literal {-errorcode {ARITH DOMAIN {non-numeric string}}}}
-			lset bbcontent $b $j \
+			set newq \
 			    [list initException $result $msgLit $exn \
 				 {literal 1} {literal 0}]
+			my removeUse $src $b
+			lset bbcontent $b $j $newq
+			my debug-rewriteParamChecks {
+			    puts "$b:$j ----> $newq"
+			}
 			incr j
 		    } else {
+			my debug-rewriteParamChecks {
+			    puts "$b:$i: (deleted)"
+			}
+			lset bbcontent $b $i {nop {}}
 			my removeUse $src $b
 			my replaceUses $result Nothing
+			dict unset duchain $result
 			# delete the quad
 		    }
 
 		}
 
 		"instanceOfParamType" {
+		    my debug-rewriteParamChecks {
+			puts "$b:$i: $q"
+		    }
 		    lassign $q op result src fref
 		    set t [my determineFunctionParamType $op $fref]
 		    if {$t != $quadcode::dataType::STRING} {
 			set t [expr {$t | $quadcode::dataType::IMPURE}]
 			set op [list "instanceOf" $t [nameOfType $t]]
-			lset bbcontent $b $j [list $op $result $src]
+			set newq [list $op $result $src]
+			lset bbcontent $b $j $newq
+			my debug-rewriteParamChecks {
+			    puts "$b:$j ----> $newq"
+			}
 			incr j
 		    } else {
+			my debug-rewriteParamChecks {
+			    puts "$b:$i: (deleted)"
+			}
+			lset bbcontent $b $i {nop {}}
 			my removeUse $src $b
 			my replaceUses $result {literal 1}
+			dict unset duchain $result
 			# delete the quad
 		    }
 		}
 
 		"purifyParam" {
+		    my debug-rewriteParamChecks {
+			puts "$b:$i: $q"
+		    }
 		    lassign $q op result src fref
 		    set t [my determineFunctionParamType $op $fref]
 		    if {$t != $quadcode::dataType::STRING} {
-			lset bbcontent $b $j [list purify $result $src]
+			set newq [list purify $result $src]
+			lset bbcontent $b $j $newq
+			my debug-rewriteParamChecks {
+			    puts "$b:$j ----> $newq"
+			}
 			incr j
 		    } else {
+			my debug-rewriteParamChecks {
+			    puts "$b:$i: (deleted)"
+			}
+			lset bbcontent $b $i {nop {}}
 			my removeUse $src $b
 			my replaceUses $result $src
+			dict unset duchain $result
 			# delete the quad
 		    }
 		}
 
 		default {

Index: quadcode/types.tcl
==================================================================
--- quadcode/types.tcl
+++ quadcode/types.tcl
@@ -397,10 +397,14 @@
 
     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 {}
@@ -874,20 +878,20 @@
 	if {$y eq $x} {
 	    set impure 0
 	} else {
 	    set impure $dataType::IMPURE
 	}
-	if {$x >= -0x80000000 && $x <= 0x7fffffff} {
+	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::ENTIER $impure]
+	    return [dataType::typeUnion $dataType::BIGINT $impure]
 	}
     } elseif {[string is double -strict $x]} {
 	set y [expr {double($x)}]
 	if {$y eq $x} {
 	    return $dataType::DOUBLE

Index: quadcode/upvar.tcl
==================================================================
--- quadcode/upvar.tcl
+++ quadcode/upvar.tcl
@@ -46,10 +46,14 @@
 
     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
@@ -64,10 +68,15 @@
 
     # 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 --