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

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

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