# builder.tcl --
#
#	Class that allows for building new quadcode inside a
#	quadcode::transformer.
#
# 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.
#
# Some passes that modify quadcode do fairly extensive code rewriting, and
# it's convenient have procedures to track these and allow access at a level
# closer to an 'assembly language'. This class contains convenience methods
# to allow automatic tracking of variable uses and defs, named temporaries,
# and named basic blocks.
#
#------------------------------------------------------------------------------

# quadcode::builder --
#
#	Class with support methods for building quadcode.
#
oo::class create quadcode::builder {

    variable xfmr;		# quadcode::transformer object containing
    ;				# the quadcode of interest.

    variable b;			# Basic block number under construction

    variable bb;		# Content of the basic block under construction

    variable bbindex;		# Dictionary whose keys are the names of
    ;				# basic blocks and whose values are the
    ;				# basic block numbers.

    variable varindex;		# Dictionary whose keys are named variables
    ;				# and whose values are the SSA names of the
    ;				# variables.
}

# quadcode::builder constructor --
#
#	Makes a quadcode::builder to allow for assembling quadcode.
#
# Parameters:
#	xfmr - quadcode::transformer object containing the subprogram
#	b - Basic block number under construction
#	bb - Basic block content of the block under construction

oo::define quadcode::builder constructor {xfmr_ b_ bb_} {
    set xfmr $xfmr_
    set b $b_
    set bb $bb_
    set bbindex {}
    set varindex {}
}

# quadcode::builder maketemp --
#
#	Makes a temporary variable.
#
# Parameters:
#	name - Base name for the temporary.
#
# Results:
#	Returns the name of the constructed temporary.
#
# Side effects:
#	Stores the name as the most recent instance of the temporary.

oo::define quadcode::builder method maketemp {name} {
    set ssaname [$xfmr newVarInstance [list temp @$name]]
    dict set varindex $name $ssaname
    return $ssaname
}

# quadcode::builder method emit --
#
#	Emits an instruction into the basic block under construction.
#
# Parameters:
#	q - Quadcode instruction to emit
#
# Results:
#	None.
#
# Side effects:
#	Appends the instruction to the basic bnlock under construction.
#	If the instruction is a jump, adds the basic block predecessor
#	relationship. If the instruction is an assignment, updates the
#	ud-chain of the assigned variable. Updates the du-chains of all
#	variables used oin the instruction.

oo::define quadcode::builder method emit {q} {

    # Split the instruction
    lassign $q opcode res argl

    # Handle the result
    switch -exact -- [lindex $res 0] {
        "bb" {

	    # Instruction is a jump, link the basic block to the jump target
            $xfmr bblink $b [lindex $res 1]
        }
        "temp" - "var" {

	    # Instrtuction is an assignment, update the ud-chain.
            dict set udchain $res $b
        }
    }

    # Handle the arguments
    foreach arg [lrange $q 2 end] {
        switch -exact -- [lindex $arg 0] {
            "temp" - "var" {

		# Argument is an SSA value, update the du-chain.
		$xfmr addUse $arg $b
            }
        }
    }

    # Add the instruction to the block
    lappend bb $q

    return
}

# quadcode::builder method bb --
#
#	Returns the content of the basic block under construction.
#
# Results:
#	Returns the instructions.

oo::define quadcode::builder method bb {} {
    return $bb
}

# Local Variables:
# mode: tcl
# fill-column: 78
# auto-fill-function: nil
# buffer-file-coding-system: utf-8-unix
# indent-tabs-mode: nil
# End:

	if {[lindex $opd 0] in {"var" "temp"}} {
	    my addUse $opd $b
	}
    }

    set bb [lindex $bbcontent $b]
    lset bbcontent $b {}
    lset bbcontent $b [linsert $bb[set bb {}] $pc $q]
    return
}

# quadcode::transformer method audit-duchain --
#
#	Makes sure that the 'duchain' dictionary matches the actual uses
#	of variables in the quadcode

    # b - Basic block number of the 'invoke' instruction
    # pc - Program counter within the basic block
    # pc0 - Program counter of the start of the invocation sequence. $pc0 <= $pc
    # q - The 'invoke' instruction itself
    # cmd - The command being invoked
    # argl - The arglist from the 'invoke' instruction
    # cfin - The callframe that flows into the invocation sequence, or Nothing
    # cfin_invoke - The callframe that is input to the 'invoke' or
    #		   'invokeExpanded' instruction, or Nothing.
    # res_invoke - The result of 'invoke' or 'invokeExpanded'
    # cfout - The callframe that flows out of the invocation sequence, or
    #         {}
    # invars - Dictionary whose keys are literal variable names and whose
    #          values are the sources of variables that need to be copied
    #          to the callframe prior to invocation
    # retval - Return value from the invocation
    # outvars - Dictionary whose keys are literal variable names and
    #           whose values are the quadcode values that need to be
    #           assigned from the callframe after the invocation
    # errexit - Basic block number to jump to on error exit
    # normexit - Basic block number to jump to on normal exit

    variable xfmr b pc q cmd res_invoke cfin_invoke argl \
	pc0 cfin invars retval cfout outvars errexit normexit

    constructor {} {
	# Defer construction to an initialization method to avoid throwing
	# constructor errors.
    }

    set pc $pc_

    set bb [$xfmr getBasicBlock $b]
    set q [lindex $bb $pc]

    # Take apart the invocation

    set argl [lassign $q op res_invoke cfin_invoke cmd]
    if {$op ni {"invoke" "invokeExpanded"}} {
	error "cannot analyze: not an invocation."
    }

    # Find the input callframe and relevant input variables
    
    set pc0 $pc
    set cfin Nothing
    set invars {}
    if {$cfin_invoke ne "Nothing"} {
	set qb [lindex $bb [expr {$pc-1}]]
	if {[lindex $qb 0] eq "moveToCallFrame"} {
	    if {[lindex $qb 1] ne $cfin_invoke} {
		error "cannot analyze: moveToCallFrame mislinked"
	    }
	    set varl [lassign $qb - - cfin]
	    foreach {namelit source} $varl {
		if {[lindex $namelit 0] ne "literal"} {
		    error "cannot analyze: name of input var not literal"
		}
		dict set invars [lindex $namelit 1] $source
	    }
	    set pc0 [expr {$pc-1}]
	}
    }

    # Find the result value

    set retval $res_invoke
    if {[lindex $bb [incr pc] 0] eq "retrieveResult"} {
	set q2 [lindex $bb $pc]
	lassign $q2 - retval cf2
	if {$cf2 ne $res_invoke} {
	    error "cannot analyze: retrieveResult mislinked"
	}
    } else {
	incr pc -1
    }

    # Find the output callframe

    set cfout $res_invoke
    if {[lindex $bb [incr pc] 0] eq "extractCallFrame"} {
	set q2 [lindex $bb $pc]
	lassign $q2 - cfout cf2
	if {$cf2 ne $res_invoke} {
	    error "cannot analyze: extractCallFrame mislinked"
	}
    } else {
	incr pc -1
    }

    # Find the output variables

    } else {
	error "cannot analyze: basic block does not end with a jump"
    }
	
    return
}

# quadcode::invocationSequence method arginfo --
#
#	Queries [info args] for the invoked command.
#
# Results:
#	Returns an ordered pair consisting of {1 result} if the args
#	are known, or {0 {}} otherwise. The value of 'result' in the
#	ordered pair is the result of [info args] for the given command.

oo::define quadcode::invocationSequence method arginfo {} {
    lassign [my cmd] status cmdName
    if {!$status
	|| [catch {info args $cmdName} arginfo]} {
	return {0 {}}
    }
    return [list 1 $arginfo]
}

# quadcode::invocationSequence method b --
#
#	Returns the basic block number of an invocation sequence

oo::define quadcode::invocationSequence method b {} {
    return $b
}

# quadcode::invocationSequence method cfin --
#
#	Returns the starting callframe for an invocation sequence

oo::define quadcode::invocationSequence method cfin {} {
    return $cfin
}

# quadcode::invocationSequence method cfin_invoke --
#
#	Returns the callframe from the 'invoke' instruction in an
#	invocation sequence

oo::define quadcode::invocationSequence method cfin_invoke {} {
    return $cfin_invoke
}

# quadcode::invocationSequence method cfout --
#
#	Returns the ending callframe for an invocation sequence

oo::define quadcode::invocationSequence method cfout {} {
    return $cfout
}

# quadcode::invocationSequence method cmd --
#
#	Queries the name of the invoked command.
#
# Results:
#
#	Returns an ordered pair that is {1 commandName} if the sequence
#	invokes a known command, and {0 {}} if the sequence does not
#	invoke a known command.

oo::define quadcode::invocationSequence method cmd {} {
    if {[lindex $cmd 0] eq "literal"} {
	return [list 1 [lindex $cmd 1]]
    } else {
	return {0 {}}
    }
}

# quadcode::invocation sequence method argl --
#
#	Returns the argument list of the invoked command.

oo::define quadcode::invocationSequence method argl {} {
    return $argl
}

# quadcode::invocationSequence method errexit --
#
#	Returns the error exit block number for an invocation sequence

oo::define quadcode::invocationSequence method errexit {} {
    return $errexit

# quadcode::invocationSequence method pc0 --
#
#	Returns the starting program counter for an invocation sequence

oo::define quadcode::invocationSequence method pc0 {} {
    return $pc0
}

# quadcode::invocationSequence method res_invoke --
#
#	Returns the result of the 'invoke' or 'invokeExpanded' in
#	an invocation sequence

oo::define quadcode::invocationSequence method res_invoke {} {
    return $res_invoke
}

# quadcode::invocationSequence method retval --
#
#	Returns the return value for an invocation sequence

oo::define quadcode::invocationSequence method retval {} {
    return $retval
}

#	Inserts narrowing operations in the quadcode.
#
# Results:
#	None.
#
# Preconditions:
#
#	The program must be deconstructed from SSA form. ud- and du-chains
#	must reflect the state of the program before deconstruction. One
#	round of copy propagation must have been done.
#
# Side effects:
#
#	Wherever a conditional branch tests the data type or existence of
#	a value, narrowing instructions are inserted in the quadcode to
#	mark that the value is of the required type.
#






# All of the operations introduced in this pass consist of introducing
# new quads of the form
#	v := some_narrowing_operation(v)
# where v is the value being tested (possibly indirectly) by the conditional
# jump. 

oo::define quadcode::transformer method narrow {} {
    upvar #0 quadcode::dataType::IMPURE IMPURE

    my debug-narrow {
	puts "before inserting narrowing operations:"
	my dump-bb

		    set falseBranch [lindex $bb end 1 1]
		} else {
		    set falseBranch [lindex $q 1 1]
		    set trueBranch [lindex $bb end 1 1]
		}

		# These operations may narrow if the defining instruction
		# is 'arrayExists', 'exists' or 'instanceOf'

		# The assignment appears at 'dpc' within basic block 'dbb'
		# and consists of the quadcode statement 'dquad'.
		if {[catch {

		    # Finding the definition will throw an error at a phi.
		    # The error can be ignored, because phi is not 'arrayExists'
		    # 'exists' or 'instanceOf'.
		    my findDef [lindex $q 2]
		} result]} continue
		lassign $result dbb dpc dquad
		set dop [lindex $dquad 0 0]

		switch -exact -- $dop {

		    arrayExists {
			set dvar [lindex $dquad 2]
			if {[lindex $dvar 0] ni {var temp}} continue
			my insertQuad $trueBranch 0 \
			    [list extractArray $dvar $dvar]
			my insertQuad $falseBranch 0 \
			    [list extractScalar $dvar $dvar]
			my debug-narrow {
			    puts "$trueBranch:0:\
                                  [lindex $bbcontent $trueBranch 0]"
			    puts "$falseBranch:0:\
                                  [lindex $bbcontent $falseBranch 0]"
			}
		    }
		    exists {
			set dvar [lindex $dquad 2]
			if {[lindex $dvar 0] ni {var temp}} continue
			my insertQuad $trueBranch 0 \
			    [list extractExists $dvar $dvar]
			my insertQuad $falseBranch 0 \
			    [list unset $dvar]
			my debug-narrow {
			    puts "$trueBranch:0:\
                                  [lindex $bbcontent $trueBranch 0]"
			    puts "$falseBranch:0:\
                                  [lindex $bbcontent $falseBranch 0]"
			}
		    }

		    instanceOf {
			set typecode [lindex $dquad 0 1]
			set typename [lindex $dquad 0 2]
			set dvar [lindex $dquad 2]
			if {[lindex $dvar 0] ni {var temp}} continue
			set nottype [::quadcode::dataType::allbut $typecode]
			set nottype [::quadcode::dataType::typeUnion \
					 $nottype $IMPURE]
			set notname [nameOfType $nottype]
			my insertQuad $trueBranch 0 \
			    [list [list narrowToType $typecode $typename] \
				 $dvar $dvar]
			my insertQuad $falseBranch 0 \
			    [list [list narrowToType $nottype $notname] \
				 $dvar $dvar]
			my debug-narrow {
			    puts "$trueBranch:0:\
                                  [lindex $bbcontent $trueBranch 0]"
			    puts "$falseBranch:0:\
                                  [lindex $bbcontent $falseBranch 0]"
			}
		    }
		}
	    }

	    jumpMaybe {
		set okBranch [lindex $bb end 1 1]
		set failBranch [lindex $q 1 1]
		set var [lindex $q 2]
		if {[lindex $var 0] ni {"var" "temp"}} continue
		my debug-narrow {
		    puts "  $bbindex:end-1: $q"
		    puts "  $okBranch:0: [list copy $var $var]"
		    puts "  $failBranch:0: [list extractFail $var $var]"
		}
		my insertQuad $okBranch 0 [list copy $var $var]
		my insertQuad $failBranch 0 [list extractFail $var $var]

	    }
	}
    }
    my debug-narrow {
	puts "after inserting narrowing operations:"
	my dump-bb
    }

}


























# quadcode::transformer method cleanupNarrow --
#
#	Removes narrowing instructions that are no longer relevant
#
# Preconditions:
#	The 'narrow' pass must have run to insert narrowing instructions,

	    copyprop
	    fqcmd
	    varargs
	    deadbb
	    bbidom
	    bblevel
	    rewriteParamChecks
	    deconstructSSA
	    narrow
	    ssa
	    ud_du_chain
	    copyprop
	} {
	    my debug-transform {
		puts "Run: $pass"
	    }
	    lappend timings $pass [lindex [time [list my $pass]] 0]
	    my debug-audit {
		my audit-duchain $pass
		my audit-phis $pass
	    }
	}
	my debug-timings {

# 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 builder.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 constjump.tcl]
source [file join $quadcode::libdir copyprop.tcl]
source [file join $quadcode::libdir dbginfo.tcl]
source [file join $quadcode::libdir deadcode.tcl]

        set pc -1
        foreach q $bb {
            incr pc

            # At this point in optimization, all invokes are part of a
            # sequence that is followed within a few instructions by a
            # jumpMaybe, so there can never be more than one in a basic
            # block.



            switch -exact [lindex $q 0] {
                "invoke" - "invokeExpanded" {
                    my debug-varargs {
                        puts "varargs: examine $b:$pc: $q"
                    }
                    my va_RewriteInvoke $b $pc $q
                    break
                }
            }
        }
    }

    my debug-varargs {
        puts "After variadic call replacement:"
        my dump-bb
    }

}

# quadcode::transformer method va_RewriteInvoke --
#
#       Rewrites 'invoke' and 'invokeExpanded' instructions to accommodate
#       compiled procs that accept variable numbers of arguments without going
#       through a call thunk or losing data type information.
#
# Parameters:
#       b - Basic block number
#       pc - Program counter within the block
#       q - Quadcode instruction being compiled
#
# Results:
#	None.
#
# Side effects:
#	Rewrites the instruction and 'expand' instructions that it
#       uses. Updates ud- and du-chains.

oo::define quadcode::transformer method va_RewriteInvoke {b pc q} {


    # Analyze the invocation sequence.  This codeburst will run from the
    # 'moveToCallFrame' preceding the invocation out to the end of the


















    # basic block.  We will be rewriting it.

    set call [::quadcode::invocationSequence new]









    $call analyze [self] $b $pc
























    # We can process only those sequences where the procedure name is known








    # a priori, the expected arguments are known, and the target procedure

    # is compiled.  BUG - We know the arguments to a great many Core commands



    # and need to work with them as well.




    lassign [$call arginfo] status arginfo


    if {!$status} return


    my debug-varargs {
        puts "[my full-name]: $b:$pc: $q"

        puts "    arginfo = $arginfo"




    }




    # We are going to be doing major surgery on the basic block.
    # Remove the 'invokeExpanded' and all following instructions
    # from the block. Unlink the block from its successors, and
    # remove ud- and du-chaining for the removed instructions.
    set bb [my va_UnlinkTail $b [$call pc0]]
    set B [quadcode::builder new [self] $b $bb]

    # Prepare parameters for the 'invoke' (or 'invokeExpanded') call, and
    # add the call to the instruction sequence under construction.
    my va_PrepareArgs $B $call

    puts "NOT FINISHED."
    exit
    $B destroy
    $call destroy
    return
}




# quadcode::transformer method va_PrepareArgs --
#








#	Emits code to prepare the arguments for an 'invoke' or
#	'invokeExpanded' command, up to the point where the actual
#	'invoke' is issued.

#
# Parameters:
#	B - quadcode::builder where the new invocation sequence is being built.
#	call - Object describing the invocation sequence.
#
# Results:
#	None.


oo::define quadcode::transformer method va_PrepareArgs {B call} {
    
    # Create the first part of the 'invoke' instruction.
    
    lassign [$call cmd] status callee
    if {!$status} {
        error "can't find callee -- can't happen"
    }
    set newq [list invoke \
                  [$call res_invoke] [$call cfin_invoke] \



                  [list literal $callee]]










    # Find out how many plain parameters (that is, not 'args') the
    # called command has.


    lassign [$call arginfo] status arginfo
    if {!$status} {



        error "can't find arginfo - can't happen"

    }
    set nPlainParams [llength $arginfo]
    set haveargs 0
    if {[lindex $arginfo end] eq "args"} {
        set haveargs 1
        incr nPlainParams -1
    }

    # Any leading plain arguments that do not have {*} can simply be retained
    # in the parameter list of [invoke].
    # $pos will be the position in the parameter list of the first
    # parameter that needs special handling. 
    set argl [$call argl]
    set pos 0
    while {$pos < $nPlainParams} {
        if {[my va_NonExpandedArgument newq $arginfo $pos $argl]} break
        incr pos
    }



    my debug-varargs {
        puts "varargs: [$call b]:[$call pc0]: matched $pos out of $nPlainParams\
              leading non-expanded arg(s)."
    }

    # Generate code to make the rest of the args into a list
    my va_MakeArgList $B $argl $pos

    puts "NOT DONE - varargs matched non-expanded args."
    exit 1

}


if 0 {

    set tempIndex -1
    set listLoc [my va_MakeArgList bb tempIndex pos $b $q]

    # We are going to need the length of the list, so
    # extract that now. (If it turns out somehow that we
    # don't use it, 'deadvars' will get rid of this, anyway.)
    set lenLoc1 [my newVarInstance [list temp [incr tempIndex]]]
    set lenLoc [my newVarInstance [list temp $tempIndex]]
    my va_EmitAndTrack $b bb [list listLength $lenLoc1 $listLoc]
    my va_EmitAndTrack $b bb [list extractMaybe $lenLoc $lenLoc1]

    # Count the mandatory args

    set firstMandatory $pos
    while {$pos < $nPlainParams} {
        if {[info default $callee [lindex $arginfo $pos] defaultVal]} {
            break
        }
        incr pos
    }
    set firstOptional $pos

    set compTemp [list temp [incr $tempIndex]]

    set nMandatory 0
    if {$firstOptional > $firstMandatory} {

        # Make code to check length of arg list, starting a
        # new basic block
        set nMandatory [expr {$firstOptional - $firstMandatory}]
        set b [my va_CheckEnough $b $bb $lenLoc $compTemp \
                   $nMandatory $notokb]
        set bb {}

        # Make code to transfer mandatory args
        my va_UnpackMandatory tempIndex bb newq $b $listLoc $nMandatory
    }

    # Now we have the parameters that have default values.

    set j $nMandatory
    if {$nPlainParams > $firstOptional} {

        # Emit a code burst for each optional parameter to
        # check the list length and extract the parameter
        set optInfo {}
        set finishB [llength $bbcontent]
        lappend bbcontent {}
        lappend bbpred {}
        set i $firstOptional
        while {$i < $nPlainParams} {
            info default $callee [lindex $arginfo $i] defaultVal
            lassign [my va_UnpackOptional tempIndex b bb \
                         $finishB $compTemp $listLoc $lenLoc $j] \
                fromBlock argLoc
            lappend optInfo [list $fromBlock $defaultVal $argLoc]
            incr i
            incr j
        }

        # Close out the last basic block, switch to the 'finish' block
        # and emit 'phi' instructions to get the correct parameter set
        my va_FinishOptional b bb newq $finishB $optInfo

    }

    # If the procedure has 'args', then fill it in with the remainder of the
    # arg list.
    if {$haveargs} {
        my va_DoArgs tempIndex $b bb newq $listLoc $j
    } else {
        my va_CheckTooMany b bb $lenLoc $compTemp $j $notokb
    }

    # Create the normal invocation sequence.
    # 1. Create moveToCallFrame

    set cfin [$call cfin]
    set invars [$call invars]
    if {[$call pc0] < $pc} {
        set cf2 [my newVarInstance $cfin]
        set q2 [list moveToCallFrame $cf2 $cfin]
        dict for {vname val} $invars {
            lappend q2 [list literal $vname] $val
        }
        my va_EmitAndTrack $b bb $q2
        set cfin $cf2
        lset newq 2 $cfin
    }
    
    # 2. Emit the call as rewritten
    my va_EmitAndTrack $b bb $newq

    # 3. Make the 'retrieveResult'
    set okresult [my newVarInstance [$call retval]]
    my va_EmitAndTrack $b bb [list retrieveResult $okresult $invokeres]
    dict set normphis [$call retval] [list bb $norm0b] $okresult
    dict set errorphis [$call retval] [list bb $err0b] $okresult

    # 4. Make the 'extractCallFrame'
    set okcf [my newVarInstance [$call cfout]]
    my va_EmitAndTrack $b bb [list extractCallFrame $okcf $invokeres]
    dict set normphis [$call cfout] [list bb $norm0b] $okcf
    dict set errorphis [$call cfout] [list bb $err0b] $okcf

    # 5. Make 'moveFromCallFrame' for all output values
    dict for {vname outval} [$call outvars] {
        set okval [my newVarInstance $outval]
        my va_EmitAndTrack $b bb \
            [list moveFromCallFrame $okval $okcf [list literal $vname]]
        dict set normphis $outval [list bb $norm0b] $okval
        dict set errorphis $outval [list bb $err0b] $okval
        set notokval [dict get [$call invars] $vname]
        dict set normphis $outval [list bb $norm1b] $notokval
        dict set errorphis $outval [list bb $err1b] $notokval
    }        

    # 6. Make the terminal jumps
    my va_EmitAndTrack $b bb [list jumpMaybe [list bb $err0b] $okresult]
    my va_EmitAndTrack $b bb [list jump [list bb $norm0b]]

    # Emit the final basic block rewrite

    lset bbcontent $b $bb

    # toRepair will have the variables that have to be fixed up by
    # repairSSAVariable after this stuff runs
    set toRepair {}

    # Make the block for the normal exit
    set normbb {}
    foreach {v sources} $normphis {
        set val 0
        if {[dict exists $toRepair $v $normb]} {
            set val [dict get $toRepair $v $normb]
        }
        incr val
        dict set toRepair $v $normb $val
        my va_EmitAndTrack $normb normbb [list phi $v {*}$sources]
    }
    my va_EmitAndTrack $normb normbb [list jump [list bb [$call normexit]]]
    lset bbcontent $normb $normbb

    # Make the block for the error exit
    set errorbb {}
    foreach {v sources} $errorphis {
        set val 0
        if {[dict exists $toRepair $v $errorb]} {
            set val [dict get $toRepair $v $errorb]
        }
        incr val
        dict set toRepair $v $errorb $val
        my va_EmitAndTrack $errorb errorbb [list phi $v {*}$sources]
    }
    my va_EmitAndTrack $errorb errorbb [list jump [list bb [$call errexit]]]
    lset bbcontent $errorb $errorbb

    # Restore dominance relationships
    my bbidom; my bblevel

    my debug-varargs {
        puts "Before repairing SSA relationships:"

    }

    my debug-varargs {
        puts "After repairing SSA relationships:"
        my dump-bb
    }
    
    $call destroy

    return
}

# quadcode::transformer method va_UnlinkTail --
#
#	Removes the invocation sequence from a basic block in preparation
#	for rewriting it.

#
# Parameters:
#	b - Number of the basic block
#	pc - Program counter of the first instruction being deleted
#
# Results:
#	Returns the partial basic block that remains.
#
# Side effects:
#	Variable defs and uses in the invocation sequence are removed
#	from ud- and du-chains. The basic block is unlinked from its
#	successors. 

oo::define quadcode::transformer method va_UnlinkTail {b pc} {
    set bb [lindex $bbcontent $b]

    set tail [lrange $bb $pc end]
    set bb [lreplace $bb[set bb {}] $pc end]
    foreach q $tail {
        if {[lindex $q 1 0] in {"temp" "var"}} {
            dict unset udchain [lindex $q 1]
        }
        foreach arg [lrange $q 2 end] {
            if {[lindex $arg 0] in {"temp" "var"}} {
                my removeUse $arg $b
            }
        }
    }
    foreach b2 [my bbsucc $b] {
        my removePred $b2 $b
    }



    return $bb
}

# quadcode::transformer method va_NonExpandedArgument --
#
#	Transfer a leading non-expanded argument into a quad
#	under construction when rewriting 'invokeExpanded'
#
# Parameters:
#	newqVar - Name of a variable in caller's scope storing the
#	          plain 'invoke' operation under construction
#	arginfo - Result of [info args] against the invoked proc
#	pos - Position of the argument (0 = first) in the argument list
#	argl - Argument list of the 'invoke' or 'invokeExpanded' instruction
#
# Results:
#	Returns 0 if the parameter was transferred, 1 if we are at the
#	end of the possible static transfers.

oo::define quadcode::transformer method va_NonExpandedArgument {newqVar
                                                                    arginfo
                                                                    pos argl} {

    upvar 1 $newqVar newq
    
    set param [lindex $arginfo $pos]
    set arg [lindex $argl $pos]
    switch -exact -- [lindex $arg 0] {
        "literal" {
        }
        "temp" - "var" {
            lassign [my findDef $arg] defb defpc defstmt
            if {[lindex $defstmt 0] eq "expand"} {
                return 1
            }
        }
        default {
            return 1
        }
    }
    lappend newq $arg
    return 0
}

# quadcode::transformer method va_MakeArgList --
#
#	Takes the non-fixed-position arguments of 'invokeExpanded'
#	and emits code to make them into a list.
#
# Parameters:
#	B - quadcode::builder that is rewriting the invocation sequence.
#	argl - Argument list being analyzed

#	pos - Position in the argument list



#
# Results:
#
#	Returns the name of a variable, temporary or literal that holds the
#	expanded list.

oo::define quadcode::transformer method va_MakeArgList {B argl pos} {



    # Handle the first arg. 'listloc' will be the variable holding the

    # expanded arglist. 'mightThrow' will be 1 if 'listloc'

    # might be a non-list and 0 otherwise.

    if {$pos >= [llength $argl]} {
        set listLoc "literal {}"
    } else {
        set arg [lindex $argl $pos]
        switch -exact -- [lindex $arg 0] {
            "literal" {
                set listloc [$B maketemp arglist]
                $B emit [list list $listloc $arg]
                set mightThrow 0
            }
            "temp" - "var" {
                lassign [my findDef $arg] defb defpc defstmt
                if {[lindex $defstmt 0] eq "expand"} {
                    set listLoc [lindex $defstmt 2]
                    set mightThrow 1
                } else {
                    set listLoc [$B maketemp arglist]
                    $B emit [list list $listLoc $arg]
                    set mightThrow 0
                }
            }
        }
    }
    puts "did first arg, arglist is $listLoc, and b so far is\n[join [$B bb] \n]"
    puts "lhsMightThrow = $lhsMightThrow"

    if {$lhsMightThrow} {

    exit 1

    # listLoc now holds the location of the list under
    # construction. Concatenate the remaining params onto it.

        foreach arg [lrange $argl [expr {1 + $pos}] end] {

            # Do we need to expand this arg?
            switch -exact -- [lindex $arg 0] {
                "literal" {
                    set op "listAppend"
                }
                "temp" - "var" {
                    lassign [my findDef $arg] defb defpc defstmt
                    if {[lindex $defstmt 0] eq "expand"} {
                        set op "listConcat"
                    } else {
                        set op "listAppend"
                    }
                }
            }

            # Make variable to hold Maybe result from the concatenation,
            # and emit the concatenation.

            set nloc [$B maketemp arglist]
            $B emit [list $op $nloc $listLoc $arg]

            if {$lhsMightThrow || $op == "listConcat"} {
                my makeErrorBlock $B
                set intb [$B makeblock]
                set nextb [$B makeblock]
                $B emit [list jumpMaybe [list bb $intb] $nloc]
                set lhsMightThrow 0
                $B emit [list jump [list bb $nextb]]
                $B buildin $intb
                set error [$B maketemp nloc]
                $B emit [list extractFail $error $nloc]
                $B emit [list jump [list bb $errorb]]
                $B phi $errorb error $error
                $B emit [list jump [list bb $errorb]]
                $B buildin $nextb

                # KBK is here - need to get my context back!!!
            }

            # extract the result from the Maybe
            set listLoc [$B maketemp arglist]
            $B emit [list extractMaybe $listLoc $nloc]
        }

        return $listLoc
    }

# quadcode::transformer method va_CheckEnough --
#
#	Emits code to check for too few args passed to invokeExpanded
#
# Parameters:
#	b - Basic block number under construction
#	bb - Instructions in the block
#	lenLoc - Location holding the length of the arg list
#	compTemp - Temporary variable name to use for comparison
#	nMandatory - Number of mandatory args still unpaired
#	errorB - Basic block to jump to if too few args
#
# Results:
#	Returns the new basic block number; this method ends the block.

oo::define quadcode::transformer method va_CheckEnough {b bb lenLoc compTemp
                                                            nMandatory errorB} {
    # Emit {$nMandatory > $lenLoc}
    set compLoc [my newVarInstance $compTemp]
    my va_EmitAndTrack $b bb \
        [list gt $compLoc [list literal $nMandatory] $lenLoc]

    # Emit jumpTrue to the error block. This has to go through an
    # intermediate block because it will be a critical edge otherwise.
    # Emit jump to the following block
    set intb [llength $bbcontent]
    lappend bbcontent {}
    lappend bbpred {}
    set newb [llength $bbcontent]
    lappend bbcontent {}
    lappend bbpred {}

    my va_EmitAndTrack $b bb [list jumpTrue [list bb $intb] $compLoc]
    my va_EmitAndTrack $b bb [list jump [list bb $newb]]

    lset bbcontent $b $bb
    set bb {}

    # Emit the intermediate jump
    my va_EmitAndTrack $intb bb [list jump [list bb $errorB]]
    lset bbcontent $intb $bb
    set bb {}

    return $newb
}

# quadcode::transformer method va_UnpackMandatory --
#
#	Unpacks the mandatory args to a proc from the list created
#	by argument expansion
#
# Parameters;
#	tempIdxVar - Variable in caller's scope containing the last
#	             allocated temporary
#	bbVar - Variable in caller's scope containing basic block content
#	newqVar - Variable in caller's scope containing the new 'invoke'
#	          quad being constructed.
#	b - Basic block number under construction
#	listLoc - Variable or temp holding the list being unpacked
#	nMandatory - Number of parameters to unpack
#
# Results:
#	None.
#
# Side effects:
#	Emits code to unpack the mandatory parameters

oo::define quadcode::transformer method va_UnpackMandatory {tempIdxVar
                                                                bbVar newqVar
                                                                b listLoc
                                                                nMandatory} {
    upvar 1 $tempIdxVar tempIdx $bbVar bb $newqVar newq

    for {set i 0} {$i < $nMandatory} {incr i} {

        # Emit the 'listIndex' instruction for one arg. It can't fail
        # because we know we have a list

        set argTemp [list temp [incr tempIdx]]
        set argLoc [my newVarInstance $argTemp]
        my va_EmitAndTrack $b bb \
            [list listIndex $argLoc $listLoc [list literal $i]]

        # Emit the 'extractMaybe' to get the arg from the Maybe
        # result of 'listIndex'
        set argLoc2 [my newVarInstance $argTemp]
        my va_EmitAndTrack $b bb [list extractMaybe $argLoc2 $argLoc]

        # Put the extracted arg on the 'invoke' instruction
        lappend newq $argLoc2
    }
}

# quadcode::transformer method va_UnpackOptional --
#
#	Emits code to unpack one optional parameter in an invokeExpanded
#
# Parameters:
#	tempIdxVar - Variable holding the index of the last used temporary
#	bVar - Variable holding the current basic block number
#	bbVar - Variable holding the content of the basic block under

#	to the finish if the parameter is not supplied and the
#	location of a temporary holding the unpacked value if it is.
#
# Side effects:
#	Emits code to unpack one value, or jump to the finish block if
#	there is nothing to unpack.

oo::define quadcode::transformer method va_UnpackOptional {tempIdxVar bVar
                                                               bbVar finishB
                                                               compTemp listLoc
                                                               lenLoc j} {
    upvar 1 $tempIdxVar tempIndex $bVar b $bbVar bb

    set pos [list literal $j]
    set compLoc [my newVarInstance $compTemp]
    set argTemp [list temp [incr tempIndex]]
    set argLoc1 [my newVarInstance $argTemp]
    set argLoc2 [my newVarInstance $argTemp]

    # Emit the list length comparison
    my va_EmitAndTrack $b bb [list ge $compLoc $pos $lenLoc]

    # Emit the jump to the finish block We need to make an intermediate block
    # because otherwise the flowgraph edge would be critical
    set intb [llength $bbcontent]
    lappend bbcontent {}
    lappend bbpred {}
    my va_EmitAndTrack $b bb [list jumpTrue [list bb $intb] $compLoc]

    # Create the next block and jump to it
    set newb [llength $bbcontent]
    lappend bbcontent {}
    lappend bbpred {}
    my va_EmitAndTrack $b bb [list jump [list bb $newb]]
    lset bbcontent $b $bb

    # Make the intermediate block
    set b $intb
    set bb {}
    my va_EmitAndTrack $b bb [list jump [list bb $finishB]]
    lset bbcontent $b $bb

    # Advance to the new block

    set b $newb
    set bb {}

    # Emit the 'listIndex' to unpack the arg
    my va_EmitAndTrack $b bb [list listIndex $argLoc1 $listLoc $pos]

    # Emit the 'extractMaybe' on the 'listIndex' result
    my va_EmitAndTrack $b bb [list extractMaybe $argLoc2 $argLoc1]

    # Return the place where we stored the arg
    return [list $intb $argLoc2]

}

# quadcode::transformer method va_FinishOptional --
#
#	Finish transmitting the args that have default values when
#	compiling {*}
#
# Parameters:
#	bVar - Variable in caller holding the current basic block number
#	bbVar - Variable in caller's scope holding basic block content

#
# Side effects:
#	Closes out the current basic block, opens the finish block,
#	and emits phi instructions into the finish block. Adds the
#	outputs of the phi instructions to the 'invoke' instruction
#	under construction.

oo::define quadcode::transformer method va_FinishOptional {bVar bbVar
                                                               newqVar finishB
                                                               optInfo} {

    upvar 1 $bVar b $bbVar bb $newqVar newq

    # Finish the current block and start building into 'finishB'

    my va_EmitAndTrack $b bb [list jump [list bb $finishB]]
    lset bbcontent $b $bb
    set bb {}
    set fromb $b
    set b $finishB

    # Emit the phi instructions

            if {$k >= $n} {
                lappend q $tempLoc
            } else {
                lappend q $defaultLit
            }
        }
        lappend q [list bb $fromb] $tempLoc
        my va_EmitAndTrack $b bb $q
        lappend newq $newTemp
    }
}

# quadcode::transformer method va_DoArgs --
#
#	Emits code to extract the parameter sequence needed to fill '$args'
#	from the parameter list.
#
# Parameters:
#	tempIdxVar - Variable containing the last temporary index used
#	b - basic block number under construction
#	bbVar - Variable containing the code of the basic block
#	newqVar - Variable containing the 'invoke' instruction under
#                 construction
#	listLoc - LLVM location holding the argument list
#	i - Index in the arg list at which 'args' starts
#
# Results:
#	None.
#
# Side effects:
#	Emits any code necessary to fill in 'args', and adds the resulting
#	variable onto the end of the new instruction.

oo::define quadcode::transformer method va_DoArgs {tempIdxVar b bbVar
                                                       newqVar listLoc i} {

    upvar 1 $tempIdxVar tempIndex $bbVar bb $newqVar newq

    if {$i == 0} {
        lappend newq $listLoc
    } else {
        set argsTemp [list temp [incr tempIndex]]
        set argsLoc1 [my newVarInstance $argsTemp]
        my va_EmitAndTrack $b bb [list listRange $argsLoc1 $listLoc \
                                   [list literal $i] [list literal end]]
        set argsLoc2 [my newVarInstance $argsTemp]
        my va_EmitAndTrack $b bb [list extractMaybe $argsLoc2 $argsLoc1]
        lappend newq $argsLoc2
    }
}

# quadcode::transformer method va_CheckTooMany --
#
#	Emits a codeburst to check whether an 'invokeExpanded' has
#	too many args
#
# Parameters:
#	bVar - Variable holding the basic block number
#	bbVar - Variable holding the content of the current basic block
#	lenLoc - LLVM location holding the argument list length
#	compTemp - Name of a temporary to use as a comparison result
#	i - Index of the next unclaimed argument
#	errorB - Basic block number to jump to if there are too many args
#
# Results:
#	None
#
# Side effects:
#	Emits code and closes the basic block

oo::define quadcode::transformer method va_CheckTooMany {bVar bbVar lenLoc
                                                             compTemp i
                                                             errorB} {

    upvar 1 $bVar b $bbVar bb


    set compLoc [my newVarInstance $compTemp]
    my va_EmitAndTrack $b bb [list gt $compLoc $lenLoc [list literal $i]]

    set intb [llength $bbcontent]
    lappend bbcontent {}
    lappend bbpred {}
    my va_EmitAndTrack $b bb [list jumpTrue [list bb $intb] $compLoc]

    set newb [llength $bbcontent]
    lappend bbcontent {}
    lappend bbpred {}
    my va_EmitAndTrack $b bb [list jump [list bb $newb]]
    lset bbcontent $b $bb

    set b $intb
    set bb {}
    my va_EmitAndTrack $b bb [list jump [list bb $errorB]]
    lset bbcontent $b $bb

    set b $newb
    set bb {}

}

# quadcode::transformer method va_EmitWrongArgs --
#
#	Generates code to throw the 'wrong # args' error when needed
#
# Parameters:
#	result - Quadcode value that will hold the command result
#	cfout - Quadcode value that will hold the result callframe,
#	        or {} if no callframe need be produced
#	cfin - Quadcode value that holds the pre-invoke callframe,
#	       or Nothing if no callframe need be produced
#	cmd - Quadcode literal with the name of the command being invoked
#
# Results:
#	None.
#
# Side effects:
#	Returns a codeburst that throws the exception

oo::define quadcode::transformer method va_EmitWrongArgs {result cfout 
                                                              cfin cmd} {

    set burst {}
    if {$cfin ne "Nothing"} {
        lappend burst [list copy $cfout $cfin]
    }

    lappend burst $q
    set q [list extractFail $result $intres]
    lappend burst $q
    return $burst

}

# quadcode::transformer method va_EmitAndTrack --
#
#	Emits a quadcode instruction and tracks its effects
#
# Parameters:
#	b - Basic block number
#	bbVar - Variable containing the basic block content
#	q - Quadcode instruction to emit
#
# Results:
#	None.
#
# Side effects:
#	Instruction is added to the basic block, and linked in ud- and du-chains
#	Basic block is linked in control flow if needed.

oo::define quadcode::transformer method va_EmitAndTrack {b bbVar q} {

    upvar 1 $bbVar bb

    set res [lindex $q 1]
    switch -exact -- [lindex $res 0] {
        "bb" {
            my bblink $b [lindex $res 1]