#
# 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:

#
# Results:
#	Returns the instructions.

oo::define quadcode::builder method bb {} {
    return $bb
}
 
# quadcode::builder method log-last --
#
#	Logs the last instruction emitted to the standard output
#
# Results:
#	None.

oo::define quadcode::builder method log-last {} {
    set pc [expr {[llength $bb] -1}]
    puts "    $b:$pc: [lindex $bb end]"
}
 
# Local Variables:
# mode: tcl
# fill-column: 78
# auto-fill-function: nil
# buffer-file-coding-system: utf-8-unix
# indent-tabs-mode: nil
# End:

# invoke.tcl --
#
#	Utilities for manipulating invocation sequences in quadcode.
#
# Copyright (c) 2018 by Kevin B. Kenny.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
#------------------------------------------------------------------------------

# quadcode::invocationSequence --
#
#	Class that represents the data for invoking a procedure.
#
# A quadcode::invocationSequence represents the codeburst that invokes
# a procedure, from the 'moveToCallFrame' that synchronizes the call frame
# prior to the invocation, down to the 'jumpMaybe' and 'jump' that handle
# a possible error return from the procedure. Procedure inlining and
# 'invokeExpand' repacement are two operations that need to rewrite the
# entire sequence, rather than just the 'invoke' instruction itself.
# This class abstracts the data from the codeburst.

oo::class create quadcode::invocationSequence {

    # xfmr - quadcode::transformer object holding the bytecode
    # 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.
    }

}
 
# quadcode::invocationSequence method analyze --
#
#	Decompose the codeburst that invokes a command from quadcode
#
# Parameters:
#	xfmr_ - quadcode::transformer object holding the quadcode
#	b_ - Basic block number in which the invoke instruction appears
#	pc_ - PC within the basic block at which the invoke instruction appears
#
# Results:
#	None
#
# Side effects:
#	Initializes variables according to the instruction.

oo::define quadcode::invocationSequence method analyze {xfmr_ b_ pc_} {

    set xfmr $xfmr_
    set b $b_
    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

    set outvars {}
    while {[lindex $bb [incr pc] 0] eq "moveFromCallFrame"} {
	set q2 [lindex $bb $pc]
	lassign $q2 - varout cf2 litname
	if {$cf2 ne $cfout} {
	    error "cannot analyze: moveFromCallFrame mislinked"
	}
	lassign $litname kind val
	if {$kind ne "literal"} {
	    error "cannot analyze: moveFromCallFrame with non-literal variable"
	}
	dict set outvars $val $varout
    }
    incr pc -1

    # Find the error exit

    if {[lindex $bb [incr pc] 0] eq "jumpMaybe"} {
	set q2 [lindex $bb $pc]
	lassign $q2 - target cond
	if {$cond ne $retval} {
	    error "cannot analyze: jumpMaybe mislinked"
	}
	set errexit [lindex $target 1]
    } else {
	error "cannot analyze: invocation does not end basic block."
    }

    # Find the normal exit

    if {[lindex $bb [incr pc] 0] eq "jump"} {
	set normexit [lindex $bb $pc 1 1]
    } 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 invars --
#
#	Returns the input variables of an invocation sequence

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

# quadcode::invocationSequence method normexit --
#
#	Returns the normal exit block number for an invocation sequence

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

# quadcode::invocationSequence method outvars --
#
#	Returns the output variables of an invocation sequence

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

# 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
}

source [file join $quadcode::libdir copyprop.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 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 copyprop.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 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 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]

#
# Preconditions:
#       This pass presumes that the quadcode is partitioned into basic blocks,
#       and that SSA conversion has been run (so a constant procedure name
#       will have propagated into 'invoke' instructions. It also presumes
#       that procedure names have been resolved into the fully qualified names.
#
#       This pass introduces temporaries, but only locally to basic blocks,
#       so it does not require elaborate rewriting of SSA form. It must run
#       prior to parameter type checking (including the 'rewriteParamChecks'
#       peephole).

#
#       There is a hidden assumption in this method that default args are
#       always of acceptable type - and so type checks need not be
#       emitted for default parameters. (There is major rethinking needed
#       if this ever might not be the case.)

oo::define quadcode::transformer method varargs {} {
................................................................................
#
# 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
................................................................................
#
# 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] {
................................................................................
#	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
................................................................................
#	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

#
# Preconditions:
#       This pass presumes that the quadcode is partitioned into basic blocks,
#       and that SSA conversion has been run (so a constant procedure name
#       will have propagated into 'invoke' instructions. It also presumes
#       that procedure names have been resolved into the fully qualified names.
#


#       This pass must run prior to parameter type checking (including the

#       'rewriteParamChecks' peephole).
#
#       There is a hidden assumption in this method that default args are
#       always of acceptable type - and so type checks need not be
#       emitted for default parameters. (There is major rethinking needed
#       if this ever might not be the case.)

oo::define quadcode::transformer method varargs {} {
................................................................................
#
# 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} {







    # 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 [my va_GetArgInfo $q] 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 $pc]
    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 $b $pc $q $arginfo
 
    puts "NOT FINISHED."
    exit
    $B destroy
    $call destroy
    return
}
 
# quadcode::transformer method va_GetArgInfo --
#
#	Determines the target of an invocation and performs [info args] on
#	that target to get its argument list.
#
# Parameters:
#	q - Quadcode 'invoke' or 'invokeExpanded' instruction
#
# Results:
#	Returns [list 1 $arglist] if the callee is known and [info args]
#	succeeds. Returns [list 0 {}] for an unknown callee or one whose
#	expected args are unknown.

oo::define quadcode::transformer method va_GetArgInfo {q} {
    set cmd [lindex $q 3]
    if {[lindex $cmd 0] ne "literal"
        || [catch {info args [lindex $cmd 1]} arginfo]} {
        return {0 {}}
    } else {
        return [list 1 $arginfo]
    }
}
 
# 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.
#	b - Basic block where the original 'invoke' instruction resided
#	pc - Program counter within the basic block
#	q - 'invoke' or 'invokeExpanded' instruction.
#	arginfo - Arguments expected by the invoked command
#
# Results:
#	None.
#
# The command name being invoked, and the expected arguments, ar always known
# at this point.

oo::define quadcode::transformer method va_PrepareArgs {B b pc q arginfo} {
    
    set argl [lassign $q opcode result cfin cmd]

    # Create the first part of the 'invoke' instruction.
    




    set iresult [my newVarInstance $result]
    set newq [list invoke $result $cfin $cmd]



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




    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 [lrange $q 4 end]
    set pos 0
    while {$pos < $nPlainParams} {
        if {[my va_NonExpandedArgument newq $arginfo $pos $argl]} break
        incr pos
    }

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

    # Generate code to make the rest of the args into a list
    lassign [my va_MakeArgList $B $argl $pos $cfin] mightThrow listLoc












    # 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 {temp @arglen}]
    set lenLoc [my newVarInstance {temp @arglen}]
    $B emit [list listLength $lenLoc1 $listLoc]
    
    my debug-varargs {
        $B log-last
    }
    $B emit [list extractMaybe $lenLoc $lenLoc1]
    my debug-varargs {
        $B log-last
    }



    # Count the mandatory args
    set firstMandatory $pos
    while {$pos < $nPlainParams} {
        my debug-varargs {
            puts "varargs: does arg $pos: \"[lindex $arginfo $pos]\"\
                  have a default?"
        }
        if {[info default $callee [lindex $arginfo $pos] defaultVal]} {
            my debug-varargs {
                puts "         yes: \"defaultVal\""
            }
            break
        }
        incr pos
    }
    my debug-varargs {
        puts "varargs: first optional arg is at position $pos"
    }
    set firstOptional $pos


    puts "NOT DONE - varargs built the arglist in $listLoc"
    exit 1

}


if 0 {

    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
................................................................................
#
# 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]
    my debug-varargs {
        puts "varargs: Split basic block $b:"
        puts "   $b:$pc: [lindex $bb $pc]"
    }

    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] {
................................................................................
#	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]
    my debug-varargs {
        puts "varargs: transfer actual arg [list $arg] into formal arg\
              \"$param\""
    }
    switch -exact -- [lindex $arg 0] {
        "literal" {
        }
        "temp" - "var" {
            lassign [my findDef $arg] defb defpc defstmt
            if {[lindex $defstmt 0] eq "expand"} {
                return 1
................................................................................
#	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
#	cfin - Callframe input to the 'invoke' instruction.
#
# Results:
#
#	Returns a two-element list. The first element is 1 if it is possible
#	that the argument list is a non-list, and 0 otherwise.  The second
#	element is the name of a variable, temporary or literal that holds the
#	expanded list.

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

    my debug-varargs {
        puts "varargs: make arg list for [list $argl] from position $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]} {
        my debug-varargs {
            puts "varargs: there are no args to list"
        }
        set listLoc "literal {}"
        set mightThrow 0
    } else {
        set arg [lindex $argl $pos]
        my debug-varargs {
            puts "varargs: transfer first arg [list $arg]"
        }
        switch -exact -- [lindex $arg 0] {
            "literal" {
                set listloc [$B maketemp arglist]
                $B emit [list list $listloc $arg]
                my debug-varargs {
                    $B log-last
                }
                $B emit [list extractMaybe $listLoc $intLoc]
                my debug-varargs {
                    $B log-last
                }
                set mightThrow 0
            }
            "temp" - "var" {
                lassign [my findDef $arg] defb defpc defstmt
                if {[lindex $defstmt 0] eq "expand"} {
                    my debug-varargs {
                        puts "  (which is expanded!)"
                    }
                    set listLoc [lindex $defstmt 2]
                    set mightThrow 1
                } else {
                    set intLoc [$B maketemp arglist]
                    set listLoc [$B maketemp arglist]
                    my debug-varargs {
                        puts "  (which is not expanded)"
                    }
                    $B emit [list list $intLoc $arg]
                    my debug-varargs {
                        $B log-last
                    }
                    $B emit [list extractMaybe $listLoc $intLoc]
                    my debug-varargs {
                        $B log-last
                    }
                    set mightThrow 0
                }
            }
        }
    }
    my debug-varargs {
        puts "varargs: transferred first arg into [list $listLoc]."
        puts "         mightThrow = $mightThrow"
    }




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

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

        my debug-varargs {
            puts "varargs: transfer arg $arg"
        }

        # 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"
                    set mightThrow 1
                } 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]
        my debug-varargs {
            $B log-last
        }


        # If the concatenation might have failed, emit the error check
        if {$mightThrow} {
            my va_MakeErrorCheck $B $cfin $nloc
            set mightThrow 0
        }

        # On normal exit from list construction, extract the result from the
        # 'maybe' returned by listAppend or listConcat
        set listLoc [$B maketemp arglist]
        $B emit [list extractMaybe $listLoc $nloc]
        my debug-varargs {
            $B log-last
        }
    }

    set retval [list $mightThrow $listLoc]
    return $retval

}
 
# quadcode::transformer method va_MakeErrorCheck --
#
#	Emits code to jump to an error block if a given value is FAIL.
#
# Parameters:
#	B - Builder that is emitting code
#	cf - Callframe that is active at the time of the check
#	val - Value that might be FAIL
#
# Results:
#	None.
#
# Side effects:
#	Emits the necessary jumpMaybe, and adds callframe and FAIL value
#	to the phi operations at the head of the error block.

oo::define quadcode::transformer method va_makeErrorCheck {B cf val} {

    # Emit any required error checking when building the variable
    # argument list.
    my va_MakeErrorBlock $B
    set intb [$B makeblock]
    set nextb [$B makeblock]

    # Close out the current block with jumpMaybe to an intermediate
    # block and jump to the normal return
    $B emit [list jumpMaybe [list bb $intb] $val]

    my debug-varargs {
        $B log-last
    }
    $B emit [list jump [list bb $nextb]]







    my debug-varargs {
        $B log-last
    }


    # Make an intermediate block that jumps to the error block
    $B buildin $intb
    



    my debug-varargs {
        $B log-last
    }
    $B emit [list jump [list bb $errorb]]
    my debug-varargs {
        $B log-last
    }


    # Add phis for the error result ant the callframe to the error block
    set errorInPhi [$B get-or-make-temp error]
    set callframeInPhi [$B get-or-make-temp error-callframe]
    $B phi $errorb $errorInPhi $val
    $B phi $errorb $callframeInPhi $cf

    # Now continue building in the normal exit
    $B buildin $nextb
}
 
# quadcode::transformer method va_CheckEnough --
#
#	Emits code to check for too few args passed to invokeExpanded
#
# Parameters:
#	b - Basic block number under construction