set t 1.0
    set i 0
    while {[incr i] < $n} {
	set t [expr {-$t*$x*$x / [incr j] / [incr j]}]
	set s [expr {$s + $t}]
    }
    return $s











}
proc coscaller1 {x} {
    cos [expr {double($x)}]
}
proc coscaller2 {} {
    for {set i -100} {$i <= 100} {incr i} {
	set x [expr {0.00314159 * $i}]
................................................................................
set errorCode {}
set demos {
    # Mathematical operations; [fib] and [cos] are supposed to be accelerated
    # heavily, the others are less critical
    {fib 85}
    {fib-r 15}
    {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}
................................................................................
# compilation engine will do that for us if necessary.

set toCompile {
    # Mathematical operations; [fib] and [cos] are supposed to be accelerated
    # heavily, the others are less critical
    fib fib-r
    ::cos

    tantest
    inttest
    math::ln_Gamma
    polartest
    lmapconsttest
    shift
    powmul1 powmul2

    set t 1.0
    set i 0
    while {[incr i] < $n} {
	set t [expr {-$t*$x*$x / [incr j] / [incr j]}]
	set s [expr {$s + $t}]
    }
    return $s
}
proc cos2 {x {n 16}} {
    set j 0
    set s 1.0
    set t 1.0
    set i 0
    while {+[incr i] < +$n} {
	set t [expr {-$t*$x*$x / [incr j] / [incr j]}]
	set s [expr {$s + $t}]
    }
    return $s
}
proc coscaller1 {x} {
    cos [expr {double($x)}]
}
proc coscaller2 {} {
    for {set i -100} {$i <= 100} {incr i} {
	set x [expr {0.00314159 * $i}]
................................................................................
set errorCode {}
set demos {
    # Mathematical operations; [fib] and [cos] are supposed to be accelerated
    # heavily, the others are less critical
    {fib 85}
    {fib-r 15}
    {cos 1.2}
    {cos2 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}
................................................................................
# compilation engine will do that for us if necessary.

set toCompile {
    # Mathematical operations; [fib] and [cos] are supposed to be accelerated
    # heavily, the others are less critical
    fib fib-r
    ::cos
    ::cos2
    tantest
    inttest
    math::ln_Gamma
    polartest
    lmapconsttest
    shift
    powmul1 powmul2

			}
			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 $result with Nothing"
			}
			dict unset udchain $result
			my replaceUses $result Nothing

			}
			dict unset udchain $result
			my replaceUses $result $res
			set changed 1
			continue; # delete the quad
		    }

		    "uplus" {
			set res [list literal [lindex $argl 0]]
			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
		    }
		    
		    "unset" {
			my debug-constfold {
			    puts "$b:$pc: $q"
			    puts "    replace $result with Nothing"
			}
			dict unset udchain $result
			my replaceUses $result Nothing

oo::define quadcode::transformer method expandOneInline {b bb pc q toInline} {

    my debug-inline {
	puts "inline: expand $b:$pc: $q"
    }

    # Remember the number of split markers, so as to be able to
    # adjust the split markers in the inline code.

    set nSplits [llength [my countSplits]]
    my debug-inline {
	puts "inline: $nSplits splits"
    }

    # Save aside the source context for the inlined call

    lassign [my sourceInfo $b $pc] sfile slines sscript sctx

    # Make a basic block for the continuation. Link flow control to
    # the new block. If there are phis in the new block's successors, relink
    # them to the new block.
................................................................................
    my debug-inline {
	puts "inline: $b:$pc [lindex $bb $pc]"
    }

    # Rewrite the inline code to fit in with the calling procedure, and
    # retrieve the set of jumps that replace the 'return' quadcodes.

    my rewriteInline $eb $cb $nSplits $q

}
 
# quadcode::transformer method rewriteInline --
#
#	Rewrites code that has just been brought inline from another procedure
#	to fit in the basic block.
#
# Parameters:
#	startBlock - Basic block number of the first inlined block
#	exitBlock - Basic block number of the block to which 'return'
#	            quadcodes will redirect
#	nSplits - Number of distinct split markers in the calling procedure
#	          before inlining
#	iq - Quadcode instruction that invoked the inlined procedure.
#
# Results:
#	None
#
# The inlining at this point is extremely simple minded. It cannot cope
# with callframe operations at all, nor can it cope with procedures that
................................................................................
#	    cannot be critical edges, since 'return' is always the only
#	    exit from its basic block.
#	(4) All variables and temporaries that appear in the inlined code
#	    are replaced with fresh instances (and of course have their
#	    ud- and du-chains created.
#	(5) Basic block references are renumbered to reflect the position
#	    of the inlined code.
#	(6) 'split' quadcodes are renumbered so that any further node
#	    splitting will have the correct counts.
#
# Following a pass that does this, the dominance hierarchy is reconstructed,
# and 'repairSSAVariable' is called to restore SSA consistency to the
# variable that contains the procedure's return value
#
# FIXME: 'repairSSAVariable' is overkill here. We shouldn't have to introduce
#        copies for the return operations; instead, the exit block should
................................................................................
#        moveFromCallFrame*; jumpMaybe.  This is because there are several
#        places in the code that assume a CALLFRAME FAIL <RESULTTYPE>
#	 will be sorted out and only the <RESULTTYPE> will arrive at
#	 a phi. (In particular, moveFromCallFrame needs to be able to find
#        a unique operation that produced the callframe in question.)

oo::define quadcode::transformer method rewriteInline {startBlock exitBlock
						       nSplits iq} {

    set argv [lassign $iq - resultVar cfin command]
    my debug-inline {
	puts "inline: pulling in an invocation of $command"
	puts "        with result $resultVar and args $argv"
	puts "        code starts at $startBlock and returns to $exitBlock"
    }
................................................................................
		    lappend newbb [list copy $resultVar $rsource]
		    my addUse $rsource $b
		    lappend newbb [list jump [list bb $exitBlock]]
		    my bblink $b $exitBlock
		    dict incr resultAssignments $b
		}

		split {
		    set splitNum [expr {[lindex $q 2 1] + $nSplits}]
		    lappend newbb [list split {} [list literal $splitNum]]
		}

		default {
		    set newq [list [lindex $q 0]]
		    set first 1
		    foreach arg [lrange $q 1 end] {
			switch -exact [lindex $arg 0] {
			    bb {
				set nb [expr {$startBlock + [lindex $arg 1]}]

oo::define quadcode::transformer method expandOneInline {b bb pc q toInline} {

    my debug-inline {
	puts "inline: expand $b:$pc: $q"
    }









    # Save aside the source context for the inlined call

    lassign [my sourceInfo $b $pc] sfile slines sscript sctx

    # Make a basic block for the continuation. Link flow control to
    # the new block. If there are phis in the new block's successors, relink
    # them to the new block.
................................................................................
    my debug-inline {
	puts "inline: $b:$pc [lindex $bb $pc]"
    }

    # Rewrite the inline code to fit in with the calling procedure, and
    # retrieve the set of jumps that replace the 'return' quadcodes.

    my rewriteInline $eb $cb $q

}
 
# quadcode::transformer method rewriteInline --
#
#	Rewrites code that has just been brought inline from another procedure
#	to fit in the basic block.
#
# Parameters:
#	startBlock - Basic block number of the first inlined block
#	exitBlock - Basic block number of the block to which 'return'
#	            quadcodes will redirect


#	iq - Quadcode instruction that invoked the inlined procedure.
#
# Results:
#	None
#
# The inlining at this point is extremely simple minded. It cannot cope
# with callframe operations at all, nor can it cope with procedures that
................................................................................
#	    cannot be critical edges, since 'return' is always the only
#	    exit from its basic block.
#	(4) All variables and temporaries that appear in the inlined code
#	    are replaced with fresh instances (and of course have their
#	    ud- and du-chains created.
#	(5) Basic block references are renumbered to reflect the position
#	    of the inlined code.


#
# Following a pass that does this, the dominance hierarchy is reconstructed,
# and 'repairSSAVariable' is called to restore SSA consistency to the
# variable that contains the procedure's return value
#
# FIXME: 'repairSSAVariable' is overkill here. We shouldn't have to introduce
#        copies for the return operations; instead, the exit block should
................................................................................
#        moveFromCallFrame*; jumpMaybe.  This is because there are several
#        places in the code that assume a CALLFRAME FAIL <RESULTTYPE>
#	 will be sorted out and only the <RESULTTYPE> will arrive at
#	 a phi. (In particular, moveFromCallFrame needs to be able to find
#        a unique operation that produced the callframe in question.)

oo::define quadcode::transformer method rewriteInline {startBlock exitBlock
						       iq} {

    set argv [lassign $iq - resultVar cfin command]
    my debug-inline {
	puts "inline: pulling in an invocation of $command"
	puts "        with result $resultVar and args $argv"
	puts "        code starts at $startBlock and returns to $exitBlock"
    }
................................................................................
		    lappend newbb [list copy $resultVar $rsource]
		    my addUse $rsource $b
		    lappend newbb [list jump [list bb $exitBlock]]
		    my bblink $b $exitBlock
		    dict incr resultAssignments $b
		}






		default {
		    set newq [list [lindex $q 0]]
		    set first 1
		    foreach arg [lrange $q 1 end] {
			switch -exact [lindex $arg 0] {
			    bb {
				set nb [expr {$startBlock + [lindex $arg 1]}]

# jumpthread.tcl --
#
#	Compiler passes to perform jump threading 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.
#
#------------------------------------------------------------------------------

# Jump threading is a surprisingly important optimization in the
# processing of quadcode. The reason is that it allows for separation
# of paths that would otherwise require boxing and unboxing of values
# at every access.  Consider, for instance, a procedure like:
#
#   proc processRange {a b} {
#       for {set i $a} {$i < $b} {incr i} {
#           doSomethingWith $i
#       }
#   }
#
# At the entry to the [for] loop, nothing is known about the values of
# $a and $b.  The comparison {$i < $b} will therefore be expensive,
# requiring that the types of both $i and $b be identified and either
# string or numeric comparision be performed according to the
# type. Moreover, on return to the top of the loop - after [incr i]
# has been guarantted to produce an integer - in order to keep types
# consistent at the phi operation at the type of the loop, $i will be
# widened to a string again, forcing it to be boxed in a Tcl object.
#
# While the particular case of $i could be addressed by 'loop
# peeling', duplicating the loop body so that the problematic first
# iteration executes separately from the others, the comparison
# {$i < $b} is not helped by loop peeling. On each trip through the loop,
# $b's type will be checked, and its value (which is almost certain
# to be an integer) will be unboxed.
#
# Jump threading addresses this issue by splitting the path from the
# detection of the type of $b to the next use of $b, so that numeric
# and non-numeric values for $b will take separate paths throughout
# the code.
#
# The drawback to jump threading is that it can possibly result in a
# combinatorial explosion in code volume. For this reason, there need
# to be safety checks and triage to only the most promising
# opportunities.
#
#
# Most of the algorithms used in this module derive indirectly from:
#
# [Prie17] Priesner, Joachim. 'Generalized jump threading in libFIRM."
# Masterarbeit, Fakultät für Informatik, Institut für
# Programmstrukturen und Dantenorganisation (IPD), Karlsruher Institut
# für Technologie (January 2017).
# https://pp.ipd.kit.edu/uploads/publikationen/priesner17masterarbeit.pdf
#
# Priesner's work, however, deals chiefly with threading of
# conditional branches and conditions involving Presburger arithmetic,
# rather than type assertions surrounding values in a dynamic
# language, so a fair amount of rethinking is present here. Instead of
# considering a threading opportunity as a sequence of basic blocks
# (with a conditional jump at the penultimate block), the logic here
# considers a threading opportunity in terms of a sequence of
# operations (reduced to a walk in the flowgraph) from an assignment
# to a value that gives it a known type (possibly this can be expanded
# to other constraints) to a use of the value that can be deleted from
# the program if a given constraint is satisfied. The basic data flow
# analysis, however - accumulate anticipated decisions from back to
# front in the program, and then accumulate threading opportunities
# from front to back - follows the general ideas in Priesner's thesis.
 
# Map from instructions to the types that trigger their removal.
# An instruction is removable if its sole operand matches the
# type expression 'is $TYPE' or 'isnot $TYPE'

namespace eval quadcode {

    # jt_removable carries the instructions that jump threading is trying
    # to let the optimizer rewrite, together with they type conditions
    # that the instructions are testing.

    variable jt_removable

    proc init {} {

        variable jt_removable
        namespace upvar ::quadcode::dataType \
            ARRAY ARRAY CONST0 CONST0 FAIL FAIL IMPURE IMPURE NEXIST NEXIST

        dict set jt_removable "arrayExists" \
            [list [list is $ARRAY] [list isnot $ARRAY]]

        dict set jt_removable "exists" \
            [list [list is $NEXIST] [list isnot $NEXIST]]

        dict set jt_removable "initArrayIfNotExists" \
            [dict get $jt_removable "exists"]

        dict set jt_removable "initIfNotExists" \
            [dict get $jt_removable "exists"]

        dict set jt_removable "jumpFalse" \
            [list [list is $CONST0] [list isnot $CONST0]]

        dict set jt_removable "jumpMaybe" \
            [list [list is $FAIL] [list isnot $FAIL]]

        dict set jt_removable "jumpTrue" \
            [dict get $jt_removable "jumpFalse"]

        dict set jt_removable "purify" \
            [list [list isnot $IMPURE]]

        dict set jt_removable "result" \
            [list [list is $FAIL] [list isnot $FAIL]]

        dict set jt_removable "returnCode" \
            [list [list is $FAIL] [list isnot $FAIL]]

        dict set jt_removable "returnOptions" \
            [list [list is $FAIL] [list isnot $FAIL]]

        rename init {}
    }

    init
}
 
# quadcode::transformer method jumpthread --
#
#	Performs jump threading on a quadcode sequence.
#
# Results:
#
#	Returns 1 if the sequence was modified, 0 otherwise.
#
# Side effects:
#
#	Performs nearly arbitrary surgery on the sequence. While ud-
#	and du-chains are kept up to date, and critical edges will be
#	split, the dominance tree will need to be rebuilt, and the
#	resulting program may contain unreachable code, basic blocks
#	subject to coalescence, constants that need folding, redundant
#	conditional jumps, chains of copy operations, and similar
#	messes that need tidying. Type analysis will also need to be
#	repeated.

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

    my debug-jumpthread {
	puts "Before jump threading"
	my dump-bb
    }

    # Unpack phi operations into the jt_phis, which is a multilevel
    # dictionary. [dict get $jt_phis $b $v $p], where $b is a basic block
    # number, $v is a variable and $p is the basic block number of a
    # predecessor of $b, identifies the data source in $p that corresponds to
    # variable $v in $b.

    my jt_unpackPhis

    # Identify sets of conditions that may benefit from threading.  The
    # conditionals appear in the dictionary jt_condition and are identified by
    # number. The anticipability of the conditions is tracked in jt_antin,
    # which records what conditions are anticipable at the start of each basic
    # block.

    my jt_backward

    # Identify which subsets of the conditions are reachable on specific
    # control flow paths, so that blocks can be replicated to have known
    # entry conditions. Also report the (up to two) successors for each
    # variant block.

    my jt_forward

    # Determine whether the division into variants is trying to split
    # anything.

    set changed [my jt_has_multiple_variants]
    if {$changed} {

        # We will be doing a 'violent' rewrite of the control flow. Rather
        # than trying to maintain data flows in the face of this, it is
        # easier to deconstruct SSA form, perform the rewriting using
        # conventional assignments, and then reconvert to SSA.
        my deconstructSSA

        # Split the blocks into the variants computed by jt_forward, and
        # recompute the control flow (bbpred and block successors).
        my jt_split_paths
        my debug-jumpthread {
            puts "After splitting the paths:"
            my dump-bb
        }

        # Splitting the paths may have introduced new critical edges, so
        # make sure that they get resplit. 
        my splitCritical
        my debug-jumpthread {
            puts "After splitting critical edges:"
            my dump-bb
        }

        # Splitting critical edges requires that topologic order be restored
        # to the blocks.
        my sortbb
        my debug-jumpthread {
            puts "After re-sorting basic blocks:"
            my dump-bb
        }

        # Restore SSA form, compute ud- and du-chains, and propagate copies.
        my ssa
        my debug-jumpthread {
            puts "After reconstructing SSA:"
            my dump-bb
        }
        my ud_du_chain
        my copyprop

        # The code should now be ready to repeat type analysis and cleanup
        # optimizations.

    }
        
    # Clean up the working storage
    
    my jt_cleanup

    return $changed
}
 
# quadcode::transformer method jt_unpackPhis --
#
#	Unpacks phi operations for fast lookup when doing jump threading.
#
# Results:
#
#	None.
#
# Side effects:
#
#	Creates a multilevel dictionary $jt_phis. If value $v is the result of
#	a phi in basic block $b, and $p is a predecessor block of $b, then
#	[dict get $jt_phis $b $v $p] will give the corresponding value in $p.

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

    my variable jt_phis

    set jt_phis {}

    set b -1
    foreach bb $bbcontent {
	incr b

	set pc -1
	foreach q $bb {
	    incr pc

	    if {[lindex $q 0 0] ne "phi"} break

	    set v [lindex $q 1]
	    foreach {source w} [lrange $q 2 end] {
		set p [lindex $source 1]
		dict set jt_phis $b $v $p $w
	    }
	}
    }

    return

}
 
# quadcode::transformer method jt_backward --
#
#	Perform one or more passes of backward data flow analysis
#	in support of jump threading.
#
# Results:
#	None.
#
# Side effects:
#
#	Constructs the list, jt_antin, indexed by basic block number,
#	containing dictionaries.  The dictionaries describe the conditions
#	that will inform jump threading downstream of the entry to the basic
#	blocks. The dictionaries have two levels. The first level key gives
#	the name of a value in the quadcode, and the second gives a condition
#	on that value's type.  The second key is either 'is TYPECONST'
#	or 'isnot TYPECONST' for a given value in quadcode::dataType.
#	The values in the dictionary are ordinal numbers of conditions in the
#	block, and will be used to construct bit vectors of what conditions
#	are satisfied in a copy of the block.

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

    namespace upvar ::quadcode jt_removable jt_removable

    my variable jt_antin
    set jt_antin [lrepeat [llength $bbcontent] {}]

    set changed 1
    while {$changed} {
        set changed 0

        my debug-jumpthread {
            puts "Start a pass of anticipability for jump threading"
        }

        foreach b [my bbrorder] {
            set bb [lindex $bbcontent $b]

            my debug-jumpthread {
                puts "bb $b:"
            }
            # Construct the conditions anticipable on output. It is
            # possible that the conditions will refer to literals,
            # in which case any possible threading opportunity will begin
            # on the exit from this block to the successor.
            set antout {}
            foreach s [my bbsucc $b] {
                dict for {w conds} [lindex $jt_antin $s] {
                    set v [my jt_translate_phi $s $w $b]
                    dict for {c -} $conds {
                        dict set antout $v $c {}
                    }
                }
            }

            # Construct the conditions anticipable on input. Begin by
            # filtering any constant conditions out of the output conditions.

            set antin {}
            dict for {v conds} $antout {
                if {[lindex $v 0] in {"temp" "var"}} {
                    dict set antin $v $conds
                }
            }

            # Run backward through the instructions in the current block.
            # Remove any conditions that depend on instructions in the
            # block. Add any conditions that inform the removal of instructions
            # in the block.

            set pc [llength $bb]
            while {$pc > 0} {
                incr pc -1
                set q [lindex $bb $pc]
                lassign $q opcode dest source1
                set op [lindex $opcode 0]
                switch -exact -- $op {

                    phi {

                        # At a phi, we're done with the content of this
                        # block.
                        break
                    }

                    copy {

                        # For a copy, the conditions on the destination
                        # turn into conditions on the source
                        set conds {}
                        if {[dict exists $antin $dest]} {
                            foreach {c -} [dict get $antin $dest] {
                                dict set antin $source1 $c {}
                            }
                            dict unset antin $dest
                        }
                    }

                    instanceOf {

                        # For instanceOf, the conditions are that the
                        # value is definitely/is definitely not an
                        # instance of the given type.
                        set wanted [lindex $opcode 1]
                        dict set antin $source1 [list is $wanted] {}
                        dict set antin $source1 [list isnot $wanted] {}
                        dict unset antin $dest
                    }

                    default {

                        # Otherwise, if this is an instruction that might
                        # be removed depending on the type of its operand,
                        # record what that type is.
                        if {[dict exists $jt_removable $op]} {
                            foreach c [dict get $jt_removable $op] {
                                dict set antin $source1 $c {}
                            }
                        }
                        dict unset antin $dest
                    }
                }
            }

            if {$antin ne [lindex $jt_antin $b]} {
                set changed 1
                lset jt_antin $b $antin
                my debug-jumpthread {
                    puts "  bb $b: anticipable conditions:"
                }
                set cn -1
                dict for {v conds} $antin {
                    foreach c [dict keys $conds] {
                        lassign $c what type
                        my debug-jumpthread {
                            puts "    [incr cn]: $v $what $type\
                                      ([nameOfType $type])"
                        }
                    }
                }
            }
        }
    }

    return
}
 
# quadcode::transformer method jt_translate_phi --
#
#	Given a variable in a successor block, finds out what the
#	corresponding variable in the predecessor block is.
#
# Parameters:
#	b - Successor block
#	v - Variable name
#	p - Predecessor block
#
# Results:
#	Returns the name of the corresponding variable in the predecessor

oo::define quadcode::transformer method jt_translate_phi {b v p} {

    my variable jt_phis
    
    if {[dict exists $jt_phis $b $v $p]} {
        return [dict get $jt_phis $b $v $p]
    } else {
        return $v
    }
}
 
# quadcode::translate method jt_forward --
#
#	Works through the forward propagation of knowledge about the
#	program to determine what sets of conditions should be assumed
#	in basic blocks prior to attempting to split them.
#
# Results:
#	None.
#
# Side effects:
#
#	The ultimate output of this procedure is a list, 'jt_variants',
#	with one entry per basic block of the original sequence. The
#	elements of the list are dictionaries whose keys are bit vectors
#	that specify the set of anticipated conditions that are satisfied
#	in a desired copy of the block. The values are lists of up to two
#	bit vectors, that give the sets of anticipated conditions that
#	are satisfied in the block's successors.

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

    # jt_stack is a list of alternating basic block number and
    # condition bit vector, used to track work that still needs to be
    # done.
    my variable jt_stack
    my variable jt_variants

    my debug-jumpthread {
        puts "Begin forward jump threading analysis for [my full-name]"
    }

    # Initially, the work list contains just the entry node, and
    # nothing is known on entry to it (there shouldn't
    # be any anticipated conditions there!)
    set jt_stack [list 0 0]
    set jt_variants [lrepeat [llength $bbcontent] {}]
    lset jt_variants 0 {0 {}}
    
    # Pop entries off the worklist and process them

    while {[llength $jt_stack] > 0} {
        set b [lindex $jt_stack end-1]
        set condMask [lindex $jt_stack end]
        set jt_stack [lreplace $jt_stack[set jt_stack ""] end-1 end]

        my jt_forward_worker $b $condMask
    }

    return
}
 
# quadcode::transformer method jt_forward_worker --
#
#	Performs forward jump threading analysis through one basic
#	block, propagating facts into the successors.
#
# Parameters:
#	b - Basic block being analyzed
#	mask - Mask identifying the conditions that are promised on
#	       entry to the block.
#
# Results:
#	None.
#
# Side effects:
#	For each successor to the block, propagates the promised
#	conditions forward into the successor. If the successor has
#	a set of conditions that has not yet been visited, adds it
#	to 'jt_variants' and stacks it for processing.

oo::define quadcode::transformer method jt_forward_worker {b mask} {

    namespace upvar ::quadcode::dataType ARRAY ARRAY CONST0 CONST0 \
        CONST1 CONST1 IMPURE IMPURE NEXIST NEXIST ZEROONE ZEROONE

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

    # Find out what assertions are guaranteed by $mask
    set asserted [my jt_maskToAssertions $b $mask]

    # Narrow the types of variables flowing into the block, according
    # to the assertions.
    set localtypes [my jt_applyAllAssertions $asserted]

    # Analyze the instructions of the block in the forward direction.
    # If an instruction is one that participates in jump threading, update
    # the assertions that apply to the block accordingly. If the instruction
    # is a threaded jump, set up to process the block's successor(s).
    
    set bb [lindex $bbcontent $b]
    set pc -1
    foreach q $bb {
        incr pc

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

        lassign $q opcode result operand1
        lassign $opcode op totype typename
        set fromtype [my jt_localtype $operand1 $localtypes]

        switch -exact -- $op {

            "arrayExists" {
                if {[quadcode::dataType::isa $fromtype $ARRAY]} {
                    dict set localtypes $result $CONST1
                } elseif {![quadcode::dataType::mightbea $fromtype $ARRAY]} {
                    dict set localtypes $result $CONST0
                } else {
                    dict set localtypes $result $ZEROONE
                }
            }

            "copy" {
                dict set localtypes $result $fromtype
            }

            "exists" {
                if {$fromtype == $NEXIST} {
                    dict set localtypes $result $CONST0
                } elseif {!($fromtype & $NEXIST)} {
                    dict set localtypes $result $CONST1
                } else {
                    dict set localtypes $result $ZEROONE
                }
            }

            "instanceOf" {
                if {[quadcode::dataType::isa $fromtype $totype]} {
                    dict set localtypes $result $CONST1
                } elseif {![quadcode::dataType::mightbea $fromtype $totype]} {
                    dict set localtypes $result $CONST0
                } else {
                    dict set localtypes $result $ZEROONE
                }
            }
            
            "jump" {
                my jt_processSuccessor $b $mask \
                    [lindex $result 1] $localtypes
                break
            }

            "jumpFalse" {
                set falsebranch [lindex $result 1]
                set truebranch [lindex $bb end 1 1]
                my jt_processCondBranch $b $mask \
                    $fromtype $truebranch $falsebranch $localtypes
                break
            }

            "jumpTrue" {
                set truebranch [lindex $result 1]
                set falsebranch [lindex $bb end 1 1]
                my jt_processCondBranch $b $mask \
                    $fromtype $truebranch $falsebranch $localtypes
                break
            }

            "jumpMaybe" {
                set failbranch [lindex $result 1]
                set okbranch [lindex $bb end 1 1]
                my jt_processJumpMaybe $b $mask \
                    $fromtype $failbranch $okbranch $localtypes
                break
            }

            "narrowToType" {
                dict set localtypes $result [expr {$fromtype & $totype}]
            }

            "phi" {
                if {![dict exists $localtypes $result]} {
                    dict set localtypes $result [dict get $types $result]
                }
            }

            "purify" {
                dict set localtypes $result [expr {$fromtype & ~$IMPURE}]
            }

            default {
                if {[lindex $result 0] in {"temp" "var"}} {
                    dict set localtypes $result [dict get $types $result]
                }
            }
        }

        my debug-jumpthread {
            if {[lindex $result 0] in {"temp" "var"}} {
                puts [format "      local type of %s is %#llx (%s)" \
                          $result [dict get $localtypes $result] \
                          [nameOfType [dict get $localtypes $result]]]
            }
        }
    }

    return
}
 
# quadcode::transformer method jt_processCondBranch --
#
#	Updates the state when jump threading encounters a conditional
#	branch.
#
# Parameters:
#	b - Predecessor block
#	mask - Bit vector identifying assertions satisfied in the predecessor
#	otype - Type of the conditional jump operand
#	truebranch - Successor block if the operand is true
#	falsebranch - Successor block if the operand is false
#	localtypes - Dictionary giving types of variables that are
#	             overridden by assertions made in jump threading.
#
# Results:
#	None.
#
# Side effects:
#	One or both successors is added to the successors of the block.

oo::define quadcode::transformer method jt_processCondBranch {b mask otype
                                                              truebranch
                                                              falsebranch
                                                              localtypes} {
    namespace upvar ::quadcode::dataType CONST0 CONST0

    my debug-jumpthread {
        puts "      block $b branches to $truebranch or $falsebranch"
        puts [format "      and might be optimized based on %#llx (%s)" \
                  $otype [nameOfType $otype]]
    }

    # Include the true branch if it represents a possible condition

    if {[quadcode::dataType::isa $otype $CONST0]} {
        my debug-jumpthread {
            puts "        branch to $truebranch cannot be taken"
        }
    } else {
        my jt_processSuccessor $b $mask $truebranch $localtypes
    }

    # Include the false branch if it represents a possible condition

    if {![quadcode::dataType::mightbea $otype $CONST0]} {
        my debug-jumpthread {
            puts "        branch to $falsebranch cannot be taken"
        }
    } else {
        my jt_processSuccessor $b $mask $falsebranch $localtypes
    }

    return
}
 
# quadcode::transformer method jt_processJumpMaybe --
#
#	Updates the state when jump threading encounters a
#	jumpMaybe instruction
#
# Parameters:
#	b - Predecessor block
#	mask - Bit vector identifying assertions satisfied in the predecessor
#	otype - Type of the conditional jump operand
#	failbranch - Successor block if the operand represents a failure
#	okbranch - Successor block if the operand represents a success
#	localtypes - Dictionary giving types of variables that are
#	             overridden by assertions made in jump threading.
#
# Results:
#	None.
#
# Side effects:
#	One or both successors is added to the successors of the block.

oo::define quadcode::transformer method jt_processJumpMaybe {b mask otype
                                                             failbranch
                                                             okbranch
                                                             localtypes} {
    namespace upvar ::quadcode::dataType FAIL FAIL

    my debug-jumpthread {
        puts "      block $b branches to $failbranch or $okbranch"
        puts [format "      and might be optimized based on %#llx (%s)" \
                  $otype [nameOfType $otype]]
    }

    # Include the true branch if it represents a possible condition

    if {[quadcode::dataType::isa $otype $FAIL]} {
        my debug-jumpthread {
            puts "        branch to $okbranch cannot be taken"
        }
    } else {
        my jt_processSuccessor $b $mask $okbranch $localtypes
    }

    # Include the false branch if it represents a possible condition

    if {![quadcode::dataType::mightbea $otype $FAIL]} {
        my debug-jumpthread {
            puts "        branch to $failbranch cannot be taken"
        }
    } else {
        my jt_processSuccessor $b $mask $failbranch $localtypes
    }

    return
}
 
# quadcode::transformer method jt_processSuccessor --
#
#	Updates the state when jump threading handles a jump that
#	proceeds from a given predecessor block to its successor.
#
# Parameters:
#	b - Predecessor block
#	mask - Bit vector identifying assertions satisfied in the predecessor
#	s - Successor block
#	localtypes - Dictionary giving types of variables that are
#	             overridden by assertions made in jump threading.
#
# Results:
#	None.
#
# Side effects:
#	Determines the assertions satisfied in the successor block.
#	Records that set in the predecessor's 'jt_variants' record.
#	If the successor block has not yet been visited, creates a
#	'jt_variants' record for it, and pushes the block onto 'jt_stack'
#	for processing.

oo::define quadcode::transformer method jt_processSuccessor {b mask s
                                                             localtypes} {
    my variable jt_variants
    my variable jt_stack

    # Find the assertion mask for the successor block

    set smask [my jt_assertionsToMask $b $mask $localtypes $s]

    my debug-jumpthread {

        puts [format {  bb %s (%#llx) will be followed by %s (%#llx)} \
                  $b $mask $s $smask]
    }

    # If the successor block has not been seen, we will need subsequently
    # to process it.

    set vs [lindex $jt_variants $s]
    if {![dict exists $vs $smask]} {
        lset jt_variants $s {}
        dict set vs $smask {}
        lset jt_variants $s $vs
        lappend jt_stack $s $smask
    }

    # Record that the successor follows this block

    set vs [lindex $jt_variants $b]
    lset jt_variants $b {}
    dict set vs $mask $s $smask
    lset jt_variants $b $vs

    return
}
 
# quadcode::transformer method jt_maskToAssertions --
#
#	Takes the bitmask corresponding to the conditions asserted at the
#	entry to a basic block, and expands to a full dictionary of assertions
#
# Return value:
#
#	Returns a dictionary var -> {kind type} -> cn
#	where var is the name of a variable
#	      kind is 'is' or 'isnot'
#	      type is the numeric code for a data type
#	      cn is the condition's position in the set of conditions for b

oo::define quadcode::transformer method jt_maskToAssertions {b mask} {

    my variable jt_antin
    set antin [lindex $jt_antin $b]
    set asserted {}

    my debug-jumpthread {
        puts [format "   anticipated on entry to %s (%#llx):" $b $mask]
    }

    set cn -1
    dict for {v conds} $antin {
        dict for {c -} $conds {
            incr cn
            my debug-jumpthread {
                puts "        $cn: $v $c"
            }
            if {$mask & (1 << $cn)} {
                dict set asserted $v $c $cn
            }
        }
    }

    my debug-jumpthread {
        puts "   asserted on entry:"
        set cn -1
        dict for {v conds} $asserted {
            dict for {c -} $conds {
                incr cn
                puts "        $cn: $v $c"
            }
        }
    }

    return $asserted
}
 
# quadcode::transformer method jt_applyAllAssertions --
#
#	Applies all the assertions that are active at the start of a block
#	and creates a dictionary holding narrowed types of variables
#
# Parameters:
#	asserted - Dictionary of the form var->{kind type}->cond#
#		where var is the name of a variable
#		      kind is 'is' or 'isnot'
#		      type is the numeric code for a data type
#	              cond# is an ordinal number of the condition in a
#		            block's list of conditions
#
# Results:
#	Returns a dictionary whose keys are variable names and whose
#	values are type codes of the narrowed data types.
#
# Used to calculate the initial data types of tracked variables on entry
# to a block.

oo::define quadcode:::transformer method jt_applyAllAssertions {asserted} {

    set localtypes {}

    my debug-jumpthread {
        puts "    Type calculated on entry:"
    }

    foreach {v conds} $asserted {
        set globaltype [dict get $types $v]
        my debug-jumpthread {
            puts [format {      %s global type %#llx (%s)} \
                      $v $globaltype [nameOfType $globaltype]]
        }
        set localtype [my jt_applyAssertions $globaltype $conds]
        dict set localtypes $v $localtype
        my debug-jumpthread {
            puts [format {      %s local  type %#llx (%s)} \
                      $v $localtype [nameOfType $localtype]]
        }
    }

    return $localtypes
}
 
# quadcode::transformer method jt_applyAssertions --
#
#	Apply assertions about a value to its type descriptor to produce
#	a narrowed type
#
# Parameters:
#	ty - Type to narrow
#	as - Assertions to apply, expressed as a dictionary:
#		{kind type}->cond#
#		where kind is 'is' or 'isnot'
#      		      type is the numeric code of a data type
#		      cond# is the ordinal number of the condition among
#		            the conditions applicable at the start of a block.
#
# Results:
#	Returns the narrowed type.

oo::define quadcode::transformer method jt_applyAssertions {ty as} {

    namespace upvar ::quadcode::dataType \
        ARRAY ARRAY FAIL FAIL IMPURE IMPURE NEXIST NEXIST

    dict for {c -} $as {
        lassign $c kind type
        switch -exact -- $kind {
            is {
                set mask $type
            }
            isnot {
                set mask [quadcode::dataType::allbut $type]
            }
        }
        if {$type & ~($ARRAY | $FAIL | $IMPURE | $NEXIST)} {
            set mask [expr {$mask | $IMPURE}]
        }
        set ty [expr {$ty & $mask}]
            
    }

    return $ty
}
 
# quadcode::transformer method jt_assertionsToMask
#
#	Given a predecessor block, the types of objects assigned to in the
#	predecessor block, and a mask of anticipated conditions satisfied at
#	the entry to the predecessor block, determines the mask of assertions
#	satisfied at the entry to the successor block.
#
# Parameters:
#	p - Predecessor block
#	pmask - Bit vector specifying the anticipated conditions satisfied
#	        at entry to block $p.
#	ptypes - Dictionary keyed by variable name giving the types of
#	         values assigned in block $p
#	s - Successor block.
#
# Results:
#	Returns a bit vector of anticipated conditions satisfied at entry
#	to block $s.

oo::define quadcode::transformer method jt_assertionsToMask {p pmask ptypes s} {

    my variable jt_antin

    my debug-jumpthread {
        puts "\t    make assertion mask for $p -> $s"
    }

    set smask 0
    set cn -1
    dict for {v conds} [lindex $jt_antin $s] {
        dict for {c -} $conds {
            incr cn
            if {[my jt_test_assertion $p $pmask $ptypes $s $v $c]} {
                my debug-jumpthread {
                    puts "\t      include $v $c"
                }
                set smask [expr {$smask | (1 << $cn)}]
            }
        }
    }
    return $smask
}
 
# quadcode::transformer method jt_test_assertion --
#
#	Tests whether an anticipated condition is satisfied at the entry of
#	successor block $s from predecessor block $p.
#
# Parameters:
#	p - Predecssor block
#	pmask - Mask of bits indicating which of p's anticipated conditions
#	        are satisfied.
#	ptypes - Dictionary whose keys are the names of values defined in p
#	         and whose values are the types of the values.
#	s - Successor block
#	v - Variable name in the successor block
#	cond - Condition being tested
#
# Results:
#	Returns 1 if the condition is satisfied, 0 otherwise

oo::define quadcode::transformer method jt_test_assertion {p pmask ptypes
                                                           s v cond} {
    namespace upvar ::quadcode::dataType NEXIST NEXIST

    lassign $cond kind t

    # Find the name of the variable in the predecessor
    set w [my jt_translate_phi $s $v $p]

    if {$w eq "Nothing"} {
        set u $NEXIST
    } elseif {[lindex $w 0] eq "literal"} {

        # The operand is a literal - extract its data type
        set u [::quadcode::typeOfLiteral [lindex $w 1]]
    } elseif {[dict exists $ptypes $w]} {

        # The operand is defined in the predecessor block, get its type
        set u [dict get $ptypes $w]
    } else {

        # The operand is not defined in the predecessor block, get its
        # conditions from the anticipable conditions in the predecessor
        return [my jt_masked_condition $p $pmask $w [list $kind $t]]
    }

    # We have the type of the operand created in the predecessor block.
    # Determine whether it satisfies the condition
    switch -exact -- $kind {
        is {
            return [my jt_type_is $u $t]
        }
        isnot {
            return [my jt_type_isnot $u $t]
        }
        default {
            return -code error error "bad condition $kind, can't happen"
        }
    }
}
 
# quadcode::transformer method jt_masked_condition --
#
#	Tests whether a block with a given mask of satisfied conditions
#	satisfies a particular named condition
#
# Parameters:
#	b - Block whose condition is being tested
#	mask - Bit mask indicating what numbered conditions are satisfied
#	v - Variable to which the desired condition applies
#	cond - Condition to test
#
# Results:
#	Returns 1 if the given condition is asserted, 0 otherwise.

oo::define quadcode::transformer method jt_masked_condition {b mask v cond} {

    my variable jt_antin

    if {![dict exists $jt_antin $b $v $cond]} {

        # The condition is not anticipable in the predecessor. This
        # should not happen!
        return 0
    } 

    # The condition is anticipated in the predecessor. Find out whether
    # it is asserted there.
    set bit [dict get $jt_antin $b $v $cond]
    if {$mask & (1 << $bit)} {
        return 1
    } else {
        return 0
    }
}
 
# quadcode::transformer method jt_localtype --
#
#	Returns the type of a quadcode operand taking into account
#	local type assertions.
#
# Parameters:
#	opd - Operand being analyzed
#	localtypes - Dictionary giving locally asserted types of variables
#
# Results:
#	Returns the type of the operand, or 0 if the operand does not
#	represent a value.

oo::define quadcode::transformer method jt_localtype {opd localtypes} {

    namespace upvar ::quadcode::dataType NEXIST NEXIST

    switch -exact -- [lindex $opd 0] {
        "Nothing" {
            return $NEXIST
        }
        "literal" {
            return [quadcode::typeOfLiteral [lindex $opd 1]]
        }
        "temp" - "var" {
            if {[dict exists $localtypes $opd]} {
                return [dict get $localtypes $opd]
            } else {
                return [dict get $types $opd]
            }
        } default {
            return 0
        }
    }
}

 
# quadcode::transformer method jt_type_is --
#
#	Tests whether one type is always an instance of another.
#
# Parameters:
#	u - Type being tested
#	v - Reference type
#
# Results:
#	Returns 1 if u is always an instance of t, 0 otherwise.
#
# Notes:
#	Ignores the IMPURE bit unless it is being tested specifically.

oo::define quadcode::transformer method jt_type_is {u v} {
    namespace upvar ::quadcode::dataType IMPURE IMPURE
    if {($v == $IMPURE)} {
        return [expr {$u == $IMPURE}]; # Can't be true
    } elseif {[quadcode::dataType::isa $u $v]} {
        return 1
    } else {
        return 0
    }
}
 
# quadcode::transformer method jt_type_isnot --
#
#	Tests whether one type is never an instance of another.
#
# Parameters:
#	u - Type being tested
#	t - Reference type
#
# Results:
#	Returns 1 if u is never an instance of t, 0 otherwise.
#
# Notes:
#	Ignores the IMPURE bit unless it is being tested specifically.

oo::define quadcode::transformer method jt_type_isnot {u v} {
    namespace upvar ::quadcode::dataType IMPURE IMPURE
    if {($v == $IMPURE)} {
        return [expr {($u & $IMPURE) == 0}]; # Can't be true
    } elseif {[quadcode::dataType::mightbea $u $v]} {
        return 0
    } else {
        return 1
    }
}
 
# quadcode::transformer method jt_has_multiple_variants --
#
#	Determine whether jump threading has found any work to do.
#
# Results:
#	Returns 1 if the program should be rewritten, 0 otherwise.

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

    my variable jt_variants

    my debug-jumpthread {
        puts "Variants found:"
        set b -1
        foreach vs $jt_variants {
            incr b
            dict for {m ss} $vs {
                puts [format "  %d (%llx): %s" $b $m $ss]
            }
        }
    }

    set b -1
    foreach vs $jt_variants {
        incr b
        if {[dict size $vs] > 1} {
            return 1
        }
    }

    return 0
}
 
# quadcode::transformer method jt_split_paths --
#
#	Duplicates basic blocks in the program to allow for jump threading.
#
# Results:
#	None.
#
# Side effects:
#	The 'bbcontent' array is augmented to hold the additional copies.
#	The 'bbpred' array is updated to reflect the revised control flows.

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

    # Destroy the predecessor relation. It will be recomputed as we
    # reconstruct the control flow
    set bbpred [lrepeat [llength $bbcontent] {}]

    # Make the required number of copies of each basic block
    set bmap [my jt_duplicate_blocks]

    # Rewrite the jumps at the end of each block to go to the new block.
    my jt_retarget_jumps $bmap
    
    return
}
 
# quadcode::transformer method jt_duplicate_blocks --
#
#	Makes the required number of duplicates of each block in the
#	program when performing jump threading.
#
# Results:
#	Returns a dictionary, bmap,  where
#	    [dict get $bmap $block $variant]
#	gives the number of the basic block in the new program that
#	corresponds to the requeste variant in the old program.

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

    my variable jt_variants

    # Make the required number of duplicates of each basic block.
    set newcontent {}
    set bmap {}
    set b -1
    set newb -1
    foreach vs $jt_variants bb $bbcontent {
        incr b
        lappend bbpred {}
        dict for {mask -} $vs {
            dict set bmap $b $mask [incr newb]
            lappend newcontent $bb
            my debug-jumpthread {
                puts [format "  Block %d (%#llx) -> new block %d" \
                          $b $mask $newb]
            }
        }
    }
    set bbcontent $newcontent
    return $bmap
}
 
# quadcode::transformer method jt_retarget_jumps --
#
#	Rewrites the jump instructions at the end of blocks after
#	performing block copying for jump threading.
#
# Parameters:
#	bmap - Dictionary describing where to find block copies.
#	       [dict get $bmap $b $variant] is the block number in
#	       the new program corresponding to variant $variant of
#	       block $b in the old program.
#
# Results:
#	None.
#
# Side effects:
#	Rewrites the jumps in the program, and re-establishes the control
#	flow graph.
#
# The rewrites encompass several cases:
#
#	0  - The block has no exits, do nothing
#	1a - The block has 1 exit, and the original had 1. End the
#	     block with an unconditional jump
#	1b - The block has 1 exit, but the original had 2. End the block
#	     with an unconditional jump, deleting any conditional jump that
#	     may have been there.
#	2  - The block has 2 exits, Rewrite both jumps to target the correct
#	     copies of the successor.

oo::define quadcode::transformer method jt_retarget_jumps {bmap} {

    my variable jt_variants

    # Walk through the blocks of the original program
    set b -1
    set oldb -1
    foreach vs $jt_variants {
        incr oldb

        # Walk through the variants, which are the blocks of the new program.
        dict for {mask targets} $vs {
            incr b
            set bb [lindex $bbcontent $b]
            lset bbcontent $b {}

            # How many jumps need to be rewritten in the block?
            
            switch -exact -- [dict size $targets] {

                0 {
                    # 0-exit block - do nothing
                    my debug-jumpthread {
                        puts "        Block $b has no exits"
                    }
                }

                1 {
                    # 1-exit block
                    if {[lindex $bb end-1 1 0] eq "bb"} {
                        my debug-jumpthread {
                            puts "        Block $b: reduce a 2-exit block\
                                          to 1-exit"
                        }
                        # Original block was two-exit
                        set start end-1
                    } else {
                        my debug-jumpthread {
                            puts "        Block $b has one exit"
                        }
                        # Original block was one-exit
                        set start end
                    }
                    # Replace jump(s) at the end of the block
                    dict for {bwas mask} $targets break
                    set newtarget [dict get $bmap $bwas $mask]
                    set newq [list jump [list bb $newtarget]]
                    set bb [lreplace $bb[set bb ""] $start end $newq]
                    my bblink $b $newtarget
                    my debug-jumpthread {
                        puts "  $b:end: $newq   # $bwas ([format %llx $mask])"
                    }
                }

                2 {
                    my debug-jumpthread {
                        puts "        Block $b has two exits"
                    }
                    # Two-exit block - rewrite the jumps
                    set q [lindex $bb end-1]
                    set newq [my jt_retarget $q $targets $bmap]
                    lset bb end-1 $newq
                    my bblink $b [lindex $newq 1 1]
                    my debug-jumpthread {
                        puts "  $b:end-1: $newq"
                    }
                    
                    set q [lindex $bb end]
                    set newq [my jt_retarget $q $targets $bmap]
                    lset bb end $newq
                    my bblink $b [lindex $newq 1 1]
                    my debug-jumpthread {
                        puts "  $b:end: $newq"
                    }
                }
            }

            # Put the basic block content back.
            lset bbcontent $b $bb
        }
    }

    return
}
 
# quadcode::transformer method jt_retarget --
#
#	Rewrites a single jump instruction during jump threading.
#
# Parameters:
#	q - Jump instruction being rewritten
#	targets - Dictionary whose keys are jump targets in the original
#	          program and whose values are block variants for those
#	          targets
#	bmap - Dictionary describing where to find the block variants.
#	       [dict get $bmap $b $variant] gives the basic block
#	       number in the new program corresponding to variant $variant
#	       of block $b in the original program.
#
# Results:
#	Returns the rewritten instruction.

oo::define quadcode::transformer method jt_retarget {q targets bmap} {

    set tgt [lindex $q 1 1]
    set var [dict get $targets $tgt]
    lset q 1 1 [dict get $bmap $tgt $var]

    return $q
}
 
# quadcode::transformer method jt_cleanup --
#
#	Cleans up working storage after the jump threading pass.
#
# Results:
#	None.

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

    my variable jt_antin
    my variable jt_phis
    my variable jt_stack
    my variable jt_variants

    unset -nocomplain jt_antin
    unset -nocomplain jt_phis
    unset -nocomplain jt_stack
    unset -nocomplain jt_variants

    return
}
 
# Local Variables:
# mode: tcl
# fill-column: 78
# auto-fill-function: nil
# buffer-file-coding-system: utf-8-unix
# indent-tabs-mode: nil
# End:

# nodesplit.tcl --
#
#	Code to update quadcode sequences by node splitting - to attempt
#	to isolate paths that operate on different data types, particularly
#	within loops.
#
# Copyright (c) 2017 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.
#
#------------------------------------------------------------------------------

#-----------------------------------------------------------------------------
#
# Why do we want to do node splitting on quadcode sequences, and what do
# we expect the results to be?
#
# A program like:
#
#	proc x {a b c} {
#	    set x 0
#	    for {set i $a} {$i < $b} {incr i $c} {
#               set x [expr {$x + $i}]
#           }
#	    return $x
#       }
#
# gives rise to performance trouble at runtime. It turns into code like
# the following. For clarity, error handling code is omitted, and the
# dummy blocks that result from critical edge splitting (and eventually
# acquire type widening and memory management code) also are not shown.
#
#-----------------------------------------------------------------------------
#
# 1: a1 := args[0]		// STRING <- STRING
#    b1 := args[1]		// STRING <- STRING
#    c1 := args[2]              // STRING <- STRING
#
# 2: b2 := phi(b1{1}, b3{7})    // STRING <- STRING x IMPURE NUMERIC
#    c2 := phi(c1{1}, c7{7})	// STRING <- STRING x IMPURE NUMERIC
#    i2 := phi(a1{1}, i7{7})    // STRING <- STRING x NUMERIC
#    x2 := phi(0{1}, x5a{7})	// NUMERIC <- ZERO x NUMERIC
#    if i2 is not numeric goto error0 // <- STRING
#    goto 3
#
# 3: i3 := impure numeric(i2)	// IMPURE NUMERIC <- STRING
#    if b2 is not numeric goto error1 // <- STRING
#    goto 4
#
# 4: b4 := impure numeric(b2)	// IMPURE NUMERIC <- STRING
#    t4 := (i3 < b4)            // ZEROONE <- IMPURE NUMERIC x IMPURE NUMERIC
#    if t3 is false goto 7
#    goto 5
#
# 5: x5 = impure numeric(x2)	// IMPURE NUMERIC <- STRING
#    x5a := x5 + i3		// NUMERIC <- IMPURE NUMERIC x IMPURE NUMERIC
#    if c2 is not numeric goto error3 // <- STRING
#    goto 6
#
# 6: c6 := impure numeric(c2)	// IMPURE NUMERIC <- STRING
#    i6 := i3 + c6		// NUMERIC <- IMPURE NUMERIC x IMPURE NUMERIC
#    goto 2
#
# 7: return x2			// <- NUMERIC
#
#-----------------------------------------------------------------------------
#
# There are no fewer than three string-to-numeric conversions, all
# inside the loop. What's more, the three corresponding phi operations promote
# numerics back to strings. What we need is some way to make the string
# conversions happen on only the first and last iterations.
#
# The way we approach this is to do successive block splitting. Whenever
# we encounter values of incompatible types (defined as being a STRING
# and a non-STRING, or an IMPURE object and a pure one, or objects of
# two non-STRING types that will combine to STRING), we know that we likely
# can improve code by splitting the block. This process will unroll at least
# part of the loop, hoisting out the data conversions.
#
# Note that if we are splitting a multi-exit block, we must introduce
# additional dummy blocks because each exit will become a critical edge.
#
# Generally speaking, splitting blocks will give rise to many more
# opportunities to split. We continue until nothing can be split further.
# (There may be a need for a safety check to avoid infinite splits in
# certain pathological cases.)
#
# Let's see what happens as we do this. After one split, we see:
#
#-----------------------------------------------------------------------------
#
# 1: a1 := args[0]		// STRING <- STRING
#    b1 := args[1]		// STRING <- STRING
#    c1 := args[2]              // STRING <- STRING
#
# 2: if a1 is not numeric goto error0 // <- STRING
#    goto 3
#
# 3: b3:= phi(b1{2}, b4{8})    // STRING <- STRING x IMPURE NUMERIC
#    c3 := phi(c1{2}, c6{8})	// STRING <- STRING x IMPURE NUMERIC
#    i3 := phi(a1{2}, i6{8})    // STRING <- STRING x NUMERIC
#    x3 := phi(0{2}, x5a{8})	// NUMERIC <- ZERO x NUMERIC
#    i3a := impure numeric(i3)	// IMPURE NUMERIC <- STRING
#    if b3 is not numeric goto error1 // <- STRING
#    goto 4
#
# 4: b4 := impure numeric(b3)	// IMPURE NUMERIC <- STRING
#    t4 := (i3a < b4)            // ZEROONE <- IMPURE NUMERIC x IMPURE NUMERIC
#    if t4 is false goto 7
#    goto 5
#
# 5: x5 = impure numeric(x3)	// IMPURE NUMERIC <- STRING
#    x5a := x5 + i3a		// NUMERIC <- IMPURE NUMERIC x IMPURE NUMERIC
#    if c3 is not numeric goto error3 // <- STRING
#    goto 6
#
# 6: c6 := impure numeric(c3)	// IMPURE NUMERIC <- STRING
#    i6 := i3a + c6		// NUMERIC <- IMPURE NUMERIC x IMPURE NUMERIC
#    goto 8
#
# 7: return x3			// <- NUMERIC
#
# 8: if i6 is not numeric goto error0 // <- IMPURE NUMERIC
#    goto 3
#
#-----------------------------------------------------------------------------
#
# (There will also be phi's at the start of 'error0'. All error handling is
# omitted for clarity.)
#
# Note that the test in block 8 will always be false, and the existing
# optimizations in 'doTypeChecks' will eliminate it, and the block. But I
# defer reapplying the existing optimizations until all block splitting is
# complete.
#
# Block 3 now becomes a candidate for splitting. After the split, we have:
#
#-----------------------------------------------------------------------------
#
# 1: a1 := args[0]		// STRING <- STRING
#    b1 := args[1]		// STRING <- STRING
#    c1 := args[2]              // STRING <- STRING
#
# 2: if a1 is not numeric goto error0 // <- STRING
#    goto 3
#
# 3: i3 := impure numeric(a1)	// IMPURE NUMERIC <- STRING
#    if b1 is not numeric goto error1 // <- STRING
#    goto 4
#
# 4: b4 := phi(b1{3}, b4a{9})   // STRING <- STRING x IMPURE NUMERIC
#    c4 := phi(c1{3}, c7{9})	// STRING <- STRING x IMPURE NUMERIC
#    i4 := phi(i3{3}, i9{9})    // IMPURE NUMERIC <- IMPURE NUMERIC x NUMERIC
#    x4 := phi(0{3}, x6a{9})	// NUMERIC <- ZERO x NUMERIC
#    b4a := impure numeric(b4)	// IMPURE NUMERIC <- STRING
#    t4 := (i4 < b4)            // ZEROONE <- IMPURE NUMERIC x IMPURE NUMERIC
#    if t4 is false goto 7
#    goto 5
#
# 5: x5 = impure numeric(x4)	// IMPURE NUMERIC <- STRING
#    x5a := x5 + i4		// NUMERIC <- IMPURE NUMERIC x IMPURE NUMERIC
#    if c4 is not numeric goto error3 // <- STRING
#    goto 6
#
# 6: c6 := impure numeric(c4)	// IMPURE NUMERIC <- STRING
#    i6 := i4 + c6		// NUMERIC <- IMPURE NUMERIC x IMPURE NUMERIC
#    goto 8
#
# 7: return x4			// <- NUMERIC
#
# 8: if i6 is not numeric goto error0 // <- IMPURE NUMERIC
#    goto 10
#
# 9: i9 = impure numeric(i7)         // NUMERIC <- NUMERIC
#    if b4a is not numeric goto error1 // <- IMPURE NUMERIC
#    goto 4
#-----------------------------------------------------------------------------
#
# The whole of block 9 consists of redundant operations, which will be
# eliminated. More importantly, the test on a1 has been moved out of
# the loop and will be performed only once. We keep on splitting, hitting
# block 4 next. Phi operations are needed in blocks 5 and 7.
#
#-----------------------------------------------------------------------------
#
# 1: a1 := args[0]		// STRING <- STRING
#    b1 := args[1]		// STRING <- STRING
#    c1 := args[2]              // STRING <- STRING
#
# 2: if a1 is not numeric goto error0 // <- STRING
#    goto 3
#
# 3: i3 := impure numeric(a1)	// IMPURE NUMERIC <- STRING
#    if b1 is not numeric goto error1 // <- STRING
#    goto 4
#
# 4: b4 := impure numeric(b1)	// IMPURE NUMERIC <- STRING
#    t4 := (i3 < b4)            // ZEROONE <- IMPURE NUMERIC x IMPURE NUMERIC
#    if t4 is false goto 7
#    goto 5
#
# 5: b5 := phi(b4{4}, b10{10})  // STRING <- STRING x IMPURE NUMERIC
#    c5 := phi(c1{4}, c7{10})	// STRING <- STRING x IMPURE NUMERIC
#    i5 := phi(i3{4}, i9{10})   // IMPURE NUMERIC <- IMPURE NUMERIC x NUMERIC
#    x5 := phi(0{4}, x6a{10})	// NUMERIC <- ZERO x NUMERIC
#    x5a := x5 + i5		// NUMERIC <- IMPURE NUMERIC x IMPURE NUMERIC
#    if c5 is not numeric goto error3 // <- STRING
#    goto 6
#
# 6: c6 := impure numeric(c5)	// IMPURE NUMERIC <- STRING
#    i6 := i5 + c6		// NUMERIC <- IMPURE NUMERIC x IMPURE NUMERIC
#    goto 8
#
# 7: x7 := phi(0{4}, x5a{10})	// NUMERIC <- ZERO x NUMERIC
#    return x7			// <- NUMERIC
#
# 8: if i6 is not numeric goto error0 // <- IMPURE NUMERIC
#    goto 9
#
# 9: i9 = impure numeric(i6)         // NUMERIC <- NUMERIC
#    if b5 is not numeric goto error1 // <- IMPURE NUMERIC
#    goto 10
#
# 10: b10 := impure numeric(b5)	// IMPURE NUMERIC <- IMPURE NUMERIC
#     t10 := (i6a < b5)            // ZEROONE <- NUMERIC x IMPURE NUMERIC
#     if t10 is false goto 7
#     goto 5
#
#-----------------------------------------------------------------------------
#
# Another expensive type conversion moved out of the loop, and block 11
# begins with an instruction that will be eliminated in optimization.
# Onward to blocks 5 and 6!
#
#-----------------------------------------------------------------------------
#
# 1: a1 := args[0]		// STRING <- STRING
#    b1 := args[1]		// STRING <- STRING
#    c1 := args[2]              // STRING <- STRING
#
# 2: if a1 is not numeric goto error0 // <- STRING
#    goto 3
#
# 3: i3 := impure numeric(a1)	// IMPURE NUMERIC <- STRING
#    if b1 is not numeric goto error1 // <- STRING
#    goto 4
#
# 4: b4 := impure numeric(b1)	// IMPURE NUMERIC <- STRING
#    t4 := (i3 < b4)            // ZEROONE <- IMPURE NUMERIC x IMPURE NUMERIC
#    if t4 is false goto 7
#    goto 5
#
# 5: x5 := 0 + i3		// NUMERIC <- ZERO x IMPURE NUMERIC
#    if c1 is not numeric goto error3 // <- STRING
#    goto 6
#
# 6: c6 := impure numeric(c1)	// IMPURE NUMERIC <- STRING
#    i6 := i3 + c6		// NUMERIC <- IMPURE NUMERIC x IMPURE NUMERIC
#    goto 8
#
# 7: x7 := phi(0{4}, x5{10})	// NUMERIC <- ZERO x NUMERIC
#    return x7			// <- NUMERIC
#
# 8: b6 := phi(b4{6}, b10{12})
#                        // IMPURE NUMERIC <- IMPURE NUMERIC x IMPURE NUMERIC
#    c8 := phi(c6{6}, c12{12})	// IMPURE NUMERIC x IMPURE NUMERIC
#                        // IMPURE NUMERIC <- IMPURE NUMERIC x IMPURE NUMERIC
#    i8 := phi(i6{6}, i9{11})   //  NUMERIC <-  NUMERIC x NUMERIC
#    x8 := phi(x5{5}, x11{11})	// NUMERIC <- ZERO x NUMERIC
#    if i8 is not numeric goto error0 // <- NUMERIC
#    goto 9
#
# 9: i9 = impure numeric(i6a)   // NUMERIC <- NUMERIC
#    if b6 is not numeric goto error1 // <- IMPURE NUMERIC
#    goto 10
#
# 10: b10 := impure numeric(b6)	// IMPURE NUMERIC <- IMPURE NUMERIC
#     t10 := (i6a < b6)         // ZEROONE <- NUMERIC x IMPURE NUMERIC
#     if t10 is false goto 7
#     goto 11
#
# 11: x11 := x8 + i8		// NUMERIC <- NUMERIC x NUMERIC
#     if c6a is not numeric goto error3 // <- IMPURE NUMERIC
#     goto 12
#
# 12: c12 = impure numeric(c8)	// IMPURE NUMERIC <- IMPURE NUMERIC
#     i12 := i8 + c8		// NUMERIC <- IMPURE NUMERIC x IMPURE NUMERIC
#     goto 8
#
#-----------------------------------------------------------------------------
#
# There's nothing left to split, because now all the data types at phi's
# are consistent, but there are a lot of tautologies to eliminate,
# useless type conversions to discard, and similar rubbish. After running
# the optimizations from other modules, the code will look something like:
#
#-----------------------------------------------------------------------------
#
# 1: a1 := args[0]		// STRING <- STRING
#    b1 := args[1]		// STRING <- STRING
#    c1 := args[2]              // STRING <- STRING
#
# 2: if a1 is not numeric goto error0 // <- STRING
#    goto 3
#
# 3: i3 := impure numeric(a1)	// IMPURE NUMERIC <- STRING
#    if b1 is not numeric goto error1 // <- STRING
#    goto 4
#
# 4: b4 := impure numeric(b1)	// IMPURE NUMERIC <- STRING
#    t4 := (i3 < b4)            // ZEROONE <- IMPURE NUMERIC x IMPURE NUMERIC
#    if t4 is false goto 7
#    goto 5
#
# 5: if c1 is not numeric goto error3 // <- STRING
#    x5 = 0 + i3		// NUMERIC <- ZERO + IMPURE NUMERIC
#    goto 6
#
# 6: c6 := impure numeric(c1)	// IMPURE NUMERIC <- STRING
#    i6 := i3 + c6		// NUMERIC <- IMPURE NUMERIC x IMPURE NUMERIC
#    goto 8
#
# 7: x7 := phi(0{4}, x5{10})	// NUMERIC <- ZERO x NUMERIC
#    return x7			// <- NUMERIC
#
# 8: i8 := phi(i6{6}, i9{9})    // NUMERIC <- NUMERIC x NUMERIC
#    x8 := phi(a1{6}, x11{11})	// NUMERIC <- ZERO x NUMERIC
#    t8 := (i8 < b4)            // ZEROONE <- NUMERIC x IMPURE NUMERIC
#    if t8 is false goto 7
#    goto 9
#
# 9: x9 := x8 + i6a		// NUMERIC <- NUMERIC x NUMERIC
#    i9 := i8 + c6		// NUMERIC <- IMPURE NUMERIC x IMPURE NUMERIC
#    goto 8
#
#-----------------------------------------------------------------------------
#
# A tightly optimized inner loop has emerged, once constant branches and
# do-nothing type conversions have been eliminated. All the pesky string
# representations are gone from the intermediate results. A few odds and
# ends of the first trip through the loop have distributed themselves
# elsewhere in the code.
#
# Now, how is this basic block splitting
#
# Essentially, it's a copying operation. We remove the 'jump'
# instruction at the end of each predecessor of the block being split,
# and replace it with the body of the split block. (All the predecessor blocks
# are single-exit, because we've done critical edge splitting.)
#
# We replace the phi instructions in the block with copies from the
# source operands. We track all the variables defined in the split
# code, since they now have multiple assignments to them, violating
# SSA. We add uses to the du-chains of all the variables used in the
# split code.
#
# Once the splitting is done, the first thing that we have to do is to
# make sure that there are no critical edges. Critical edges will have
# been introduced any time that we split a block that has multiple
# exits. We remove them by introducing a new, empty, basic block on each
# of the exits from the new block.
#
# The original block is now unreachable code. All variable uses
# in it are discarded, the block itself is emptied, and 'bbpred' is
# cleansed of references to it, both from it to its predecessors and from
# its successors to it.
#
# These manipulations have destroyed the dominance hierarchy, and this
# must be repaired. Currently, it is rebuilt wholesale. It would most
# likely be possible to constrain the rebuilding, using the ideas in
#
# Vugranam C. Sreedhar, Guang R. Gao and Yong-fong Lee. "Incremental
# Computation of Dominator Trees." ACM Trans. Progrm. Languages and
# Systems, 1995, pp. 1-12.
# http://citeseer.ist.psu.edu/viewdoc/summary?doi=10.1.1.46.3846
#
# It might also be possible to avoid use of the dominator tree during
# this operation - see Section 5.4 of "SSA-based Compiler Design"
# (http://ssabook.gforge.inria.fr/latest/book.pdf) for how this might
# be carried out.
#
# We now have a program where the control flows are again correct, and
# the dominance relations are understood. The program is,
# nevertheless, not in SSA form. The violation of SSA is well
# characterized. We have available to us a set of variables that are
# assigned at multiple places, and the places where they are
# assigned. We can use a 'black box' SSA reconstruction algorithm on
# those variables to repair SSA.
#
# Finally, type analysis has to be repeated. Once again, this is
# currently done wholesale. It might be possible to constrain it to
# the newly-split variables and their phi-webs.
# There are algorithms known for repair of the dominance relations as
# edges are cut and spliced. This implementation more or less follows
# Vugranam C. Sreedhar, Guang R Gao, and Yong-Fong Lee; "Incremental
# Computation of Dominator Trees." Proc. ACM SIGPLAN Workshop on
# Intermediate Representations. San Francisco, Calif.:ACM, 1995,
# pp. 1-12.
#
# You have been warned.
#
#-----------------------------------------------------------------------------
 
# quadcode::transformer method insertSplitMarkers --
#
#	Inserts markers into the code indicating the original basic
#	blocks prior to any node splitting.
#
# Results:
#	None.
#
# Side effects:
#	Every basic block has a 'split' instruction added at its head.
#	The 'split' has no result, and its sole source operand is a literal
#	giving the original basic block number.

oo::define quadcode::transformer method insertSplitMarkers {} {
    set b -1
    foreach bb $bbcontent {
	incr b
	lset bbcontent $b {}
	set pc -1
	foreach q $bb {
	    incr pc
	    if {[lindex $q 0 0] ni {"entry" "phi" "param"}} {
		break
	    }
	}
	lset bbcontent $b [linsert $bb[set bb ""] $pc \
			       [list split {} [list literal $b]]]
    }

    return
}
 
# quadcode::transformer method countSplits --
#
#	Walks through the quadcode, counting the number of split markers
#	present for each original location in the code.
#
# Parameters:
#	None.
#
# Results:
#	Returns a list, indexed by the original basic block number,
#	where the values are the number of copies of the original block that
#	are present. Zero counts are possible and expected if the original
#	code has been optimized away entirely.

oo::define quadcode::transformer method countSplits {} {
    set r {}
    set b -1
    foreach bb $bbcontent {
	incr b
	foreach q $bb {
	    if {[lindex $q 0 0] eq "split"} {
		set origb [lindex $q 2 1]
		while {$origb >= [llength $r]} {
		    lappend r 0
		}
		set n [lindex $r $origb]
		incr n
		lset r $origb $n
	    }
	}
    }

    return $r
}
 
# quadcode::transformer method removeSplitMarkers --
#
#	Removes markers that indicate the source of code when code splitting
#
# Results:
#	None
#
# Side effects:
#	Split markers are removed.

oo::define quadcode::transformer method removeSplitMarkers {} {
    set b -1
    foreach bb $bbcontent {
	incr b
	set newbb {}
	foreach q $bb {
	    if {[lindex $q 0] ne "split"} {
		lappend newbb $q
	    }
	}
	lset bbcontent $b $newbb
    }

    return
}
 
# quadcode::transformer method nodesplit --
#
#	Attempts to factor type checking out of loops by splitting a
#	single node of the flow graph.
#
# Results:
#	Return 1 if a node was split, 0 if no splittable node was found.
#
# Side effects:
#	Major surgery on the program, that requires cleanup optimization
#	and type inference (including possible repairs to interprocedural
#	type inference).

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

    #    global splitcount
    #    if {[incr splitcount] > 10} {puts "$splitcount splits"; return 0}

    my debug-nodesplit {
	puts "Before node splitting:"
	my dump-bb
    }

    # Determine how many copies of each original basic block are present
    set ns_counters [my countSplits]

    # Walk the basic blocks in reverse order and try to find the longest
    # possible dominator chain for jump threading.
    for {set b [expr {[llength $bbcontent] - 1}]} {$b >= 0} {incr b -1} {
	set splitb [my ns_checksForBB $b]
	if {$splitb ne {}} {
	    if {[my ns_splittable $splitb]} {
		# Split a single basic block
		my ns_cloneBB $splitb
		my debug-nodesplit {
		    puts "After splitting:"
		    my dump-bb
		}
		my debug-audit {
		    my audit-duchain "nodesplit"
		    my audit-phis "nodesplit"
		}
		return 1
	    }
	}
    }

    # Found nothing to split

    return 0
}
 
# quadcode::transformer method ns_checksForBB --
#
#	Characterizes a basic block according to what tests in it
#	might benefit from jump threading.
#
# Parameters:
#	b - Basic block to examine

oo::define quadcode::transformer method ns_checksForBB {b} {

    set checks {}
    foreach q [lindex $bbcontent $b] {
	my ns_checksForQuad checks $q
    }

    set splitLevel Inf
    set splitb {}
    dict for {v typedict} $checks {
	set vt [typeOfOperand $types $v]
	lassign [my findDef $v] db dpc dq
	if {[lindex $dq 0] eq "phi"} {
	    my debug-nodesplit {
		puts "$v comes from $db:$dpc: $dq"
		puts "Can $dq be split profitably?"
		set pptypes [lmap t [dict keys $typedict] {
		    list $t ([nameOfType $t])
		}]
		puts "typedict = $pptypes"
	    }
	    set split 0
	    dict for {t -} $typedict {
		foreach {from sourceVar} [lrange $dq 2 end] {
		    if {[quadcode::dataType::isa \
			     [typeOfOperand $types $sourceVar] $t]
			&& ![quadcode::dataType::isa $vt $t]} {
			my debug-nodesplit {
			    puts "Yes, because $sourceVar must be\
			          [nameOfType $t] but $v might not be"
			}
			set split 1
			break
		    } elseif {([typeOfOperand $types $sourceVar] & $t) == 0} {
			my debug-nodesplit {
			    puts "Yes, because $sourceVar cannot be\
			          [nameOfType $t] but $v might be"
			}
			set split 1
			break
		    }
		}
		if {$split} break
	    }
	    if {$split} {
		set lev [lindex $bblevel $db]
		my debug-nodesplit {
		    puts "Found a split, block $db at level $lev"
		}
		if {$lev < $splitLevel} {
		    set splitb $db
		    set splitLevel $lev
		}
	    } else {
		my debug-nodesplit {
		    puts "No benefit to splitting $db:$dpc: $dq"
		}
	    }
	}
    }
    if {$splitLevel != Inf} {
	my debug-nodesplit {
	    puts "Outermost phi to split is in block $splitb"
	}
    }
    return $splitb
}

 
# quadcode::transformer method ns_checksForQuad --
#
#	Characterizes a quadcode instruction according to whether
#	it could benefit from jump threading, and if so, what typechecks
#	are needed to thread it.
#
# Parameters:
#	q - Quadcode instruction

oo::define quadcode::transformer method ns_checksForQuad {checksVar q} {

    upvar 1 $checksVar checks

    namespace upvar ::quadcode::dataType \
	FAIL FAIL	IMPURE IMPURE	NEXIST NEXIST \
	CONST0 CONST0

    switch -exact [lindex $q 0 0] {

	purify {

#       add -       bitand -    bitnot -    bitor -     bitxor -
#       div -       eq -        expon -     ge -        gt -
#       land -      le -        lor -       lshift -    lt -
#       mod -       mult -      neq -       rshift -    sub -
#       uminus -    uplus -
#       dictIncr


	    foreach opd [lrange $q 2 end] {
		if {[lindex $opd 0] in {"var" "temp"}} {
		    dict set checks $opd $IMPURE {}
		}
	    }
	}

	exists -
	initIfNotExists {
	    set opd [lindex $q 2]
	    if {[lindex $opd 0] in {"var" "temp"}} {
		dict set checks $opd $NEXIST {}
	    }
	}

	jumpTrue -  jumpFalse {
	    set opd [lindex $q 2]
	    if {[lindex $opd 0] in {"var" "temp"}} {
 		dict set checks $opd $CONST0 {}
	    }
	}

	jumpMaybe - result - returnCode - returnOptions {
	    set opd [lindex $q 2]
	    if {[lindex $opd 0] in {"var" "temp"}} {
		dict set checks $opd $FAIL {}
	    }
	}

	narrowToType -
	instanceOf {
	    set type [lindex $q 0 1]
	    set opd [lindex $q 2]
	    if {[lindex $opd 0] in {"var" "temp"}} {
		dict set checks $opd $type {}
	    }
	}
    }
}
 
# quadcode::transformer method ns_splittable --
#
#	Determines whether a basic block is a candidate for splitting
#
# Parameters:
#	b - Basic block number of the block being examined
#
# Results:
#	Returns 1 if the block should be split, 0 otherwise.
#
# A basic block is splittable unless some quad in would have more than
# $bbSplitLimit copies after the split

oo::define quadcode::transformer method ns_splittable {b} {

    set bbSplitLimit 8

    set bb [lindex $bbcontent $b]

    # We will add one more instance of the block for every
    # predecessor, but delete one for the current instance
    set delta [dict size [lindex $bbpred $b]]
    incr delta -1

    set pc -1
    # Make sure that the block hasn't been split too often already
    while {[incr pc] < [llength $bb]} {
	set q [lindex $bb $pc]
	if {[lindex $q 0] eq "split"} {
	    set splitFrom [lindex $q 2 1]
	    set count [lindex $ns_counters $splitFrom]
	    if {$count + $delta > $bbSplitLimit} {
		my debug-nodesplit {
		    puts "$b:$pc: $splitFrom has been split too many\
                    	               times already."
		}
		return 0
	    }
	}
    }

    my debug-nodesplit {
	puts "split block $b: [llength $bb] quads and\
              [expr {$delta+1}] predecessors"
    }
    return 1
}
 
# quadcode::transformer method ns_cloneBB --
#
#	Clones a basic block that has been identified as a candidate
#	for splitting.
#
# Parameters:
#	b - Basic block number of the block being cloned
#
# Results:
#	None.
#
# Side effects:
#	Copies the block onto the end of its successors, and adds
#	edges, blocks for critical edge splitting, and phi nodes as
#	necessary to have the code in two places instead of one.
#
# The block must be multiple entry, therefore all its predecessors
# are single exit. That's the key concept that makes this splitting
# possible - that we can hoist the code up into the predecessors.

oo::define quadcode::transformer method ns_cloneBB {b} {
    my debug-nodesplit {
	puts "Cloning and eliminating basic block $b:"
	set bb [lindex $bbcontent $b]
	set pc -1
	foreach q $bb {
	    puts "  $b:[incr pc]: $q"
	}
	puts "------------------------------"
    }

    # dups is a three-level dictionary. The first key is the name of
    # a variable whose assignment has been duplicated. The second-level
    # key is the number of the basic block where it now appears, and
    # the content is the number of assignments to the variable that appear
    # in the block.

    set dups {}

    # Copy the block's instructions into its predecessors. Split critical
    # edges if the block has more than one exit.

    set ps [lindex $bbpred $b]
    dict for {pred -} $ps {
	my ns_rewriteBlockOntoPred dups $b $pred
    }

    # If the block had multiple successors, its successors are all
    # single entry and free of phi nodes. If it had a single successor,
    # then any phi's in the successor need to have it removed and the
    # clones inserted.

    set ss [my bbsucc $b]
    if {[llength $ss] eq 1} {
	my ns_fixupPhis [lindex $ss 0] $b $ps
    }

    # Unlink du-chains from the split block, and remove its
    # predecessor and successor links. Fixup bbidom, bbkids, and bblevel
    # to reflect the new state of the DJ graph.

    my ns_destroyBB $b
    my bbidom
    my bblevel

    # Repair SSA

    my debug-nodesplit {
	puts "Repair SSA after node splitting"
	dict for {v defs} $dups {
	    puts "   $v: [dict keys $defs] -> [dict keys [dict get $duchain $v]]"
	}
	my dump-bb
    }

    dict for {v defs} $dups {
	my repairSSAVariable $v $defs
    }

}
 
# quadcode::transformer method ns_rewriteBlockOnPred --
#
#	Copies the instructions of the body of a basic block
#	(which must be two-entry) onto the end of a predecessor,
#	renaming all assigned variables.
#
# Parameters:
#	dupsv - Name of a variable in the callers scope that holds a two-level
#               dictionary tracking the duplicated assignment statements. The
#	        first-level keys are basic block numbers; the second-level
#	        keys are basic blocks where the variables are assigned, and
#	        the values are counts of assignments within the blocks.
#	b - Number of the basic block to copy
#	pred - Number of the predecessor block
#
# Results:
#	None.
#
# Side effects:
#	Copies the code, and updates du-chains of variables appearing in
#	instructions being copied. Updates 'dupsv' with the locations of
#	variable definitions in the copies. Splits critical edges if
#	they are being introduced.

oo::define quadcode::transformer method ns_rewriteBlockOntoPred {dupsv b pred} {

    upvar 1 $dupsv dups

    # Look up the code we're copying and the code that we're appending to.

    set bb [lindex $bbcontent $b]
    set pb [lindex $bbcontent $pred]
    lset bbcontent $pred {}
    set pb [lreplace $pb[set pb {}] end end]

    my debug-nodesplit {
    	puts "Want to copy basic block $b into predecessor $pred"
    	set pc -1
    	foreach q $bb {
    	    puts "    $b:[incr pc]: $q"
    	}
    	puts " ------- "
    	set pc -1
    	foreach q $pb {
    	    puts "    $pred:[incr pc]: $q"
    	}
    	puts " +++++++ "
    }


    # Iterate through the instructions being copied
    set key [list bb $pred]
    set pc -1
    set critical 0
    foreach q $bb {
	incr pc

	set res [lindex $q 1]

	# If we're copying a phi, replace it with a copy from the appropriate
	# source variable.
	set op [lindex $q 0 0]
	switch -exact -- $op {
	    phi {
		set repvar [dict get $q $key]
		if {$repvar eq "Nothing"} {
		    set q [list unset $res]
		} else {
		    set q [list copy $res $repvar]
		}
	    }
	}

	# Examine the result of the operation. If the result is a value,
	# add the copy to the dictionary of multiple assignments that will
	# need SSA repair. If the operation is a conditional jump, peform
	# critical edge splitting. On any jump, update the 'bbpred' link.
	switch -exact -- [lindex $res 0] {
	    "temp" - "var" {
		if {[dict exists $dups $res]} {
		    set d [dict get $dups $res]
		    dict set dups $res {}
		} else {
		    set d {}
		}
		dict incr d $pred
		dict set dups $res $d
	    }
	    "bb" {
		if {[lindex $q 0] ne "jump"} {
		    set critical 1
		}
		if {$critical} {
		    set tgt [my makeEmptyBB [lindex $res 1]]
		    my debug-nodesplit {
			puts "       (* $tgt:0: [list jump $res] *)"
		    }
		    set res [list bb $tgt]
		    lset q 1 $res
		}
		my bblink $pred [lindex $res 1]
	    }
	}

	# Add du-chaining for the variable references in the copied code
	foreach opd [lrange $q 2 end] {
	    if {[lindex $opd 0] in {"temp" "var"}} {
		my addUse $opd $pred
	    }
	}

	# Copy the quad to its new home
	my debug-nodesplit {
	    puts "    $pred:[llength $pb]: $q"
	}
	lappend pb $q
    }

    lset bbcontent $pred $pb
    return
}
 
# ns_fixupPhis --
#
#	Repairs phi operations in a successor block after splitting a
#	basic block.
#
# Parameters:
#	b - Successor block
#	orig - Original block that was split
#	clones - Blocks into which the code was cloned.
#
# Results:
#	None.
#
# Side effects:
#	Phi operations are rewritten

oo::define quadcode::transformer method ns_fixupPhis {b orig clones} {
    my debug-nodesplit {
	puts "  redirect phi operations in $b that refer to $orig to use\
	        [dict keys $clones] instead"
    }

    set bb [lindex $bbcontent $b]
    lset bbcontent $b {}
    set key [list bb $orig]
    set repls [lmap {c -} $clones {list bb $c}]
    set pc -1
    foreach q $bb {
	if {[lindex $q 0] ne "phi"} {
	    break
	}
	incr pc
	set newq {}
	dict for {from fromvar} $q {
	    if {$from ne $key} {
		lappend newq $from $fromvar
	    } else {
		foreach newfrom $repls {
		    lappend newq $newfrom $fromvar
		}
	    }
	}
	my debug-nodesplit {
	    puts "    $b:$pc: redirected: $newq"
	}
	lset bb $pc $newq
    }
    lset bbcontent $b $bb

    return
}
 
# ns_destroyBB --
#
#	Destroys a basic block after node splitting has replaced it with
#	one or more new instances.
#
# Parameters:
#	b - Basic block number to be destroyed
#
# Results:
#	None.
#
# Side effects:
#	All values defined in the block have their du-chains unlinked.
#	The block is erased from 'bbcontent' and 'bbpred'.
#
# The next time that 'deadcode' runs, the last vestiges of the block,
# which is now unreachable, will be eliminated entirely.

oo::define quadcode::transformer method ns_destroyBB {b} {
    # Unlink du-chains
    set bb [lindex $bbcontent $b]
    set key [list bb $b]
    foreach q $bb {
	foreach opd [lrange $q 2 end] {
	    if {[lindex $opd 0] in {"var" "temp"}} {
		my removeUse $opd $b
	    }
	}
    }

    # Unlink predecessor relationships
    foreach s [my bbsucc $b] {
	set ps [lindex $bbpred $s]
	lset bbpred $s {}
	dict unset ps $b
	lset bbpred $s $ps
    }

    # Remove the block from 'bbpred' and 'bbcontent'
    set preds [lindex $bbpred $b]
    lset bbpred $b {}
    lset bbcontent $b {}

}

# renameTemps.tcl --
#
#	Renames temporaries in a quadcode program so as to avoid interferences.
#
# Copyright (c) 2017 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.
#
#------------------------------------------------------------------------------

package require struct::disjointset

# quadcode::transformer method renameTemps --
#
#	Renames temporaries in a quadcode sequence so as to avoid interferences.
#
# Results:
#	None.
#
# Side effects:
#	Temporaries are renamed by their equivalence classes.
#
# Temporaries that meet at phi operations represent the same temporary and
# must be named alike. If temporaries do not meet at phi operations, they
# do not need to have the same names.

oo::define quadcode::transformer method renameTemps {} {
    my debug-renameTemps {
	puts "Before renaming temporaries:"
	my dump-bb
    }


    # Put all the temporaries in a disjoint sets structure
    struct::disjointset [namespace current]::tempEquiv
    foreach bb $bbcontent {
	foreach q $bb {
	    set res [lindex $q 1]
	    if {[lindex $res 0] eq "temp"} {
		tempEquiv add-partition [list $res]
	    }
	}
    }

    # Unify all temporaries that flow through phis.
    foreach bb $bbcontent {
	foreach q $bb {
	    if {[lindex $q 0] eq "phi" && [lindex $q 1 0] eq "temp"} {
		set res [lindex $q 1]
		if {[lindex $res 0] eq "temp"} {
		    foreach {- src} [lrange $q 2 end] {
			if {[lindex $src 0] eq "temp"} {
			    tempEquiv merge $res $src
			}
		    }
		}
	    }
	}
    }

    # Come up with new labels for the temporaries
    set n 0
    set renamed {}
    foreach p [tempEquiv partitions] {
	set m -1
	foreach v $p {
	    dict set renamed $v [my newVarInstance [list temp $n]]
	    my debug-renameTemps {
		puts "Rename: $v [dict get $renamed $v]"
	    }
	}
	incr n
    }
    tempEquiv destroy

    # Relabel the quads

    set b -1
    foreach bb $bbcontent {
	incr b
	set pc -1
	foreach q $bb {
	    incr pc
	    set i 0
	    foreach arg [lrange $q 1 end] {
		incr i
		if {[dict exists $renamed $arg]} {
		    lset bbcontent $b $pc $i [dict get $renamed $arg]
		}
	    }
	}
    }

    my debug-renameTemps {
	puts "After renaming temporaries:"
	my dump-bb
    }

}

    }

    set inf [dict get $typeInf $instance]

    my debug-specializer {
	puts "SPLIT $procName ($argTypeNames):"
    }
    if {[$inf nodesplit]} {
	my AddToWorklist 0 $procName $argTypes
    } else {
	my AddToWorklist 3 $procName $argTypes
    }
}
 
# quadcode::specializer method DoneNodeSplitting --

    }

    set inf [dict get $typeInf $instance]

    my debug-specializer {
	puts "SPLIT $procName ($argTypeNames):"
    }
    if {[$inf jumpthread]} {
	my AddToWorklist 0 $procName $argTypes
    } else {
	my AddToWorklist 3 $procName $argTypes
    }
}
 
# quadcode::specializer method DoneNodeSplitting --

#		 eliminates variable-to-variable copies in the process,
#		 and fills in the arguments to phi functions.

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

	my bbidom
	my bblevel
	my bbssa1
	my bbssa2
    }
 

# bbidom --
#
#	Compute the immediate dominators of the basic blocks
#
................................................................................
#
#	First pass of the SSA conversion
#
# Preconditions:
#	The immediate dominance tree (bbidom and bbkids) must be known,
#	and dominance depths (bblevel) must have been calculated.
#





# Side effects:
#	Contents of basic blocks are rewritten to add phi functions at the
#	beginning of the blocks for the variables that converge on the block.
#	The 'vars' variable is set to a list of variable names in
#	the program.

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



    # Find out the 'globals' - the variables that flow from one block
    # to another - and the basic blocks in which variables are written.

    set global {}
    set vardict {}
    set writers {}
    set b -1
................................................................................
		}
	    }
	}
    }

    # Find places to insert phi nodes


    set phis [lrepeat [llength $bbcontent] {}]
    dict for {v -} $global {
	if {[dict exists $writers $v]} {
	    if {[dict exists $writers $v]} {
		set w [dict keys [dict get $writers $v]]
	    } else {
		set w {}
	    }
	    foreach n [my bbfrontier+ $w] {

		set list [lindex $phis $n]
		lset phis $n {}
		lappend list [list phi $v]
		lset phis $n $list

	    }
	}
    }

    # Insert phi nodes

    set b 0
    foreach content $bbcontent phi $phis {
	lset bbcontent $b [concat $phi $content]
	incr b
    }

    set vars [dict keys $vardict]
    return

}
 
# quadcode::transformer method bbssa2 -
#
#	Second pass of SSA transformation
#
................................................................................
# Preconditions:
#	A list of variables in the program must be in the 'vars' variable
#	(quads-list-vars will compute this). The immediate dominance tree
#	(bbidom and bbkids) must have been computed, and dominance frontiers
#	(bbfrontier) must be known. Dummy phi functions must have already
#	been placed at confluence points (bbssa1).
#





# Results:
#	None.
#
# Side effects:
#	Rewrites all basic blocks to begin with phi functions for confluent
#	variables, and removes copies.

oo::define quadcode::transformer method bbssa2 {} {
    my debug-ssa {
	puts "before variable renaming:"
	my dump-bb
    }

    set stack {}
    set varcount {}
    foreach v $vars {
	dict set stack $v [list "Nothing"]
    }
    my renamevars 0 stack

    my debug-ssa {
	puts "after variable renaming:"
	my dump-bb
    }

    unset vars
................................................................................
#	Renames the variables in a basic block and its dominance children
#	to the correct names for SSA form
#
# Parameters:
#	b - Basic block number
#	vstack - Name of a variable in callers scope that maintains the
#		 stack of current variable names.


#
# Results:
#	None.
#
# Side effects:
#	Basic blocks are rewritten. Phi functions are filled in and copies
#	are removed.
#
# This procedure is called once in bbssa2 for the entry block. It
# recurses down the dominance tree to fill in the variables for all
# the other blocks.

oo::define quadcode::transformer method renamevars {b vstack} {
    upvar 1 $vstack stack





    # Iterate over the quads in the basic block
    set newcontent {}
    set oldcontent [lindex $bbcontent $b]

    foreach q $oldcontent {
	set op [lindex $q 0]
	set lhs [lindex $q 1]

	# Rewrite variable uses
	if {$op ne "phi"} {
	    set i 2
................................................................................
	# Replace unsets with Nothing
	if {$op eq "unset"} {
	    set newlhs Nothing
	    set stk [dict get $stack $lhs]
	    dict set stack $lhs {}
	    lappend stk $newlhs
	    dict set stack $lhs $stk










	} elseif {[lindex $lhs 0] in {"temp" "var"}} {
	    set newlhs [my newVarInstance $lhs]
	    lset q 1 $newlhs
	    lappend newcontent $q
	    set stk [dict get $stack $lhs]
	    dict set stack $lhs {}
	    lappend stk $newlhs
	    dict set stack $lhs $stk



	} else {
	    lappend newcontent $q
	}
    }

    # Patch the phi's in the successor blocks.
    foreach s [my bbsucc $b] {
	set j 0
	foreach q [lindex $bbcontent $s] {
	    if {[lindex $q 0] eq "phi"} {
		set lhs [lrange [dict get $q "phi"] 0 1]






		set source [lindex [dict get $stack $lhs] end]



		lappend q [list bb $b] $source
		lset bbcontent $s $j $q
	    } else {
		break
	    }
	    incr j
	}
    }
    lset bbcontent $b $newcontent

    # Recurse down the dominance tree
    foreach k [lindex $bbkids $b] {
	my renamevars $k stack
    }

    # Pop the variables that we pushed



    foreach q $oldcontent {
	set lhs [lindex $q 1]

	if {[lindex $lhs 0] in {"temp" "var"}} {






	    set stk [dict get $stack $lhs]
	    dict set stack $lhs {}
	    set stk [lreplace $stk[set stk {}] end end]
	    dict set stack $lhs $stk
	}
    }

................................................................................
    }
    
    my debug-convssa {
	puts "convssa: after copy insertion:"
	my dump-bb
    }
}

#		 eliminates variable-to-variable copies in the process,
#		 and fills in the arguments to phi functions.

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

	my bbidom
	my bblevel
	set aliasFor [my bbssa1]
	my bbssa2 $aliasFor
    }
 

# bbidom --
#
#	Compute the immediate dominators of the basic blocks
#
................................................................................
#
#	First pass of the SSA conversion
#
# Preconditions:
#	The immediate dominance tree (bbidom and bbkids) must be known,
#	and dominance depths (bblevel) must have been calculated.
#
# Results:
#	Returns a dictionary that describes the placed phi operations.
#	Keys are the result variables of the phi's; values are the
#	variable names that the phi's replace.
#
# Side effects:
#	Contents of basic blocks are rewritten to add phi functions at the
#	beginning of the blocks for the variables that converge on the block.
#	The 'vars' variable is set to a list of variable names in
#	the program.

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

    set varcount {}
    
    # Find out the 'globals' - the variables that flow from one block
    # to another - and the basic blocks in which variables are written.

    set global {}
    set vardict {}
    set writers {}
    set b -1
................................................................................
		}
	    }
	}
    }

    # Find places to insert phi nodes

    set aliasFor {}
    set phis [lrepeat [llength $bbcontent] {}]
    dict for {v -} $global {
	if {[dict exists $writers $v]} {
	    if {[dict exists $writers $v]} {
		set w [dict keys [dict get $writers $v]]
	    } else {
		set w {}
	    }
	    foreach n [my bbfrontier+ $w] {
		set newv [my newVarInstance $v]
		set list [lindex $phis $n]
		lset phis $n {}
		lappend list [list phi $newv]
		lset phis $n $list
		dict set aliasFor $newv $v
	    }
	}
    }

    # Insert phi nodes

    set b 0
    foreach content $bbcontent phi $phis {
	lset bbcontent $b [concat $phi $content]
	incr b
    }

    set vars [dict keys $vardict]
    return $aliasFor

}
 
# quadcode::transformer method bbssa2 -
#
#	Second pass of SSA transformation
#
................................................................................
# Preconditions:
#	A list of variables in the program must be in the 'vars' variable
#	(quads-list-vars will compute this). The immediate dominance tree
#	(bbidom and bbkids) must have been computed, and dominance frontiers
#	(bbfrontier) must be known. Dummy phi functions must have already
#	been placed at confluence points (bbssa1).
#
# Parameters:
#	aliasFor - Dictionary that, for each placed 'phi' operation, lists
#	           the variable that the 'phi' replaces. Keys are the result
#                  variables of the 'phi' instructions.
#
# Results:
#	None.
#
# Side effects:
#	Rewrites all basic blocks to begin with phi functions for confluent
#	variables, and removes copies.

oo::define quadcode::transformer method bbssa2 {aliasFor} {
    my debug-ssa {
	puts "before variable renaming:"
	my dump-bb
    }

    set stack {}

    foreach v $vars {
	dict set stack $v [list "Nothing"]
    }
    my renamevars 0 stack $aliasFor

    my debug-ssa {
	puts "after variable renaming:"
	my dump-bb
    }

    unset vars
................................................................................
#	Renames the variables in a basic block and its dominance children
#	to the correct names for SSA form
#
# Parameters:
#	b - Basic block number
#	vstack - Name of a variable in callers scope that maintains the
#		 stack of current variable names.
#	aliasFor - Dictionary that maps the names of phi results to the
#	           names of the program variables that they replace.
#
# Results:
#	None.
#
# Side effects:
#	Basic blocks are rewritten. Phi functions are filled in and copies
#	are removed.
#
# This procedure is called once in bbssa2 for the entry block. It
# recurses down the dominance tree to fill in the variables for all
# the other blocks.

oo::define quadcode::transformer method renamevars {b vstack aliasFor} {
    upvar 1 $vstack stack

    my debug-ssa {
	puts "Rename vars in basic block $b"
    }

    # Iterate over the quads in the basic block
    set newcontent {}
    set oldcontent [lindex $bbcontent $b]

    foreach q $oldcontent {
	set op [lindex $q 0]
	set lhs [lindex $q 1]

	# Rewrite variable uses
	if {$op ne "phi"} {
	    set i 2
................................................................................
	# Replace unsets with Nothing
	if {$op eq "unset"} {
	    set newlhs Nothing
	    set stk [dict get $stack $lhs]
	    dict set stack $lhs {}
	    lappend stk $newlhs
	    dict set stack $lhs $stk
	} elseif {$op eq "phi"} {
	    set oldv [dict get $aliasFor $lhs]
	    my debug-ssa {
		puts "  rename $oldv -> $var"
	    }
	    lappend newcontent $q
	    set stk [dict get $stack $oldv]
	    dict set stack $oldv {}
	    lappend stk $lhs
	    dict set stack $oldv $stk
	} elseif {[lindex $lhs 0] in {"temp" "var"}} {
	    set newlhs [my newVarInstance $lhs]
	    lset q 1 $newlhs
	    lappend newcontent $q
	    set stk [dict get $stack $lhs]
	    dict set stack $lhs {}
	    lappend stk $newlhs
	    dict set stack $lhs $stk
	    my debug-ssa {
		puts "  rename $lhs -> $newlhs"
	    }
	} else {
	    lappend newcontent $q
	}
    }

    # Patch the phi's in the successor blocks.
    foreach s [my bbsucc $b] {
	set j 0
	foreach q [lindex $bbcontent $s] {
	    if {[lindex $q 0] eq "phi"} {
		my debug-ssa {
		    puts "Patch $q in successor block $s"
		}
		set oldv [dict get $aliasFor [lindex $q 1]]
		my debug-ssa {
		    puts "  it originally referred to $oldv"
		}
		set source [lindex [dict get $stack $oldv] end]
		my debug-ssa {
		    puts "  and now includes $b -> $source"
		}
		lappend q [list bb $b] $source
		lset bbcontent $s $j $q
	    } else {
		break
	    }
	    incr j
	}
    }
    lset bbcontent $b $newcontent

    # Recurse down the dominance tree
    foreach k [lindex $bbkids $b] {
	my renamevars $k stack $aliasFor
    }

    # Pop the variables that we pushed
    my debug-ssa {
	puts "Pop vars when leaving block $b"
    }
    foreach q $oldcontent {

	lassign $q op lhs
	if {[lindex $lhs 0] in {"temp" "var"}} {
	    if {$op eq "phi"} {
		set lhs [dict get $aliasFor $lhs]
	    }
	    my debug-ssa {
		puts "   pop $lhs"
	    }
	    set stk [dict get $stack $lhs]
	    dict set stack $lhs {}
	    set stk [lreplace $stk[set stk {}] end end]
	    dict set stack $lhs $stk
	}
    }

................................................................................
    }
    
    my debug-convssa {
	puts "convssa: after copy insertion:"
	my dump-bb
    }
}
 
# quadcode::transformer method deconstructSSA --
#
#	Converts a quadcode sequence from SSA form back to multiple
#	assignments.
#
# Results:
#	None.
#
# Side effects:
#	Phi operations are removed and assignment operations are added.
#
# This transformation is used in passes that make sweeping changes to
# program structure. In some of these passes, it is easier to destroy SSA
# form completely and reconstruct it afterward than it is to attempt to
# track the data flows.

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

    my debug-decontstructSSA {
	puts "Deconstruct SSA form for [my full-name]:"
    }

    # Walk through the basic blocks, rewriting each one in turn
    set newcontent {}
    set b -1
    foreach bb $bbcontent {
	incr b
	my debug-deconstructSSA {
	    puts "  bb $b:"
	}

	# Copy over the quads in one block, removing the phis and stopping
	# at the first jump at the end of the block
	set newb {}
	set newpc -1
	set pc -1
	set singleExit 1
	foreach q $bb {
	    incr pc
	    if {[lindex $q 0 0] eq "phi"} {
		continue
	    }
	    if {[lindex $q 0 0] eq "jump"} {
		break
	    }
	    if {[lindex $q 1 0] eq "bb"} {
		set singleExit 0
	    }
	    my debug-deconstructSSA {
		puts "    [incr newpc]: $q"
	    }
	    lappend newb $q
	}

	# If the block is single-exit, examine the phi operations
	# in the successor block and convert them to assignments here.

	if {[lindex $q 0 0] eq "jump" && $singleExit} {
	    set s [lindex $q 1 1]
	    set bkey [list bb $b]
	    my debug-deconstructSSA {
		puts "      # assignments from block $s:"
	    }
	    foreach q2 [lindex $bbcontent $s] {
		set argl [lassign $q2 opcode dest]
		if {[lindex $opcode 0] ne "phi"} {
		    break
		}
		set src [dict get $argl $bkey]
		if {$src eq "Nothing"} {
		    set q3 [list unset $dest]
		} else {
		    set q3 [list copy $dest $src]
		}
		my debug-deconstructSSA {
		    puts "    [incr newpc]: $q3"
		}
		lappend newb $q3
	    }
	}

	# Put the jump back in at the end of a single-exit block
	if {[lindex $q 0 0] eq "jump"} {
	    my debug-deconstructSSA {
		puts "    [incr newpc]: $q"
	    }
	    lappend newb $q
	}
	    
	# Done with the new basic block
	lappend newcontent $newb
    }

    # Replace the program with the rewritten one

    set bbcontent $newcontent
    return
}

	foreach pass {
	    bbpartition
	    constJumpPeephole
	    sortbb
	    loopinv
	    callFrameMotion
	    ssa
	    renameTemps
	    ud_du_chain
	    copyprop
	    fqcmd
	    varargs
	    deadbb
	    bbidom
	    bblevel
	    rewriteParamChecks
	    narrow
	    insertSplitMarkers
	} {
	    lappend timings $pass [lindex [time [list my $pass]] 0]
	    my debug-audit {
		my audit-duchain $pass
		my audit-phis $pass
	    }
	}
................................................................................
# 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]
	}]
................................................................................
		}
	    } else {
		set seenNonPhi 1
	    }
	}
    }
}





source [file join $quadcode::libdir abbreviate.tcl]
source [file join $quadcode::libdir aliases.tcl]
source [file join $quadcode::libdir bb.tcl]
source [file join $quadcode::libdir bytecode.tcl]
source [file join $quadcode::libdir callframe.tcl]
source [file join $quadcode::libdir constfold.tcl]
................................................................................
source [file join $quadcode::libdir dbginfo.tcl]
source [file join $quadcode::libdir deadcode.tcl]
source [file join $quadcode::libdir duchain.tcl]
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]
source [file join $quadcode::libdir upvar.tcl]
source [file join $quadcode::libdir varargs.tcl]
source [file join $quadcode::libdir widen.tcl]

#source [file join $quadcode::libdir exists.tcl]
#source [file join $quadcode::libdir interval.tcl]

	foreach pass {
	    bbpartition
	    constJumpPeephole
	    sortbb
	    loopinv
	    callFrameMotion
	    ssa

	    ud_du_chain
	    copyprop
	    fqcmd
	    varargs
	    deadbb
	    bbidom
	    bblevel
	    rewriteParamChecks
	    narrow

	} {
	    lappend timings $pass [lindex [time [list my $pass]] 0]
	    my debug-audit {
		my audit-duchain $pass
		my audit-phis $pass
	    }
	}
................................................................................
# 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 {

	removeCallFrameNop
	uselessphis
	eliminateCallFrame
    } {
	set cmd [string map [list @pass $pass] {
	    set result [my @pass]
	}]
................................................................................
		}
	    } else {
		set seenNonPhi 1
	    }
	}
    }
}

# types comes first - other modules' initialization can depend on it

source [file join $quadcode::libdir types.tcl]

source [file join $quadcode::libdir abbreviate.tcl]
source [file join $quadcode::libdir aliases.tcl]
source [file join $quadcode::libdir bb.tcl]
source [file join $quadcode::libdir bytecode.tcl]
source [file join $quadcode::libdir callframe.tcl]
source [file join $quadcode::libdir constfold.tcl]
................................................................................
source [file join $quadcode::libdir dbginfo.tcl]
source [file join $quadcode::libdir deadcode.tcl]
source [file join $quadcode::libdir duchain.tcl]
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 jumpthread.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 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 upvar.tcl]
source [file join $quadcode::libdir varargs.tcl]
source [file join $quadcode::libdir widen.tcl]

#source [file join $quadcode::libdir exists.tcl]
#source [file join $quadcode::libdir interval.tcl]