#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
#------------------------------------------------------------------------------

oo::define Builder {
			  
    # Builder:Tcl_Alloc --
    #
    #	Allocate memory using Tcl's system
    #
    # Parameters:
    #	size - An LLVM value reference giving the size of the block to allocated
    #	name - The name to give to the value
    #
    # Results:
    #	Returns an LLVM value reference designating the pointer to the allocated
    #	block

    method Tcl_Alloc {size {name {}}} {
	my call ${tcl.alloc} [list $size] $name
    }
    export Tcl_Alloc

    # Builder:Tcl_Free --
    #
    #	Free memory using Tcl's system
    #
    # Parameters:
    #	block - An LLVM value reference giving the pointer to the block

    method Tcl_Free {block} {
	my call ${tcl.free} [list $block]
    }
    export Tcl_Free

    # Builder:isInt32 --
    #
    #	Generate code to test if an INT holds an int32.
    #
    # Parameters:
    #	INT -	The INT LLVM value reference.
    #	name (optional) -

    #	argc -	The int LLVM value reference for the number of arguments.
    #	argv -	The STRING* LLVM value reference (or equivalent type) for the
    #		array of arguments, allocated on the function stack.
    #	proc -	The LLVM value reference to the procedure's metadata.
    #	localcache -
    #		The LLVM value reference to the procedure's local variable
    #		metadata.
    #	callframe - The LLVM pointer reference to the callframe to construct
    #	entryBlock - The entry block of the function, needed for allocating
    #	             the array of local variables.
    #
    # Results:
    #	A Tcl list of the LLVM CALLFRAME value reference and the mapping
    #	dictionary from string variable names to the corresponding LLVM Var*
    #	value references.

    method frame.create {varlist argc argv proc localcache callframe
			 entryBlock} {
	# Construct the call frame itself

	set length [Const [llength $varlist]]
	set locals [my arrayAllocInBlock $entryBlock Var $length]
	my Call tcl.callframe.init $callframe $length \
	    $argc [my cast(ptr) $argv STRING] $proc $localcache $locals
	# Initialise the information about the local variables
	set idx -1
	set varmap {}
	foreach varinfo $varlist {
	    lassign $varinfo flags var

    #		The CALLFRAME LLVM value reference.
    #	ec -	An int* LLVM reference for where to write error codes into.
    #	name (optional) -
    #		The LLVM name of the result value.
    #
    # Results:
    #	An LLVM bool? value reference.
    
    method frame.bind.upvar(STRING,STRING,STRING) {
	localName level otherName localVar callframe ec {name ""}
    } {
	set otherVar [my call ${tcl.callframe.lookup.upvar} [list \
		$callframe $level $otherName] "otherVar"]
	set val [my call ${tcl.callframe.bindvar} [list \
		$callframe $otherVar $localVar $localName $ec] $name]
	return [my frame.pack $callframe $val $name]
    }


    }

    # Builder:allocBitv --
    #
    #	Allocate a bit vector of a given length.
    #
    # Parameters:
    #	entryBlock - The block in which the 'alloca' should appear
    #	len - The length of the vector
    #	name (optional) - Name to give to the resulting LLVM value
    #
    # Results:
    #	Returns an LLVM int1* reference designating the start of the vector
    #
    # MUST BE CALLED WHILE EMITTING CODE FOR THE ENTRY BLOCK AND AT
    # NO OTHER TIME

    method allocBitv {entryBlock len {name {}}} {
	set type [Type array{bool,$len}]
	set bits [my allocInBlock $entryBlock $type ${name}.space]
	set first [my gep $bits 0]
	SetValueName $first $name
	return $first
    }

    # Builder:allocObjv --
    #
    #	Allocate a STRING vector of a given length
    # 
    # Parameters:
    #	entryBlock - The block in which the 'alloca' should appear
    #	len - The length of the vector
    #	name (optional) - Name to give to the resulting LLVM value
    #
    # Results:
    #	Returns an LLVM STRING* reference designating the start of the vector
    #
    # MUST BE CALLED WHILE EMITTING CODE FOR THE ENTRY BLOCK AND AT
    # NO OTHER TIME

    method allocObjv {entryBlock len {name {}}} {
	set type [Type array{STRING,$len}]
	set strs [my allocInBlock $entryBlock $type ${name}.space]
	set first [my gep $strs 0]
	SetValueName $first $name
	return $first
    }

    # Builder:appendString --
    #

    #	as where a multi-element dictionary path is required. This value
    #	*MUST* be cleaned up after use with clearVector.
    #
    # Parameters:
    #	start - An LLVM STRING* value that designates the start of the vecotr
    #	types -	The types of the values used to build the vector, as a Tcl
    #		list of type descriptors.
    #	qvalues -
    #		Tcl list of quadcode values that are the individual
    #		elements of the vector.
    #	lvalues - Tcl list of LLVM values of the individual elements
    # Results:
    #	LLVM vector value reference.

    method buildVector {start types qvalues lvalues} {
	# Implementation note: there must be no branches in the issued code.
	set vectortype [Type struct{int,STRING*}]
	set idx -1
	foreach src $qvalues t $types v $lvalues {
	    set s [my stringify($t) $v]
	    set cell [my gep $start 0 [incr idx]]
	    my store $s $cell
	    if {![my IsVectorItemConstant $src $t]} {
		my addReference(STRING) $s
	    }
	}
	set vector [my undef $vectortype]
	set vector [my insert $vector [Const [llength $lvalues]] 0]
	set vector [my insert $vector [my gep $start 0 0] 1]
	return $vector
    }

    # Builder:ExtractVector --
    #
    #	Extract the length and array of STRINGs from a vector.

    }

    # Builder:clearVector --
    #
    #	Clean up a vector value created with buildVector.
    #
    # Parameters:
    #	objv - The start of the vector to be cleared
    #	srcs -	The quadcode values that the vector elements were built from.
    #		Used to detect direct literal STRINGs, which don't need
    #		free-ing.
    #	types -	The types of the values used to build the vector.
    #
    # Results:
    #	None.

    method clearVector {objv types srcs} {
	set idx -1
	foreach src $srcs t $types {
	    
	    incr idx
	    if {![my IsVectorItemConstant $src $t]} {
		set ptr [my gep $objv 0 $idx]
		set toDrop [my load $ptr]
		my dropReference [my load [my gep $objv 0 $idx]]
	    }
	}
	return
    }

    # Builder:concat() --
    #
    #	Concatenate a collection of values using the classic Tcl algorithm.
    #	Quadcode implementation ('concat').

    # Builder:invoke --
    #
    #	Generate code to call a Tcl command.  Quadcode implementation
    #	('invoke').
    #
    # Parameters:
    #	arguments -
    #		The arguments as an LLVM array value reference. Note that
    #		this includes the function name as the first argument.
    #	havecf -
    #		Tcl boolean indicating if we have a valid callframe.
    #	cf -	The reference to the current callframe if 'havecf' is true.
    #	ec -	Location to write the Tcl return code into, as an LLVM int*
    #		reference.
    #	resultName (optional) -
    #		A name to give to the result value.
    #
    # Results:
    #	An LLVM value reference.

    method invoke {arguments havecf cf ec {resultName ""}} {
	my ExtractVector $arguments
	if {!$havecf} {
	    set cf {}
	}
	my call ${tcl.invoke.command} [list $len $ary $cf $ec] $resultName
    }

    # Builder:invokeNRE --
    #
    #	Generate code to call a Tcl command with non-recursive eval.
    #	Quadcode implementation ('NRE.invoke').
    #
    # Parameters:
    #	arguments -
    #		The arguments as an LLVM array value reference. Note that
    #		this includes the function name as the first argument.
    #	havecf -
    #		Tcl boolean indicating if we have a valid callframe.
    #	cf -	The reference to the current callframe if 'havecf' is true.
    #	ec -	Location to write the Tcl return code into, as an LLVM int*
    #		reference.
    #	resultName (optional) -
    #		A name to give to the result value.
    #
    # Results:
    #	None. The command's return value is in the coroutine promise.

    method invokeNRE {arguments havecf cf ec {resultName ""}} {
	my ExtractVector $arguments
	if {!$havecf} {
	    set cf {}
	}
	my call ${tcl.invoke.command.nre} [list $len $ary $cf $ec] $resultName
    }

    # Builder:invokeExpanded --
    #
    #	Generate code to call a Tcl command while doing argument expansion.
    #	Quadcode implementation ('invokeExpanded').
    #
    # Parameters:
    #	arguments -
    #		The arguments as an LLVM vector value reference. Note that
    #		this includes the function name as the first argument.
    #	flags -	LLVM bit array indicating which arguments to expand.
    #	ec -	Location to write the Tcl return code into, as an LLVM int*
    #		reference.
    #	resultName (optional) -
    #		A name to give to the result value.
    #
    # Results:
    #	None. The command's return value is in the coroutine promise.

    method invokeExpanded {arguments flags ec {resultName ""}} {
	my ExtractVector $arguments
	my call ${tcl.invoke.expanded} [list $len $ary $flags $ec] $resultName
    }

    # Builder:invokeExpandedNRE --
    #
    #	Generate code to call a command with non-recursive eval while doing
    #	argument expansion. Quadcode implementation ('NRE.invokeExpanded').
    #
    # Parameters:
    #	arguments -
    #		The arguments as an LLVM vector value reference. Note that
    #		this includes the function name as the first argument.
    #	flags -	LLVM bit array indicating which arguments to expand.
    #	havecf -
    #		Tcl boolean indicating if we have a valid callframe.
    #	cf -	The reference to the current callframe if 'havecf' is true.
    #	ec -	Location to write the Tcl return code into, as an LLVM int*
    #		reference.
    #	resultName (optional) -
    #		A name to give to the result value.
    #
    # Results:
    #	None.

    method invokeExpandedNRE {arguments flags havecf cf ec {resultName ""}} {
	my ExtractVector $arguments
	if {!$havecf} {
	    set cf {}
	}
	my call ${tcl.invoke.expanded.nre} [list $len $ary $flags $cf $ec] \
	    $resultName
    }

    method restoreFrame {frame} {
	my call ${tcl.restoreFrame} [list $frame]
    }

    # Builder:isBoolean(INT BOOLEAN) --
    #
    #	Test if a value is a boolean. Quadcode implementation ('isBoolean').
    #
    # Parameters:
    #	value -	The value to test, as an LLVM value reference.

#	none

oo::class create TclCompiler {
    superclass llvmEntity
    variable bytecode cmd func quads paramTypes returnType vtypes variables
    variable m b pc errorCode currentline currentprocrelline currentscript
    variable bytecodeVars namespace objv bitv
    variable nreReturnType coro_info

    constructor {} {
	next
	namespace import \
	    ::quadcode::nameOfType \
	    ::quadcode::typeOfLiteral \
	    ::quadcode::typeOfOperand \

	if {$channel eq ""} {
	    return [format "%s------>\n%s" $cmd [join $descriptions \n]]
	} else {
	    puts $channel [format "%s------>\n%s" $cmd [join $descriptions \n]]
	}
    }

    # TclCompiler:GenerateDeclaration --
    #
    #	Generate the declaration for the function that we are transforming the
    #	Tcl code into.
    #
    # Parameters:
    #	module -
    #		The module reference (i.e., instance of Module class) to
    #		generate the function within.
    #	qs -
    #		The quadcode sequence
    #
    # Results:
    #	The function reference (i.e., instance of Function class) that we have
    #	generated. Note that this will be an unimplemented function at this
    #	stage.

    method GenerateDeclaration {module qs} {
	set m $module

	##############################################################
	#
	# Compute the argument types
	#

	set argl {}
	set argn {}
	foreach typecode $paramTypes {
	    set type [nameOfType $typecode]
	    lappend argn $type
	    lappend argl [Type $type]
	}

	##############################################################
	#
	# Compute the return type
	#

	set rtype char*
	foreach insn $qs {
	    switch -exact -- [lindex $insn 0 0] {
		"entry" {
		    set rtype [nameOfType $returnType]
		    break
		}
		"NRE.entry" {
		    set nreReturnType [nameOfType $returnType]
		    break
		}
	    }
	}
	set returntype [Type $rtype]

	##############################################################
	#
	# Construct the function signature type and the function object.
	#

	}
	$func setAsCurrentDebuggingScope

	lassign [my GenerateBasicBlocks $quads] blockDict ipathDict pred
	array set block $blockDict
	array set ipath $ipathDict

	# NB: block(-2) contains the alloca's for the function.
	#     block(-1) is the function entry block. It's supposed to be
	# almost entirely optimized out.

	$block(-2) build-in $b
	$b @location 0
	set errorCode [$b alloc int "tcl.errorCode"]

	set 0 [$b int 0]

	$block(-1) build-in $b
	$b @location 0
	set curr_block $block(-1)

	##############################################################
	#
	# Create debug info for variables in LLVM

	dict for {name typecode} $vtypes {
	    lassign $name kind formalname origin
	    set type [nameOfType $typecode]

		} else {
		    # Not a parameter; set up the debugging metadata as a
		    # local variable.
		    $func localvar $formalname $type
		}
	    }
        }

	foreach insn $quads {
	    switch -exact -- [lindex $insn 0 0] {
		"NRE.entry" {
		    set coro_info \
			[my IssueNREEntrySequence $curr_block $block(0)]
		    set curr_block $block(0)
		    break
		}
		"entry" {
		    break
		}
	    }
	}

	##############################################################
	#
	# Convert Tcl parse output, one instruction at a time.
	#

	set pc -1
	set ERROR_TEMPLATE "\n    (compiling \"%s\" @ pc %d: %s)"
	set phiAnnotations {}
	set phiPending {}
	set theframe {}
	set thevarmap {}
	set syntheticargs {}
	set currentline 0
	set currentprocrelline 0
	set currentscript {}

	foreach l $quads {
	    incr pc
	    if {[info exists block($pc)]} {
		$block($pc) build-in $b
		set curr_block $block($pc)
		set consumed {}
	    }
	    unset -nocomplain tgt

	    ##########################################################
	    #
	    # Issue the code for a single quadcode instruction.
	    #

	    try {
	    $b @location $currentline
	    switch -exact -- [lindex $l 0 0] {
		"entry" {
		    lassign [my IssueEntry $l $pc $block(-2)] \
			theframe thevarmap syntheticargs
		}
		"NRE.entry" {
		    lassign [my IssueEntry $l $pc $block(-2)] \
			theframe thevarmap syntheticargs
		}
		"allocObjvForCallees" {
		    set objc [lindex $l 2 1]
		    if {$objc > 0} {
			$b @location $currentline
		    	set objv [$b allocObjv $block(-2) \
				      $objc "objv.for.callees"]
		    	set bitv [$b allocBitv $block(-2) \
				      $objc "flags.for.invokeExpanded"]
		    }
		}
		"confluence" - "unset" {
		    # Do nothing; required for SSA computations only
		}
		"@debug-file" {
		}

			append opcode ( [my ValueTypes {*}$srcs] )
			set srcs [lmap s $srcs {my LoadOrLiteral $s}]
			set res [$b $opcode {*}$srcs $errorCode $name]
			my StoreResult $tgt $res
		    } else {
			# Need to construct the variadic path
			set vectortypes [lmap s $srcs {my ValueTypes $s}]
			set vectorValues [lmap s $srcs {my LoadOrLiteral $s}]
			set vector [$b buildVector $objv $vectortypes $srcs \

				       $vectorValues]
			append opcode ( [my ValueTypes $srcObj] )
			set srcObj [my LoadOrLiteral $srcObj]
			set res [$b $opcode $srcObj $vector $errorCode $name]
			my StoreResult $tgt $res
			$b clearVector $objv $vectortypes $srcs
		    }
		    if {"FAIL" in [my ValueTypes $tgt]} {
			my SetErrorLine $errorCode [$b maybe $res]
		    }
		}
		"dictSet" - "listSet" {
		    set srcs [lassign $l opcode tgt srcObj srcValue]
		    set name [my LocalVarName $tgt]
		    if {[llength $srcs] == 1} {
			# Simple case
			set srcs [list $srcObj {*}$srcs $srcValue]
			append opcode ( [my ValueTypes {*}$srcs] )
			set srcs [lmap s $srcs {my LoadOrLiteral $s}]
			set res [$b $opcode {*}$srcs $errorCode $name]
			my StoreResult $tgt $res
		    } else {
			# Need to construct the variadic path
			set vectortypes [lmap s $srcs {my ValueTypes $s}]
			set vector [$b buildVector $objv $vectortypes $srcs \
				  [lmap s $srcs {my LoadOrLiteral $s}]]
			set srcs [list $srcObj $srcValue]
			append opcode ( [my ValueTypes {*}$srcs] )
			set srcs [lmap s $srcs {my LoadOrLiteral $s}]
			set res [$b $opcode {*}$srcs $vector $errorCode $name]
			my StoreResult $tgt $res
			$b clearVector $objv $vectortypes $srcs
		    }
		    if {"FAIL" in [my ValueTypes $tgt]} {
			my SetErrorLine $errorCode [$b maybe $res]
		    }
		}
		"copy" - "expand" {
		    lassign $l opcode tgt src

		    set mth isTrue([my ValueTypes $src])
		    set test [$b $mth [my LoadOrLiteral $src] test_$name]
		    $b condBr $test $ipath($pc) $block($tgt)
		}
		"jump" {
		    $b br $block([lindex $l 1 1])
		}
		"NRE.suspend" {
		    set tgt [lindex $l 1 1]
		    my CoroSuspend $coro_info $block($tgt)
		}				 
		"return" {
		    lassign $l opcode -> frame src
		    set val [my LoadOrLiteral $src]
		    if {"CALLFRAME" in [my ValueTypes $src]} {
			# The CALLFRAME does not leave
			set val [$b frame.value $val]
		    }
		    set type [nameOfType $returnType]
		    if {refType($type)} {
			$b printref $val "ret:"
			if {literal($src)} {
			    $b addReference($type) $val
			}
		    }
		    if {$theframe ne "" && ![IsNull $theframe]} {
			$b frame.release $theframe $syntheticargs
		    }
		    $b ret $val
		}
		"NRE.return" {
		    lassign $l opcode -> frame src
		    set val [my LoadOrLiteral $src]
		    if {"CALLFRAME" in [my ValueTypes $src]} {
			# The CALLFRAME does not leave
			set val [$b frame.value $val]
		    }
		    set type [nameOfType $returnType]
		    if {refType($type)} {
			$b printref $val "ret:"
			if {literal($src)} {
			    $b addReference($type) $val
			}
		    }
		    if {$theframe ne "" && ![IsNull $theframe]} {
			$b frame.release $theframe $syntheticargs
		    }
		    my CoroReturn $coro_info $val
		}
		    
		"phi" {
		    set values {}
		    set sources {}
		    foreach {var origin} [lassign $l opcode tgt] {
			set spc [lindex $origin end]
			while {![info exists block($spc)]} {incr spc -1}
			set s $block($spc)

		    foreach aa $arguments {
			set arguments [lassign $arguments a]
			if {$a ni $arguments && consumed($a, $pc + 1)} {
			    lappend consumed $a
			}
		    }
		}
		"NRE.invoke" {
		    my IssueNREInvoke $theframe $l
		}
		"invokeExpanded" {
		    set arguments [my IssueInvokeExpanded $theframe $l]
		    foreach aa $arguments {
			set arguments [lassign $arguments a]
			if {$a ni $arguments && consumed($a, $pc + 1)} {
			    lappend consumed $a
			}
		    }
		}
		"NRE.invokeExpanded" {
		    my IssueNREInvokeExpanded $theframe $l
		}
		"NRE.returnFromInvoke" {
		    set arguments [my IssueNREReturnFromInvoke $theframe $l]
		    foreach aa $arguments {
			set arguments [lassign $arguments a]
			if {$a ni $arguments && consumed($a, $pc + 1)} {
			    lappend consumed $a
			}
		    }
		}
		"NRE.returnFromInvokeExpanded" {
		    set arguments \
			[my IssueNREReturnFromInvokeExpanded $theframe $l]
		    foreach aa $arguments {
			set arguments [lassign $arguments a]
			if {$a ni $arguments && consumed($a, $pc + 1)} {
			    lappend consumed $a
			}
		    }
		}
		"frameArgs" {

		    }
		    my StoreResult $tgt $result
		}
		"concat" {
		    set srcs [lassign $l opcode tgt]
		    # Need to construct the variadic vector
		    set vectortypes [lmap s $srcs {my ValueTypes $s}]
		    set vectorValues [lmap s $srcs {my LoadOrLiteral $s}]
		    set vector [$b buildVector $objv $vectortypes $srcs \

				   $vectorValues]
		    set name [my LocalVarName $tgt]
		    set result [$b concat() $vector $name]
		    my StoreResult $tgt $result
		    $b clearVector $objv $vectortypes $srcs
		}
		"foreachStart" {
		    set srcs [lassign $l opcode tgt assign]
		    set listtypes [lmap s $srcs {my ValueTypes $s}]
		    set lists [lmap s $srcs {my LoadOrLiteral $s}]
		    set result [$b foreachStart \
				    [lindex $assign 1] $lists \

    #	dictionary says which block contains the next instruction (necessary
    #	for forking jumps); i.e., the Instruction Path. The third says which
    #	blocks are the predecessors of the current block.

    method GenerateBasicBlocks {quads} {
	# Instructions that will always jump.
	set JUMPS {
	    "jump" "NRE.suspend"
	}
	# Instructions that can go to either the next instruction OR the named
	# instruction.
	set FORKJUMPS {
	    "jumpFalse" "jumpTrue"
	    "jumpMaybe" "jumpMaybeNot"
	}
	# Instructions that terminate execution of the function.
	set EXITS {
	    "return" "NRE.return"
	}

	##############################################################
	#
	# Create basic blocks
	#

	set block(-2) [$func block]; # Block(-2) is reserved for alloca's
	set block(-1) [$func block]; # Block(-1) is entry code that precedes
	;			     # any user code in the function
	set next_is_ipath 1
	set pc -1
	foreach q $quads {
	    incr pc
	    set opcode [lindex $q 0 0]
	    if {$next_is_ipath >= 0} {
		if {![info exists block($pc)]} {

	##############################################################
	#
	# Compute the predecessors of each basic block
	#

	set pc -1
	set pred {-1 -2}
	set cb $block(-1)
	foreach q $quads {
	    incr pc
	    if {![info exist cb]} {
		set cb $block($pc)
	    } elseif {[info exist block($pc)]} {
		dict lappend pred $block($pc) $cb

    # TclCompiler:IssueEntry --
    #
    #	Generate the code for creating a callframe at the start of a function.
    #	Must only be called from the 'compile' method.
    #
    # Parameters:
    #	quad -	The 'entry' quadcode, including its parameters.
    #	pc - The program counter at which the entry appears.
    #	entryBlock - The Block of the entry to the function, used to make
    #	             sure that any allocations happen early
    #
    # Results:
    #	A triple of the callframe, the local variable mapping, and a list
    #	saying which elements in the callframe are synthetic (i.e., have no
    #	existing string representation) and need to be released on function
    #	exit.

    method IssueEntry {quad pc entryBlock} {

	lassign $quad opcode tgt vars

	# When no frame is wanted
	if {$tgt eq {}} {
	    return [list [$b null CALLFRAME] {} {}]
	}

	# Store the fact that we must generate complex metadata for this
	# function/command, and the variable where this metadata will be
	# stored.
	if {![dict exists $bytecode procmeta]} {
	    dict set bytecode procmeta \
		[$m variable [list procmeta $cmd] Proc* [$b null Proc*]]
	    dict set bytecode localcache \
		[$m variable [list localcache $cmd] LocalCache* \
		     [$b null LocalCache*]]
	}

	# Build the argument list. First, we get the Tcl descriptors of the
	# arguments, their types, etc.


	set arguments [list [list literal $cmd]]

	set argtypes {STRING}
	for {incr pc} {[lindex $quads $pc 0] eq "param"} {incr pc} {
	    set vname [lindex $quads $pc 1]
	    lappend arguments $vname
	    lappend argtypes [my ValueTypes $vname]
	}

	set varmeta [dict get $bytecode variables]

	# Patch in the extra variables discovered during quadcode analysis;
	# these are never arguments as Tcl always correctly puts those in the
	# original bytecode descriptor.
	set stdnames [lmap vinfo $varmeta {lindex $vinfo 1}]
	foreach v [lindex $vars 1] {
	    if {$v ni $stdnames} {
		lappend varmeta [list scalar $v]
	    }
	}
	dict set bytecode variables $varmeta

	# Now we allocate the storage for the argument list
	set argc [Const [llength $arguments]]
	set argv [$b allocInBlock $entryBlock \
		      [Type array{Tcl_Obj*,[llength $arguments]}] argv]

	# Store the arguments in the argument list
	set cell [$b gep $argv 0 0]
	$b store [Const $cmd STRING] $cell
	set idx -1
	set drop 0
	foreach v $arguments t $argtypes {
	    if {[incr idx]} {
		set val [$b stringify($t) [$func param [expr {$idx-1}]]]
		$b store $val [$b gep $argv 0 $idx]
		lappend drop [expr {!refType($t)}]
	    }
	}

	# Create the stack frame
	set procmeta [dict get $bytecode procmeta]
	set localcache [dict get $bytecode localcache]
	set callframe [$b allocInBlock $entryBlock CallFrame "callframe"]

	lassign [$b frame.create $varmeta $argc $argv \
		     [$b load $procmeta "proc.metadata"] \
		     [$b load $localcache "proc.localcache"] \
		     $callframe $entryBlock] \
	    theframe thevarmap
	my StoreResult $tgt $theframe
	return [list $theframe $thevarmap $drop]
    }

    # TclCompiler:IssueInvoke --
    #

    # Results:
    #	The set of arguments that might have been consumed in the operation
    #	(for cleanup by the caller of this method).

    method IssueInvoke {callframe operation} {
	set arguments [lassign $operation opcode tgt thecallframe origname]
	set vname [my LocalVarName $tgt]


	set called [my ResolveInvoke \



			[dict get $vtypes $tgt] $origname $arguments]





	if {$called ne {}} {
	    set argvals [lmap arg $arguments {my LoadOrLiteral $arg}]























	    my IssueInvokeFunction $tgt $called $argvals $vname
	    return {}
	} else {
	    set arguments [linsert $arguments[set arguments ""] 0 $origname]



	    set argvals [lmap arg $arguments {my LoadOrLiteral $arg}]
	    my IssueInvokeCommand $tgt $arguments $argvals $vname
	    return $arguments
	}
    }

    # TclCompiler:IssueNREInvoke --
    #
    #	Generate the code for invoking another Tcl command by NRE. Must only be
    #	called from the 'compile' method.
    #
    # Parameters:
    #	callframe -
    #		The callframe.

    #	operation -
    #		The quadcode descriptor for the instruction.














    method IssueNREInvoke {callframe operation} {

	set arguments [lassign $operation opcode tgt thecallframe origname]
	set rettype [lindex $opcode 1]
	set vname [my LocalVarName $tgt]

	set called [my ResolveInvoke $rettype $origname $arguments]
	if {$called ne {}} {
	    set argvals [lmap arg $arguments {my LoadOrLiteral $arg}]
	    set useCallframe [expr {callframe($thecallframe)}]
	    set handle [my IssueNREInvokeFunction \
			    $useCallframe $callframe \
			    $rettype $tgt $called $argvals $vname]
	} else {
	    set arguments [linsert $arguments[set arguments ""] 0 $origname]
	    set argvals [lmap arg $arguments {my LoadOrLiteral $arg}]
	    my IssueNREInvokeCommand $tgt $called $arguments $argvals $vname
	}

    }

    method IssueInvokeCommand {tgt resolved arguments argvals vname} {
	upvar 1 callframe callframe thecallframe thecallframe

	set types [lmap s $arguments {my ValueTypes $s}]
	if {$resolved ne ""} {
	    # FIXME: this causes wrong "wrong # args" messages
	    set argvals [lreplace $argvals 0 0 $resolved]
	}
	set vector [$b buildVector $objv $types $arguments $argvals]
	set result [$b invoke $vector \
			[expr {callframe($thecallframe)}] $callframe \
			$errorCode $vname]
	$b clearVector $objv $types $arguments
	# Result type is now FAIL STRING, always.
	my SetErrorLine $errorCode [$b maybe $result]
	if {callframe($thecallframe)} {
	    set result [$b frame.pack $callframe $result]
	}
	my StoreResult $tgt $result
    }

    method IssueNREInvokeCommand {tgt resolved arguments argvals vname} {
	upvar 1 callframe callframe thecallframe thecallframe

	set types [lmap s $arguments {my ValueTypes $s}]
	if {$resolved ne ""} {
	    # FIXME: this causes wrong "wrong # args" messages
	    set argvals [lreplace $argvals 0 0 $resolved]
	}
	set vector [$b buildVector $objv $types $arguments $argvals]
	$b invokeNRE $vector [expr {callframe($thecallframe)}] \
	    $callframe $errorCode $vname

	# For an invoked command, we didn't launch another LLVM coroutine,
	# and the Tcl status and command return value will appear
	# in the current coroutine's promise.

	set result [dict get $coro_info coro_handle]
	if {callframe($thecallframe)} {
	    set result [$b frame.pack $callframe $result]
	}
	my StoreResult $tgt $result
    }

    # TclCompiler:IssueInvokeExpanded --

	set arguments [lassign $operation opcode tgt thecallframe]
	set vname [my LocalVarName $tgt]
	set expandPositions [lmap s $arguments {
	    expr {"EXPANDED" in [my OperandType $s]}
	}]
	set argvals [lmap s $arguments {my LoadOrLiteral $s}]
	set types [lmap s $arguments {my ValueTypes $s}]
	set vector [$b buildVector $objv $types $arguments $argvals]
	set flags [$b buildBitArray $bitv $expandPositions]
	set result [$b invokeExpanded $vector $flags $errorCode $vname]
	my SetErrorLine $errorCode [$b maybe $result]
	if {callframe($thecallframe)} {
	    set result [$b frame.pack $callframe $result]
	}
	my StoreResult $tgt $result
	$b clearVector $objv $types $arguments
	return $arguments
    }

    # TclCompiler:IssueNREInvokeExpanded --
    #
    #	Issues the codeburst needed to handle invocation with argument
    #	expansion in the NRE environment.
    #
    # Parameters:
    #	callframe - LLVM reference to the call frame
    #	operation - The quadcode operation being compiled
    #
    # Results:
    #	None.

    method IssueNREInvokeExpanded {callframe operation} {
	set arguments [lassign $operation opcode tgt thecallframe]
	set rettype [lindex $opcode 1]
	set vname [my LocalVarName $tgt]
	set expandPositions [lmap s $arguments {
	    expr {"EXPANDED" in [my OperandType $s]}
	}]
	set argvals [lmap arg $arguments {my LoadOrLiteral $arg}]
	set types [lmap s $arguments {my ValueTypes $s}]
	set vector [$b buildVector $objv $types $arguments $argvals]
	set flags [$b buildBitArray $bitv $expandPositions]

	$b invokeExpandedNRE $vector $flags [expr {callframe($thecallframe)}] \
	    $callframe $errorCode $vname]

	# For an invoked command, we didn't launch another LLVM coroutine, and
	# the Tcl status and command return value will appear in the current
	# coroutine's promise.

	set result [dict get $coro_info coro_handle]
	if {callframe($thecallframe)} {
	    set result [$b frame.pack $callframe $result]
	}
	my StoreResult $tgt $result
    }

    # TclCompiler:IssueNREReturnFromInvoke --
    #
    #	Generates the code to tidy up after an invoked NRE command returns.
    #
    # Parameters:
    #	callframe - The current callframe
    #	operation - The quadcode operation that represents the return point
    #
    # Results:
    #	Returns the set of arguments that might have been consumed in the
    #	call (for cleanup by the caller of this method).

    method IssueNREReturnFromInvoke {callframe operation} {

	set arguments [lassign $operation opcode tgt corohandle origname]
	set rettype [dict get $vtypes $tgt]
	set vname [my LocalVarName $tgt]
	set called [my ResolveInvoke $rettype $origname $arguments]

	# Built-in types that are handled here.
	set BASETYPES {ZEROONE INT DOUBLE NUMERIC STRING}
	set ts [lmap t $BASETYPES {Type $t?}]
	set tgttype [my ValueTypes $tgt]

	if {$called ne {}} {
	    set destroy 1
	} else {
	    set destroy 0
	}
	# Emit the sequence that destroys the LLVM coroutine and returns the
	# result as 'retval'
	lassign [my returnedIntoCoro $rettype $tgttype $corohandle $destroy] \
	    callframe retcode retval

	# Clean up the arguments if needed

	if {$called eq {}} {
	    set arguments [linsert $arguments[set arguments ""] 0 $origname]
	    set types [lmap s $arguments {my ValueTypes $s}]
	    $b clearVector $objv $types $arguments
	}

	# Handle the return

	if {$tgttype eq "FAIL"} {
	    # This procedure only ever fails.
	    $b store $retval $errorCode
	    my SetErrorLine $errorCode
	} else {
	    set restype [TypeOf $retval]; # LLVM type ref of the return val
	    if {$restype in $ts} {
		$b store [$b extract $retval 0] $errorCode
	    } elseif {[Type $restype?] eq [Type $tgttype]} {
		set retval [$b ok $retval]
	    }
	    if {"FAIL" in $tgttype} {
		my SetErrorLine $errorCode [$b maybe $retval]
	    }
	}
	# Pack a callframe reference with the return if needed

	if {"CALLFRAME" in $tgttype} {
	    set retval [$b frame.pack $callframe $retval]
	}

	my StoreResult $tgt $retval
	if {$called eq {}} {
	    return $arguments
	} else {
	    return {}
	}
    }

    # TclCompiler:ResolveInvoke --
    #
    #	Determines whether an invoked command is known as a compiled
    #	function, and resolves it if it is.
    #
    # Parameters:
    #	type - Type of the result of the invocation
    #	origname - Quadcode value holding the name of the function
    #              being invoked
    #	arguments - Arguments being passed to the function being invoked
    #
    # Results:
    #	Returns either an LLVM value reference to the function to call,
    #	or {} if there is no known function to call and the invocation
    #   must go through Tcl's evaluator.

    method ResolveInvoke {type origname arguments} {
	if {literal($origname)} {
	    set name [my FuncName [lindex $origname 1]]
	    set fullname [my GenerateFunctionName $name arguments $arguments]
	    if {[$m function.defined $fullname]} {
		return [[$m function.get $fullname] ref]
	    }
	    set type [nameOfType $type]
	    if {"FAIL" ni $type || "STRING" ni $type} {
		my Warn "$fullname is not implemented, but result is not\
		                FAIL STRING."
	    }
	}
	return {}
    }

    # TclCompiler:IssueInvokeFunction --
    #
    #	Issues the invocation sequence of a builtin function or compiled proc
    #
    # Parameters:
    #	tgt - Descriptor of the value where the result is to be stored
    #	func - LLVM value representing the function to invoke
    #	arguments - List of descriptors of the arguments to pass
    #	vname - Name of the result value
    #
    # Results:
    #	None
   
    method IssueInvokeFunction {tgt func arguments vname} {
	upvar 1 callframe callframe thecallframe thecallframe
	set BASETYPES {ZEROONE INT DOUBLE NUMERIC STRING}

	set result [$b call $func $arguments $vname]
	if {[my ValueTypes $tgt] eq "FAIL"} {
	    $b store $result $errorCode
	    my SetErrorLine $errorCode
	} else {
	    set ts [lmap t $BASETYPES {Type $t?}]
	    if {[TypeOf $result] in $ts} {
		$b store [$b extract $result 0] $errorCode
	    } elseif {[Type [TypeOf $result]?] eq [Type [my ValueTypes $tgt]]} {
		# Managed to prove non-failure in this case...
		set result [$b ok $result]
	    }
	    if {"FAIL" in [my ValueTypes $tgt]} {
		my SetErrorLine $errorCode [$b maybe $result]
	    }
	}
	if {callframe($thecallframe)} {
	    set result [$b frame.pack $callframe $result]
	}
	my StoreResult $tgt $result
    }

    # TclCompiler:IssueNREInvokeFunction --
    #
    #	Issues the invocation sequence of a builtin function or compiled proc
    #
    # Parameters:
    #   rettype - Return type of the function to be invoked. This is
    #	          necessary because the type of $tgt will always be
    #		  'LLVM coroutine handle'
    #	tgt - Descriptor of the value where the result is to be stored
    #	func - LLVM value representing the function to invoke
    #	arguments - List of descriptors of the arguments to pass
    #	vname - Name of the result value
    #
    # Results:
    #	None

    method IssueNREInvokeFunction {useCallframe callframe \
				       rettype tgt func arguments vname} {
	set result [$b call $func $arguments $vname]
	$b launchCoroRunner $result
	if {$useCallframe} {
	    set result [$b frame.pack $callframe $result]
	}
	my StoreResult $tgt $result
    }

    method IssueInvokeCommand {tgt arguments argvals vname} {
	upvar 1 callframe callframe thecallframe thecallframe

	set types [lmap s $arguments {my ValueTypes $s}]

	# FIXME: The front end needs to pass through command info
	#        prior to resolution as well as after, so as to produce
	#        proper error messages. This will get complicated in the
	#        presence of ensembles; we ignore the problem for now.

	set vector [$b buildVector $objv $types $arguments $argvals]
	set result [$b invoke $vector \
			[expr {callframe($thecallframe)}] $callframe \
			$errorCode $vname]
	$b clearVector $objv $types $arguments
	# Result type is now FAIL STRING, always.
	my SetErrorLine $errorCode [$b maybe $result]
	if {callframe($thecallframe)} {
	    set result [$b frame.pack $callframe $result]
	}
	my StoreResult $tgt $result
    }

    # TclCompiler:IssueWiden --
    #
    #	Generate the code for widening the type of a value. Must only be
    #	called from the 'compile' method.
    #
    # Parameters:

	} elseif {[llength $srcs] == 0 && $srcDict eq "literal \uf8ff"} {
	    my StoreResult $tgt [my LoadOrLiteral "literal 0"]
	    return
	}

	# Need to construct the variadic vector
	set types [lmap s $srcs {my ValueTypes $s}]
	set argvals [lmap s $srcs {my LoadOrLiteral $s}]
	set vector [$b buildVector $objv $types $srcs $argvals]

	set name [my LocalVarName $tgt]
	append opcode ( [my ValueTypes $srcDict] )
	set srcDict [my LoadOrLiteral $srcDict]
	my StoreResult $tgt [$b $opcode $srcDict $vector $name]
	$b clearVector $objv $types $srcs
	return
    }

    # TclCompiler:IssueExtract --
    #
    #	Generate the code for exactracting the value of a variable which
    #	contains a "possibly-existing" value. Must only be called from the

	    return -code error "Duplicate definition of $desc"
	}

	# Type check the assignment
	set destType [nameOfType [dict get $vtypes $desc]]
	if {[Type $destType] ne [TypeOf $value]} {
	    my Warn "Attempt to store the value\
	             '%s' of type '%s' \
                     into a variable, '%s', of type '%s'"\
		[PrintValueToString $value] \
		[PrintTypeToString [TypeOf $value]] \
		$desc $destType
	}

	if {[lindex $desc 0] eq "var"} {
	    if {[lindex $opcode 0] eq "phi"} {
		lappend phiAnnotations [lindex $desc 1] $value
	    } else {
		my AnnotateAssignment [lindex $desc 1] $value

    #
    # Results:
    #	The PC at which the 'free' occurs, or 0 if the value isn't consumed
    #	(there is never a free as the first instruction in a function, so this
    #	may be used as a boolean).

    method IsConsumed {var search} {
	while {$search < [llength $quads]} {
	    switch [lindex $quads $search 0 0] {
		"free" {
		    if {[lindex $quads $search 2] eq $var} {
			return $search
		    }
		}
		"jump" - "jumpFalse" - "jumpTrue" - "return" -
		"jumpMaybe" - "jumpMaybeNot" - "NRE.return" - "NRE.suspend" {
		    return 0
		}
		default {
		    if {$var in [lindex $quads $search]} {
			return 0
		    }
		}
	    }
	    incr search
	}
	error "IsConsumed ran away!"
    }

    # TclCompiler:ConvertIndices --
    #
    #	Convert the most common cases of literal end-based indexing into forms
    #	that can actually be processed by the low-level code issuer.
    #

	my ByteCode $command [::tcl::unsupported::getbytecode proc $command]
	set info [$specializer makeInstance $command $argumentTypes]
	lassign $info rt ats tmap quadcode
	my InitTypeInfo $ats $rt $tmap
	set ats [lmap t $ats {nameOfType $t}]
	set readableName ${cmd}([string map {" " .} [join $ats ,]])
    }

    # TclInterprocedureCompiler:needsNRE --
    #
    #	Return 1 if the function we are compiling needs NRE, 0 otherwise.
    #
    method needsNRE {} {
	expr {[lindex $quadcode 0 0] eq "NRE.entry"}
    }

    # TclInterproceduralCompiler:commandName (property) --
    #
    #	Get the human-readable name of the function we are compiling/have
    #	compiled. Note that this is not necessarily the same as the name of
    #	the function in the code *or* the name of the Tcl command that will be
    #	replaced by this function.

	    my Compile $quadcode
	} on error {msg opts} {
	    dict append opts -errorinfo \
		"\n    (compiling code for \"$cmd\")"
	    return -options $opts $msg
	}
    }

    # TclInterproceduralCompiler:generateDeclaration --
    #
    #	Generate the declaration of the function that we transformed the
    #	procedure into.
    #
    # Parameters:
    #	module - Module that we're compiling into.

    method generateDeclaration {module} {
	try {
	    my GenerateDeclaration $module $quadcode
	} on error {msg opts} {
	    dict append opts -errorinfo \
		"\n    (compiling code for \"$cmd\")"
	    return -options $opts $msg
	}
    }

    # TclInterproceduralCompiler:generateThunk --
    #
    #	Generate the binding into Tcl of the function that we transformed the
    #	procedure into.
    #
    # Parameters:
    #	thunkBuilder -
    #		The API binding class instance.
    #
    # Results:
    #	The function reference (i.e., instance of Function class) for the
    #	binding function. (Not the bound function, which this class made.)

    method generateThunk {thunkBuilder} {
	my variable returnType
	if {[dict exists $bytecode procmeta]} {
	    $thunkBuilder buildProcedureMetadata $cmd $bytecode \
		[dict get $bytecode procmeta]
	    dict unset bytecode procmeta
	}
	set isNRE 0
	foreach q $quadcode {
	    switch -exact [lindex $q 0 0] {
		"entry" {
		    break
		}
		"NRE.entry" {
		    set isNRE 1
		    break
		}
	    }
	}
	$thunkBuilder thunk $cmd $bytecode $func $isNRE [nameOfType $returnType]
    }

    # TclInterproceduralCompiler:printTypedQuads --
    #
    #	Print the sequence of typed quadcodes that the type inference engine
    #	has transformed the procedure into.
    #

# config.tcl --
#
#	LLVM code generator configuration and high-level driver. Packages the
#	LLVM interface code into a convenient form and provides the ability to
#	configure a few things (such as the logging level) simply.
#
# Copyright (c) 2014-2017 by Donal K. Fellows
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
#------------------------------------------------------------------------------

package require llvmtcl 3.9
package require platform

namespace eval ::LLVM {
    namespace path ::llvmtcl
    variable THIS_SCRIPT [info script]

    variable counter 0
    variable debug 0

    variable debugmeta 1
    variable time 0
    variable optimiseLevel 3
    variable quadcode-log {}
    variable dumpPre {}
    variable dumpPost {}
    variable useStubs 0
    variable OptExecutable [file join $::llvmtcl::llvmbindir opt]

    include stdlib.tcl
    include varframe.tcl
    include thunk.tcl
    include tclapi.tcl
    include macros.tcl
    include compile.tcl
    include debug.tcl
    include coro.tcl
    include jit.tcl
    include ../quadcode/specializer.tcl

    # LLVM::configure --
    #
    #	Provide a standard configuration interface, following the same general
    #	model as [chan configure].

# coro.tcl --
#
#	Various routines needed for interface to LLVM's coroutines and
#	use them to implement Tcl's requirements for non-recursive evaluation.
#
# 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.
#
#-----------------------------------------------------------------------------

oo::define Builder {

    # Implementation of various support functions needed to support Tcl's
    # coroutines

    variable tcl.coro.runner
    variable tcl.coro.addCallbackToCoroRunner
    variable tcl.nr.add.callback
}

# Builder method @coroFunctions --
#
#	Defines support functions for LLVM coroutines that need to be in
#	LLVM assembly language.
#
# Parameters:
#	module - LLVM module handle to the module under construction
#	api - Handle of the Tcl API object
#
# Results:
#	None.
#
# Side effects:
#	Defines the support functions
#
# Called only from '@apiFunctions'

oo::define Builder method @coroFunctions {api} {

    ##### Function tcl.coro.runner #####
    #
    # Type signature: x:char** × Interp* × int32 -> int32
    #
    # Parameters:
    #	ClientData clientDataArray [4] - Client data from the Tcl_NRAddCallback
    #                                    Only clientData[0] is used; it is
    #	                                 the coroutine handle
    #   Tcl_Interp* interp             - Tcl interpreter
    #   int status                     - Tcl status code chained from the
    #                                    last call
    #
    # Results:
    #	Returns TCL_OK.
    #
    # This function is the main loop of any NRE call. It is the callback
    # from a Tcl_AddCallback call, and its client data is the LLVM coroutine
    # frame. It also carries the result of the last Tcl callout, and that
    # result will be handed off to the next LLVM continuation by storing
    # it in the coroutine promise.

    set f [$m local "tcl.coro.runner" int32<-char**,Interp*,int32 noinline]
    params clientDataArray interp result
    build {

	# Get the coroutine handle from client data
	set coro.handle [my load $clientDataArray "coro.handle"]

	# First, has the NRE proc finished execution? If so, we simply
	# want to return back to the trampoline and execute the next
	# callback.

	set llvm.coro.done [$m intrinsic coro.done]
	set done [my call ${llvm.coro.done} [list ${coro.handle}] "doneFlag"]
	my condBr $done $finished $needResume

    label needResume:

	# We will need to resume the coroutine. Stack this callback again so
	# that the next time it suspends, we'll loop back to here.

	$api Tcl_NRAddCallback $interp ${tcl.coro.runner} ${coro.handle} \
	    [my null char*] [my null char*] [my null char*]
    
	# Transfer the interpreter status into the coroutine promise
	# so that the body of the coroutine can see it.

	set alignment [expr {2 * [$m alignof [Type char*]]}]
	set llvm.coro.promise [$m intrinsic coro.promise]
	set promise.addr.raw \
	    [my call ${llvm.coro.promise} \
		 [list ${coro.handle} \
		      [Const $alignment int32] \
		      [Const false bool]] \
		 "promise.addr.raw"]
	set promise.addr [my cast(ptr) ${promise.addr.raw} int32 "promise.addr"]
	my store $result ${promise.addr}

	# Resume the coroutine, and return to the trampoline to await
	# further developments

	set llvm.coro.resume [$m intrinsic coro.resume]
	my call ${llvm.coro.resume} ${coro.handle}

	my br $finished

    label finished:

	# Either the coro is done, or we've just resumed it and need to
	# see what further callbacks it may have stacked. In either case,
	# return to the trampoline

	my ret [Const 0 int];	# TCL_OK

    }

    ##### Function: tcl.coro.addCallbackToCoroRunner #####
    #
    # Type signature: char* -> void
    #
    # Parameters:
    #	coroHandle - Handle of the coroutine to run to the next suspension
    #
    # Results:
    #	None.
    #
    # This function invokes Tcl_NRAddCallback to launch a call to
    # coroRunner, with the LLVM coroutine handle given by 'handle'.

    set f [$m local "tcl.coro.addCallbackToCoroRunner" void<-char*]
    params coroHandle
    build {

	$api Tcl_NRAddCallback [$api tclInterp] ${tcl.coro.runner} $coroHandle \
	    [my null char*] [my null char*] [my null char*]
	my ret

    }

    ##### Function: tcl.nr.add.callback #####
    #
    # Type signature: NRCallback*×char*×char*×char*×char*->void
    #
    # Adds a callback to the Tcl interpreter
    
    set f [$m local tcl.nr.add.callback \
	       void<-func{int<-ClientData*,Interp*,int}*,char*,char*,char*,char*]
    params func d1 d2 d3 d4
    build {
	$api Tcl_NRAddCallback [$api tclInterp] $func $d1 $d2 $d3 $d4
	my ret
    }
}

# TclCompiler method IssueNREEntrySequence --
#
#	Issues the sequence of code that begins an LLVM coroutine
#	that corresponds to an NRE Tcl procedure.
#
# Parameters:
#	currentBlock - The current block being built in
#	nextBlock - The block that will follow the current block, which
#	            is the actual entry to the procedure.
#
# Results:
#	Returns a dictionary with values that will be needed for other
#	actions within the procedure body. The following keys will be
#	included:
#
#	cleanup - Block to which control must transfer on final exit
#		  from this procedure or if the coroutine is killed.
#	coro_handle - Handle of this coroutine
#	exit - Block to which control must transfer on return from
#	       this procedure at Tcl level.
#	promise - LLVM value containing the address of this coroutine's promise
#	suspend - Block to which all returns from this coroutine eventually
#		  transfer

oo::define TclCompiler method IssueNREEntrySequence {currentBlock nextBlock} {

    $currentBlock build-in $b
    $b @location 0

    # Basic blocks in the function entry sequence

    set alloc_frame [$func block "coro.alloc.frame"]
    set begin [$func block "coro.begin"]

    # Basic blocks in the function exit sequence

    set exit [$func block "coro.exit"]
    set trap [$func block "coro.trap"]
    set cleanup [$func block "coro.cleanup"]
    set free_frame [$func block "coro.free.frame"]
    set suspend [$func block "coro.suspend"]

    # Allocate the coroutine promise

    set alignment [$m alignof [Type [my CoroPromiseType]]]
    set promise [$b alloc [my CoroPromiseType] "coro,promise"]
    $b align $promise $alignment
    set clientData [$b cast(ptr) $promise char]

    # Get a coroutine ID

    set llvm.coro.id [$m intrinsic coro.id]
    set coro_id [$b call ${llvm.coro.id} \
		     [list [Const $alignment int32] $clientData \
			  [$b null char*] [$b null char*]] "coro.id"]

    # Determine whether coroutine frame elision has been performed

    set llvm.coro.alloc [$m intrinsic coro.alloc]
    set needToAlloc [$b call ${llvm.coro.alloc} [list $coro_id] \
			 "coro.need.to.alloc"]
    $b condBr $needToAlloc $alloc_frame $begin

    $alloc_frame build-in $b
    $b @location 0

    # Allocate the coroutine frame

    set llvm.coro.size [$m intrinsic coro.size int32]
    set coro_size [$b call ${llvm.coro.size} {} "coro.size"]
    set coro_alloc [$b Tcl_Alloc $coro_size "coro.frame.alloc"]
    $b br ${begin}

    # Start the coroutine with the newly allocated frame

    $begin build-in $b
    $b @location 0

    set coro_frame [$b phi \
			[list [$b null char*] $coro_alloc] \
			[list $currentBlock   $alloc_frame] \
			"coro.frame"]
    set llvm.coro.begin [$m intrinsic coro.begin]
    set coro_handle [$b call ${llvm.coro.begin} [list $coro_id $coro_frame] \
			 "coro.handle"]

    # Suspend the coroutine immediately to allow it to be restarted
    # from a TclNR calllback. Upon resumption, go to the entry block.

    set llvm.coro.suspend [$m intrinsic coro.suspend]
    set result [$b call ${llvm.coro.suspend} \
		    [list [ConstNone] [Const false bool]] "coro.suspend.result"]
    $b switch $result $suspend 0 $nextBlock 1 $cleanup
    
    ########################################################################

    # Now generate the exit sequence. We need to do this in advance,
    # because invoke and return operations inside the body of the procedure
    # need to reference it.

    $exit build-in $b
    $b @location 0

    set result [$b call ${llvm.coro.suspend} \
		    [list [ConstNone] [Const true bool]] "coro.suspend.result"]
    $b switch $result $suspend 0 $trap 1 $cleanup

    # Following the final suspend a coro cannot be called again, so invoke
    # nasal daemons if this should happen

    $trap build-in $b
    $b @location 0

    set llvm.trap [$m intrinsic trap]
    $b call ${llvm.trap} {}
    $b unreachable

    # Free the coroutine frame if necessary

    $cleanup build-in $b
    $b @location 0

    set llvm.coro.free [$m intrinsic coro.free]
    set coro_frame [$b call ${llvm.coro.free} [list $coro_id $coro_handle] \
			"coro.frame"]
    set coro_need_free [$b neq $coro_frame [$b null char*] \
			    "coro.frame.need.to.free"]
    $b condBr $coro_need_free $free_frame $suspend

    $free_frame build-in $b
    $b @location 0

    $b Tcl_Free $coro_frame
    $b br $suspend

    # All exits from the coroutine, whether because it has finished,
    # suspended, or been killed, come here to return.

    $suspend build-in $b
    $b @location 0

    set llvm.coro.end [$m intrinsic coro.end]
    $b call ${llvm.coro.end} [list $coro_handle [Const false bool]]
    $b ret $coro_handle
		 
    return [dict create \
		cleanup $cleanup \
		coro_handle $coro_handle \
		exit $exit \
		promise $promise \
		suspend $suspend]
}

# TclCompiler method CoroPromiseType --
#
#	Generates the LLVM type that represents the coroutine promise for
#	the current NRE function

oo::define TclCompiler method CoroPromiseType {{rettype {}}} {
    namespace upvar ::quadcode::dataType CALLFRAME CALLFRAME
    if {$rettype eq {}} {
	set rettype $returnType
    }
    set rettype [expr {$rettype & ~$CALLFRAME}]
    set typestr named 
    append typestr \{ [nameOfType $rettype] .promise
    append typestr , status:int32
    append typestr , retval: [nameOfType $rettype]
    append typestr \}
    return [Type $typestr]
}

# Builder method launchCoroRunner --
#
#	Generates code to launch the Tcl_NRAddCallback chain that executes
#	the LLVM coroutine representing a Tcl command invocation.
#
# Parameters:
#	handle - LLVM value reference specifying the LLVM coroutine handle

oo::define Builder method launchCoroRunner {handle} {
    my call ${tcl.coro.addCallbackToCoroRunner} $handle
}

# Builder method NRAddCallback --
#
#	Add a callback to the current interpreter
#
# Parameters:
#	func - LLVM reference to the callback function
#	args - LLVM references to up to four client data objects
#
# Results:
#	None.

oo::define Builder method NRAddCallback {func args} {
    set argv {}
    if {[llength $args] > 4} {
	error "at most four client data objects can be passed to a callback"
    }
    set argv [lmap a $args {my cast(ptr) $a int8}]
    while {[llength $argv] < 4} {
	lappend argv [my null int8*]
    }
    my call ${tcl.nr.add.callback} [linsert $argv 0 $func]
}
oo::define Builder export NRAddCallback

# TclCompiler method returnedIntoCoro --
#
#	Generates code to retrieve the status and return value from
#	a coroutine that has done the final suspend or an invoked NRE
#	command.
#
# Parameters:
#	rettype - The function's return type
#	tgttype - The type of the target value
#	corohandle - The handle to the coroutine that ran the invoked function
#	destroy - Flag == 1 if this was a return from another coroutine
#	          that must be destroyed, 0 if it's a return from a
#		  Tcl_NRAddCallback chain in the same coroutine
#
# Results:
#	Returns a list of two LLVM value refs: the status code and the
#	return value.

oo::define TclCompiler method returnedIntoCoro {rettype tgttype 
						corohandle destroy} {

    # Retrieve the coroutine promise from the coroutine handle

    set handle [my LoadOrLiteral $corohandle]
    set frame {}
    if {"CALLFRAME" in $tgttype} {
	set frame [$b frame.frame $handle]
	set handle [$b frame.value $handle]
    }
    set ptype [my CoroPromiseType $rettype]
    set alignment [Const [$m alignof $ptype] int32]
    set paddr_raw [$b call [$m intrinsic coro.promise] \
		       [list $handle $alignment [Const false bool]] \
		       "promise.addr.raw"]
    set paddr [$b cast(ptr) $paddr_raw $ptype "promise.addr"]

    # Retrieve the return code and return value of the called procedure

    set rcodeaddr [$b gep $paddr 0 0]
    set rcode [$b load $rcodeaddr "return.code"]

    # Destroy the coroutine - we're done with it now.

    if {$destroy} {
	set rvaladdr [$b gep $paddr 0 1]
	set rval [$b load $rvaladdr "return.value"]
	$b call [$m intrinsic coro.destroy] [list $handle]
    } else {
	set rval [$b getNRCommandReturnValue $rcode $errorCode "return.value"]
	if {"CALLFRAME" in $tgttype} {
	    # Return from an invoked function may need to restore the callframe
	    $b restoreFrame $frame
	}
    }

    # Return the status and result

    return [list $frame $rcode $rval]
}

# Builder method getNRCommandReturnValue --
#
#	Retrieves the return value of a noncompiled command invoked by NRE
#
# Parameters:
#	rcode - Return code of the invoked command
#	ecvar - LLVM variable reference of where to put the return code
#	name - (Optional) name to assign to the result
#
# Results:
#	Returns an LLVM STRING? value

oo::define Builder method getNRCommandReturnValue {rcode ecvar {name {}}} {
    my call ${tcl.nr.command.result} [list $rcode $ecvar] $name
}

# TclCompiler method NRReturnToThunk --
#
#	Generates the codeburst to return to a call thunk when a compiled
#	NRE procedure returns.
#
# Parameters:
#	handle - LLVM value reference to the LLVM coroutine for the
#		 wrapped function invocation
#	restype - Type of the result that is stored in the coroutine promise
#
# Results:
#	Returns the LLVM value reference to the result of the wrapped function

oo::define Builder method NRReturnToThunk {handle resType} {
    set promiseType named{$resType.promise,int32,$resType}
    set alignment [$m alignof [Type $promiseType]]
    set llvm.coro.promise [$m intrinsic coro.promise]
    set promiseAddrRaw [my call ${llvm.coro.promise} \
			    [list $handle [Const $alignment int32] \
				 [Const false bool]] "promise.addr.raw"]
    set promiseAddr [my cast(ptr) $promiseAddrRaw $promiseType]
    set value [my load [my gep $promiseAddr 0 1] "value"]
    set llvm.coro.destroy [$m intrinsic coro.destroy]
    my call ${llvm.coro.destroy} $handle
    return $value
}
oo::define Builder export NRReturnToThunk

# TclCompiler method CoroSuspend --
#
#	Generates code to suspend the current coroutine and resume at a
#	specified basic block.
#
# Parameters:
#	coro_info - Information about the current LLVM coroutine from
#	            IssueNREEntrySequence
#	blk - Basic block at which control resumes
#
# Results:
#	None.

oo::define TclCompiler method CoroSuspend {coro_info blk} {

    set llvm.coro.suspend [$m intrinsic coro.suspend]
    set result \
	[$b call ${llvm.coro.suspend} [list [ConstNone] [Const false bool]] \
	     "coro.suspend.result"]
    $b switch $result [dict get $coro_info suspend] \
	0 $blk 1 [dict get $coro_info cleanup]

}

# TclCompiler method CoroReturn --
#
#	Generates code to return from the current NRE procedure by
#	storing result data in the promise and performing the 'final
#	suspend' of the LLVM coroutine.
#
# Parameters:
#	coro_info - Information about the current LLVM coroutine from
#	            IssueNREEntrySequence
#	retval - Value to return from the procedure

oo::define TclCompiler method CoroReturn {coro_info retval} {
    set promise [dict get $coro_info promise]
    set statPtr [$b gep $promise 0 0]
    $b store [Const 0 int32] $statPtr
    set valPtr [$b gep $promise 0 1]
    $b store $retval $valPtr
    $b br [dict get $coro_info exit]
}

	    set cmds [lsort -unique $cmds]
	}

	timeit init-module {
	    set ns [uplevel 1 {namespace current}]
	    set name [SelectModuleName $ns]
	    set module [Module new $name]

	    $module mcjit

	    # Get an instance of the system that glues things to the Tcl
	    # runtime.
	    set thunkBuilder [ThunkBuilder new $module]
	    set sp [quadcode::specializer new]
	}

		# For code that needs to bind to Tcl, make the thunks. Then
		# finalise the thunks, which finishes building the module's
		# init function.
		foreach c $publicInterface {
		    $c generateThunk $thunkBuilder
		}

		$thunkBuilder finalize
	    }

	    timeit dump-pre {
		# Save the current IR
		variable dumpPre [$module dump]
		variable bitcodePre [$module bitcode]
	    }

	    # Check that what we have is actually correct!
	    $module verify
	    if {$debug} {
		parray ::useCount
	    }
	    set bitcodeFinal [$module bitcode]
	    set f_ [open test.bc wb]
	    puts -nonewline $f_ $bitcodeFinal
	    close $f_
	    set dumpFinal [$module dump]
	    set f_ [open test.ll w]
	    puts $f_ $dumpFinal
	    close $f_

	    timeit optimize {
		# Run the LLVM IR optimizer. The configuration of this is in
		# llvmtcl and is due to Jos Decoster.
		$module optimize $optimiseLevel
	    }

	    timeit dump-post {
		# Save the current IR
		variable dumpPost [$module dump]
		variable bitcodePost [$module bitcode]
		set f_ [open opt.ll w]
		puts $f_ $dumpPost
		close $f_
	    }

	    timeit assemble {
		# Call the package init function. This causes native code to
		# be issued and linked.

		$thunkBuilder install
	    }

	    # Return the LLVM handle to the module, just in case.
	    #
	    # Note that it is *UNSAFE* to uninstall this package (unless all
	    # commands it creates are deleted, since we don't do any custom

	set cmds [lmap p $cmds {uplevel 1 [list namespace which $p]}]
	# Strip any duplicates
	set cmds [lsort -unique $cmds]

	set ns [uplevel 1 {namespace current}]
	set name [SelectModuleName $ns]
	set module [Module new $name]
	$module prepareToCompile

	# Get an instance of the system that glues things to the Tcl runtime.
	set thunkBuilder [ThunkBuilder new $module]
	set sp [quadcode::specializer new]

	try {
	    set required {}

	# Convert list of commands and package name into what the compiler
	# really wants.
	set cmds [lsort -unique $packageProcedures($p_id)]
	unset -nocomplain packageProcedures($p_id)
	set name [SelectModuleName $packageName]
	set module [Module new $name $pkgfile]
	$module prepareToCompile 

	# Get an instance of the system that glues things to the Tcl runtime.
	set thunkBuilder [ThunkBuilder new $module]
	set sp [quadcode::specializer new]

	try {
	    set required {}

	if {[TypeOf $left] ne [TypeOf $right]} {
	    return -code error "values must both be of the same type"
	} elseif {[GetTypeKind [TypeOf $left]] ne "LLVMIntegerTypeKind"} {
	    return -code error "values must be integers"
	}
	my Locate [BuildNSWAdd $b $left $right $name]
    }

    # Builder:align --
    #
    #	Set the alignment on an LLVM value
    #
    # Parameters:
    #	v - Value to set the alignment on
    #	align - Integer alignment in bytes - must be a power of 2

    method align {v align} {
	if {![string is integer $align]
	    || $align <= 0
	    || ($align & ($align - 1)) != 0} {
	    return -code error "alignment must be a power of 2"
	}
	return [SetAlignment $v $align]
    }


    # Builder:alloc --
    #
    #	Generate code to allocate a writable memory location on the stack.
    #
    # Parameters:
    #	type -	The type of the memory location to allocate.
    #	name (optional) -
    #		A name to give to the result value.
    #
    # Results:
    #	A pointer to the location as an LLVM value reference.

    method alloc {type {name ""}} {
	my @validToIssue
	my Locate [BuildAlloca $b [Type $type] $name]
    }

    # Builder:allocInBlock --
    #
    #	Generates an 'alloca' instruction, but puts it in a block other than
    #	the current one.
    #
    # Parameters:
    #	block - Block to place the alloc
    #	type - LLVM type reference of the type to allocate
    #	name - Name to assign to the result
    #
    # Results:
    #	Returns a LLVM value reference to the pointer to the allocated space

    method allocInBlock {block type name} {
	set here [my @cur]
	my @end $block
	my @validToIssue
	set ref [my alloc $type $name]
	my @end $here
	return $ref
    }

    # Builder:and --
    #
    #	Generate code to compute the bitwise-and of two integers of the same
    #	bit width.
    #
    # Parameters:

    method arrayAlloc {type size {name ""}} {
	my @validToIssue
	if {[GetTypeKind [TypeOf $size]] ne "LLVMIntegerTypeKind"} {
	    return -code error "size must be integer"
	}
	my Locate [BuildArrayAlloca $b [Type $type] $size $name]
    }

    # Builder:arrayAllocInBlock --
    #
    #	Generate code to allocate a contiguous array of memory cells on the
    #	stack, placing it in a block other than the current one.
    #
    # Parameters:
    #   block - The LLVM block reference of the block where the alloc should go
    #	type -	The type of each of the memory cells.
    #	size -	The number of cells to create as an int[X] LLVM value
    #		reference. (X is the same as for the 'left' parameter.)
    #	name (optional) -
    #		A name to give to the result value.
    #
    # Results:
    #	A pointer to the first cell in the array.

    method arrayAllocInBlock {block type size {name ""}} {
	if {[GetTypeKind [TypeOf $size]] ne "LLVMIntegerTypeKind"} {
	    return -code error "size must be integer"
	}
	set here [my @cur]
	my @end $block
	my @validToIssue
	set ref [my Locate [BuildArrayAlloca $b [Type $type] $size $name]]
	my @end $here
	return $ref
    }

    # Builder:br --
    #
    #	Branch unconditionally to another basic block. Widely used, marks the
    #	end of the current basic block. Quadcode implementation ('jump').
    #
    # Parameters:

    #	type -	The type (as type name or LLVM type reference) to get the size
    #		of.
    #
    # Results:
    #	LLVM constant int reference.

    method sizeof {type} {
	Const [$m sizeof [Type $type]] int64
    }

    # Builder:store --
    #
    #	Generate code to write a value to a memory location. The value MUST be
    #	the same type as the memory location being pointed at.
    #

    #
    # Results:
    #	An undef LLVM value reference of the given type.

    method undef {type} {
	GetUndef [Type $type]
    }

    # Builder:unreachable --
    #
    #	Indicate that a particular point in the instruction sequence
    #	is unreachable.

    method unreachable {} {
	my @validToIssue
	my Locate [BuildUnreachable $b]
    }

    # Builder:xor --
    #
    #	Generate code to compute the bitwise-xor of two integers of the same
    #	bit width.
    #
    # Parameters:

	build {
	    set r0 [my int 1 "result.enter"]
	    set n0 [my getInt64 $y "n.enter"]
	    # These are stand-ins for values that we've not generated yet
	    my br $loop(test)
	label loop(test) "loop.test"
	    set sources {$entry $loop(double)}
	    set thisn [PHI int64 {$n0 $nLoop} $sources "n.test"]
	    set xbody [PHI INT {$x $xLoop} $sources "x.test"]
	    set result [PHI INT {$r0 $rLoop} $sources "result.test"]
	    my condBr [my neq $thisn $0] $loop(bit0) $loop(result)
	label loop(result) "result"
	    my ret $result
	label loop(bit0) "loop.bit0"
	    my condBr [my cmpInt [my and $thisn $1] NE $0] \
		$loop(mult) $loop(double)
	label loop(mult) "loop.mult"

	    set b2 [$api Tcl_GetString $value]
	    SetValueName $b2 "bytes"
	    my br $get
	label get:
	    set bytes [my phi [list $b1 $b2] [list $entry $generate] "bytes"]
	    my ret [my eq [my dereference $bytes 0] [Const 0 int8]]
	}


	##### Function tcl.isNumeric #####
	#
	# Type signature: value:STRING -> ZEROONE
	#
	# Tests if a STRING can be parsed as a NUMERIC. Part of the
	# implementation of quadcode "instanceOf".

    variable tcl.dict.get1.empty tcl.dict.set1.empty
    variable tcl.maptoint

    # Variables holding implementations of Tcl's exception-handling machinery
    variable tcl.getresult tcl.getreturnopts tcl.initExceptionOptions
    variable tcl.initExceptionSimple tcl.processReturn tcl.procedure.return
    variable tcl.setErrorLine tcl.existsOrError tcl.logCommandInfo
    variable tcl.handleExceptionResult tcl.invoke.command
    variable tcl.invoke.command.nre tcl.nr.command.result tcl.invoke.expanded
    variable tcl.invoke.expanded.nre tcl.restoreFrame

    # Helper functions
    variable tcl.impl.trimleft tcl.impl.trimright obj.cleanup
    variable tcl.impl.getIndex tcl.impl.listDupe
    variable tcl.alloc tcl.free
    variable tcl.vector.clear

    # Reference to the module object
    variable m

    # Builder:ReferenceFunctions --
    #
    #	Generate the functions that implement Tcl_Obj reference management.

	params objc objv
	build {
	    nonnull $objv
	    my br $entry
	label entry:
	    my br $loop
	label loop:
	    set count_loop [PHI int {$objc $count_freeOne} {$entry $freeOne} "count"]
	    set res [my cmpInt $count_loop SGT [Const 0 int]]
	    my condBr $res $freeOne $done
	label freeOne:
	    set count_freeOne [my sub $count_loop [Const 1 int] "count"]
	    set obj [my load [my getelementptr $objv $count_freeOne]]
	    my br $loop
        label done:
	    my ret


	}

	return
    }

    # Builder:StringFunctions --
    #

	    if {[TypeOf $target] ne $vt} {
		set target [my cast(ptr) $target void]
	    }
	    if {[TypeOf $source] ne $vt} {
		set source [my cast(ptr) $source void]
	    }
	    if {[CountParamTypes [GetElementType [TypeOf $memcpy]]] == 5} {
		# Alignment parameter only needed before LLVM 7
		my Call memcpy $target $source $length \
		    [Const 0] [Const false bool]
	    } else {
		my Call memcpy $target $source $length [Const false bool]
	    }
	    return
	}

	    }
	    set vt [Type void*]
	    set memset [$m intrinsic memset $vt [TypeOf $length]]
	    if {[TypeOf $target] ne $vt} {
		set target [my cast(ptr) $target void]
	    }
	    if {[CountParamTypes [GetElementType [TypeOf $memset]]] == 5} {
		# Alignment parameter only needed before LLVM 7
		my Call memset $target [Const 0 int8] $length \
		    [Const $alignment] [Const false bool]
	    } else {
		my Call memset $target [Const 0 int8] $length \
		    [Const false bool]
	    }
	    return

	# Type signature: valueObj:STRING -> int1*int1

	set f [$m local "tcl.impl.getBoolean" struct{int1,int1}<-STRING]
	params valueObj
	build {
	    nonnull $valueObj
	    set boolVar [my alloc int32 "boolPtr"]
#	    The following does not work
#	    set sizeofBool [my castPtr2Int [my gep [my null int32*] 1] \
#				int64 sizeof(int)]
	    set sizeofBool [Const 4 int64]
	    set str [$api Tcl_GetString $valueObj]
	    set code [$api Tcl_GetBooleanFromObj {} $valueObj $boolVar]
	    set res [my undef struct{int1,int1}]
	    set res [my insert $res [my eq $code [Const 0]] 0]
	    set res \
		[my insert $res [my neq [my load $boolVar "bool"] [Const 0]] 1]
	    my ret $res
	}
	my closure GetBoolean {valueObj} {
	    my call ${tcl.impl.getBoolean} [list $valueObj] "result"
	}
	unset -nocomplain valueObj


	##### Function tcl.impl.getDouble #####
	##### MAPPED CALL TO METHOD: Build:GetDouble #####
	#
	# Type signature: valueObj:STRING -> int * int8[]
	#
	# Gets the (pseudo-)UTF-8 version of a string. Wrapper around Tcl API

	    my condBr [my eq $numBytes $0] $ret0 $checkTrim
	label checkTrim:
	    my condBr [my eq $numTrim $0] $ret0 $outerLoop
	label ret0:
	    my ret $0
	label outerLoop:
	    set sources {$checkTrim $nextOuter}
	    set p [PHI char* {$bytes $pLoop} $sources "p"]
	    set numBytes2 [PHI int {$numBytes $nbLoop} $sources "numBytes.2"]

	    set pInc [$api Tcl_UtfToUniChar $p $chVar]
	    SetValueName $pInc "pInc"
	    set ch1 [my load $chVar "ch1"]
	    my br $innerLoop
	label innerLoop:
	    set sources [list $outerLoop $nextInner]
	    set q [PHI char* {$trim $qLoop} $sources "q"]
	    set bytesLeft [PHI int {$numTrim $blLoop} $sources "bytesLeft"]

	    set qInc [$api Tcl_UtfToUniChar $q $chVar]
	    SetValueName $qInc "qInc"
	    set ch2 [my load $chVar "ch2"]
	    my condBr [my eq $ch1 $ch2] $doneInner $nextInner
	label nextInner:
	    set qLoop [my getelementptr $q [list $qInc] "q"]
	    set blLoop [set bytesLeft2 [my sub $bytesLeft $qInc "bytesLeft"]]

	    my condBr [my eq $numBytes $0] $ret0 $checkTrim
	label checkTrim:
	    my condBr [my eq $numTrim $0] $ret0 $outerLoop
	label ret0:
	    my ret $0
	label outerLoop:
	    set sources [list $checkTrim $nextOuter]
	    set p1 [PHI char* {$p0 $pLoop} $sources "p.1"]
	    set numBytes1 [PHI int {$numBytes $nbLoop} $sources "numBytes.1"]

	    set p2 [$api Tcl_UtfPrev $p1 $bytes]
	    SetValueName $p2 "p.2"
	    set pInc [$api Tcl_UtfToUniChar $p2 $chVar]
	    SetValueName $pInc "pInc"
	    set ch1 [my load $chVar "ch1"]
	    my br $innerLoop
	label innerLoop:
	    set sources [list $outerLoop $nextInner]
	    set q [PHI char* {$trim $qLoop} $sources "q"]
	    set bytesLeft [PHI int {$numTrim $blLoop} $sources "bytesLeft"]

	    set qInc [$api Tcl_UtfToUniChar $q $chVar]
	    SetValueName $qInc "qInc"
	    set ch2 [my load $chVar "ch2"]
	    my condBr [my eq $ch1 $ch2] $doneInner $nextInner
	label doneInner:
	    my condBr [my le $bytesLeft $0] $fixP $nextOuter
	label nextInner:

	    set end [my getelementptr $string [list $length]]
	    my switch $class $xdigit \
		0 $alnum 1 $alpha 2 $ascii 3 $control \
		4 $digit 5 $graph 6 $lower 7 $print \
		8 $punct 9 $space 10 $upper 11 $word
	    set n [list $1]
	label alnum:
	    set p [PHI int16* {$string $p0} {$test $alnumNext} "p"]
	    my condBr [my neq [$api Tcl_UniCharIsAlnum [my load $p]] $0] \
		$alnumNext $fail
	label alnumNext "alnum.next"
	    set p0 [my getelementptr $p $n "p.0"]
	    my condBr [my lt $p0 $end] $alnum $match
	label alpha:
	    set p [PHI int16* {$string $p1} {$test $alphaNext} "p"]
	    my condBr [my neq [$api Tcl_UniCharIsAlpha [my load $p]] $0] \
		$alphaNext $fail
	label alphaNext "alpha.next"
	    set p1 [my getelementptr $p $n "p.1"]
	    my condBr [my lt $p1 $end] $alpha $match
	label ascii:
	    set p [PHI int16* {$string $p2} {$test $asciiNext} "p"]
	    my condBr [my Call tcl.impl.isAscii [my load $p]] \
		$asciiNext $fail
	label asciiNext "ascii.next"
	    set p2 [my getelementptr $p $n "p.2"]
	    my condBr [my lt $p2 $end] $ascii $match
	label control:
	    set p [PHI int16* {$string $p3} {$test $controlNext} "p"]
	    my condBr [my neq [$api Tcl_UniCharIsControl [my load $p]] $0] \
		$controlNext $fail
	label controlNext "control.next"
	    set p3 [my getelementptr $p $n "p.3"]
	    my condBr [my lt $p3 $end] $control $match
	label digit:
	    set p [PHI int16* {$string $p4} {$test $digitNext} "p"]
	    my condBr [my neq [$api Tcl_UniCharIsDigit [my load $p]] $0] \
		$digitNext $fail
	label digitNext "digit.next"
	    set p4 [my getelementptr $p $n "p.4"]
	    my condBr [my lt $p4 $end] $digit $match
	label graph:
	    set p [PHI int16* {$string $p5} {$test $graphNext} "p"]
	    my condBr [my neq [$api Tcl_UniCharIsGraph [my load $p]] $0] \
		$graphNext $fail
	label graphNext "graph.next"
	    set p5 [my getelementptr $p $n "p.5"]
	    my condBr [my lt $p5 $end] $graph $match
	label lower:
	    set p [PHI int16* {$string $p6} {$test $lowerNext} "p"]
	    my condBr [my neq [$api Tcl_UniCharIsLower [my load $p]] $0] \
		$lowerNext $fail
	label lowerNext "lower.next"
	    set p6 [my getelementptr $p $n "p.6"]
	    my condBr [my lt $p6 $end] $lower $match
	label print:
	    set p [PHI int16* {$string $p7} {$test $printNext} "p"]
	    my condBr [my neq [$api Tcl_UniCharIsPrint [my load $p]] $0] \
		$printNext $fail
	label printNext "print.next"
	    set p7 [my getelementptr $p $n "p.7"]
	    my condBr [my lt $p7 $end] $print $match
	label punct:
	    set p [PHI int16* {$string $p8} {$test $punctNext} "p"]
	    my condBr [my neq [$api Tcl_UniCharIsPunct [my load $p]] $0] \
		$punctNext $fail
	label punctNext "punct.next"
	    set p8 [my getelementptr $p $n "p.8"]
	    my condBr [my lt $p8 $end] $punct $match
	label space:
	    set p [PHI int16* {$string $p9} {$test $spaceNext} "p"]
	    my condBr [my neq [$api Tcl_UniCharIsSpace [my load $p]] $0] \
		$spaceNext $fail
	label spaceNext "space.next"
	    set p9 [my getelementptr $p $n "p.9"]
	    my condBr [my lt $p9 $end] $space $match
	label upper:
	    set p [PHI int16* {$string $p10} {$test $upperNext} "p"]
	    my condBr [my neq [$api Tcl_UniCharIsUpper [my load $p]] $0] \
		$upperNext $fail
	label upperNext "upper.next"
	    set p10 [my getelementptr $p $n "p.10"]
	    my condBr [my lt $p10 $end] $upper $match
	label word:
	    set p [PHI int16* {$string $p11} {$test $wordNext} "p"]
	    my condBr [my neq [$api Tcl_UniCharIsWordChar [my load $p]] $0] \
		$wordNext $fail
	label wordNext "word.next"
	    set p11 [my getelementptr $p $n "p.11"]
	    my condBr [my lt $p11 $end] $word $match
	label xdigit:
	    set p [PHI int16* {$string $p12} {$test $xdigitNext} "p"]
	    my condBr [my Call tcl.impl.isXdigit [my load $p]] \
		$xdigitNext $fail
	label xdigitNext "xdigit.next"
	    set p12 [my getelementptr $p $n "p.12"]
	    my condBr [my lt $p12 $end] $xdigit $match
	label match:
	    my ret [Const true bool]

	    my condBr [my eq [my dereference $listPtr 0 TclList.refCount] $1] \
		$sublistInplace $sublistNew
	label sublistInplace "sublist.inPlace"
	    set onePast [my add $to $1 "onePast"]
	    my br $sublistInplaceFreeTest
	label sublistInplaceFreeTest "sublist.inPlace.loop.test"
	    set sources {$sublistInplace $sublistInplaceFree}
	    set index [PHI int32 {$onePast $loopIndex} $sources "index"]
	    my condBr [my lt $index $objc] \
		$sublistInplaceFree $sublistInplaceDone
	label sublistInplaceFree "sublist.inPlace.loop.body"
	    set loopIndex [my add $index $1 "index"]
	    set obj [my load [my getelementptr $objv [list $index]] "objPtr"]
	    my dropReference $obj
	    my br $sublistInplaceFreeTest

	    my condBr [my eq [my dereference $listPtr 0 TclList.refCount] $1] \
		$sublistInplace $sublistNew
	label sublistInplace "sublist.inPlace"
	    set onePast [my add $to $1 "onePast"]
	    my br $sublistInplaceFreeTest
	label sublistInplaceFreeTest "sublist.inPlace.free.test"
	    set sources {$sublistInplace $sublistInplaceFree}
	    set index [PHI int32 {$onePast $loopIndex} $sources "index"]
	    my condBr [my lt $index $objc] \
		$sublistInplaceFree $sublistInplaceDone
	label sublistInplaceFree "sublist.inPlace.free"
	    set loopIndex [my add $index $1 "index"]
	    set obj [my load [my getelementptr $objv [list $index]] "objPtr"]
	    my dropReference $obj
	    my br $sublistInplaceFreeTest

	params list idxArg elem ecvar
	build {
	    noalias $ecvar
	    nonnull $list $idxArg $elem $ecvar
	    set ary [my alloc STRING]
	    set argc [my alloc int]
	    set argv [my alloc STRING*]
	    my condBr [my eq [my dereference $idxArg 0 Tcl_Obj.typePtr] \
			   [$api tclListType]] \
		$doCopy $checkIndex
	label checkIndex "check.index"
	    my condBr [my GetIndex {} $idxArg $0] $doFlat $doCopy
	label doFlat "flat"
	    my store $idxArg $ary
	    my ret [my Call tcl.list.set $list $1 $ary $elem $ecvar]
	label doCopy "copy"

	    set code [$api Tcl_ListObjGetElements $interp $list $lenVar $objvVar]
	    my condBr [my eq $code $0] $realCheck $fail
	label realCheck:
	    set objc [my load $lenVar "objc"]
	    set objv [my load $objvVar "objv"]
	    my condBr [my gt $objc $0] $loop $done
	label loop:
	    set i [PHI int32 {$0 $iLoop} {$realCheck $loopNext} "i"]
	    set obj [my load [my getelementptr $objv [list $i]] "obj"]
	    lassign [my GetString $obj "element"] len2 bytes2
	    my condBr [my eq $len1 $len2] $loopCompare $loopNext
	label loopCompare:
	    my condBr [my eq [my memcmp $bytes1 $bytes2 $len1] $0] \
		$done $loopNext
	label loopNext:
	    set iLoop [set i [my add $i $1 "i"]]
	    my condBr [my lt $i $objc] $loop $done
	label fail:
	    my store $1 $ecVar
	    my ret [my fail ZEROONE]
	label done:
	    set flag [my phi [lmap flag {false false true} {Const $flag bool}] \
		    [list $realCheck $loopNext $loopCompare] "flag"]
	    my ret [my ok $flag]
	}

	##### Function tcl.list.unshare #####
	#
	# Type signature: list:STRING -> STRING

	    my ret [my fail FOREACH]
	label success:
	    set pair [my undef FOREACH]
	    set pair [my insert $pair $0 FOREACH.val]
	    set pair [my insert $pair [my unmaybe $steps] FOREACH.max]
	    my ret [my ok $pair]
	}


	##### Function tcl.list.foreach.getStep #####
	#
	# Type signature: pair:FOREACH -> INT
	#
	# Core of quadcode implementation ('foreachIter')
	#

	params objPtr
	build {
	    nonnull $objPtr
	    set NULL [my null Interp*]
	    set code [my setFromAny [$api tclBooleanType] $NULL $objPtr]
	    my ret [my eq $code $0]
	}


	##### Function tcl.invoke.command #####
	#
	# Type signature: objc:int * objv:STRING* * ecvar:int* -> STRING?
	#
	# Calls the Tcl interpreter to invoke a Tcl command, and packs the
	# result into a STRING FAIL.

	    my store $vf $vfp
	    my condBr [my eq $code2 $0] $ok $fail
	label ok:
	    set result [$api Tcl_GetObjResult $interp]
	    my addReference(STRING) $result
	    my ret [my ok $result]
	label fail:
	    set code [PHI int {$code1 $code2} {$stdInvoke $frameInvoke} "code"]
	    my store $code $ecvar
	    my ret [my fail STRING $code]
	}

	##### Function tcl.invoke.command.nre #####
	#
	# Type signature: objc:int × objv:STRING* × frame:CALLFRAME × ecvar:int*
	#                        -> CALLFRAME
	#
	# Calls the Tcl interpreter to invoke a Tcl command by means of
	# Tcl_NREvalObjv. Returns the callframe before the invocation if the
	# callframe was swizzled to do the invoke, NULL otherwise.

	set f [$module local "tcl.invoke.command.nre" \
		   CALLFRAME<-int,STRING*,CALLFRAME,int*]
	params objc objv frame ecvar
	build {
	    noalias $objv $frame $ecvar
	    nonnull $objv $ecvar
	    set interp [$api tclInterp]
	    my condBr [my nonnull $frame] $frameInvoke $stdInvoke
	label stdInvoke "invoke.standard"
	    $api Tcl_NREvalObjv $interp $objc $objv $0
	    my ret [my null CALLFRAME]
	label frameInvoke "invoke.with.callframe"
	    set vfp [my gep $interp 0 Interp.varFramePtr]
	    set vf [my load $vfp]
	    my store $frame $vfp
	    $api Tcl_NREvalObjv $interp $objc $objv $0
	    my ret $vf
	}

	##### Function tcl.nr.command.result #####
	#
	# Type signature: ecode:int × ecvar:int* -> STRING?
	#
	# Retrieves the value of a command invoked by tcl.invoke.command.nre
	# after the command has returned.

	set f [$module local "tcl.nr.command.result" STRING?<-int,int*]
	params ecode ecvar
	build {
	    noalias $ecvar
	    nonnull $ecvar
	    my condBr [my eq $ecode $0] $ok $fail
	label ok:
	    set result [$api Tcl_GetObjResult [$api tclInterp]]
	    my addReference(STRING) $result
	    my ret [my ok $result]
	label fail:
	    my store $ecode $ecvar
	    my ret [my fail STRING $ecode]
	}

	##### Function tcl.invoke.expanded #####
	#
	# Type signature: objc:int * objv:STRING* * flags:bool* * ecvar:int*
	#			-> STRING?
	#
	# Calls the Tcl interpreter to invoke a Tcl command, first expanding

	    set result [$api Tcl_GetObjResult $interp]
	    my addReference(STRING) $result
	    my ret [my ok $result]
	label fail:
	    my store $code $ecvar
	    my ret [my fail STRING $code]
	}

	##### Function tcl.invoke.expanded.nre #####
	#
	# Type signature: objc:int * objv:STRING* * flags:bool*
	#			* frame:CALLFRAME * ecvar:int* -> CALLFRAME
	#
	# Calls the Tcl interpreter to invoke a Tcl command by means of
	# Tcl_NREvalObjv, first expanding the arguments indicate by the flags
	# array (which will have objc elements in it). Returns the callframe
	# before the invocation if the callframe was swizzled to do the
	# invoke, NULL otherwise.

	set f [$module local "tcl.invoke.expanded.nre" \
		   CALLFRAME<-int,STRING*,bool*,CALLFRAME,int*]
	params objc objv flags frame ecvar
	build {
	    noalias $objv $flags $frame $ecvar
	    nonnull $objv $flags $ecvar
	    set iPtr [my alloc int "i"]
	    set jPtr [my alloc int "j"]
	    set lenPtr [my alloc int "len"]
	    set objcPtr [my alloc int "objcPtr"]
	    set objvPtr [my alloc STRING* "objvPtr"]
	    set tclobjSize [my cast(int) [my sizeof STRING]]
	    set interp [$api tclInterp]
	    my store $0 $iPtr
	    my store $0 $lenPtr
	    my br $findLenTest
	label findLenTest "test.findLength"
	    set i [my load $iPtr "i"]
	    my condBr [my lt $i $objc] $findLenBody $setupExpansion
	label findLenBody "body.findLength"
	    set flag [my load [my getelementptr $flags $i] "flag"]
	    set len [my load $lenPtr "len"]
	    my condBr $flag $findLenExpand $findLenSimple
	label findLenExpand "body.findLength.expand"
	    set obj [my load [my getelementptr $objv $i] "objPtr"]
	    $api Tcl_ListObjLength {} $obj $objcPtr
	    set lenstep1 [my load $objcPtr "lenStep"]
	    my br $findLenNext
	label findLenSimple "body.findLength.simple"
	    set lenstep2 $1
	    my br $findLenNext
	label findLenNext "next.findLength"
	    set lenstep [my phi [list $lenstep1 $lenstep2] \
			     [list $findLenExpand $findLenSimple] "lenStep"]
	    my store [my add $len $lenstep] $lenPtr
	    my store [my add $i $1] $iPtr
	    my br $findLenTest
	label setupExpansion "setup.expansion"
	    set len [my load $lenPtr "len"]
	    # Do not allocate on stack; might be large
	    set ary [$api ckalloc [my mult $len $tclobjSize] STRING "array"]
	    my store $0 $iPtr
	    my store $0 $jPtr
	    my br $expansionTest
	label expansionTest "test.expansion"
	    set i [my load $iPtr "i"]
	    my condBr [my lt $i $objc] $expansionBody $invoke
	label expansionBody "body.expansion"
	    set j [my load $jPtr "j"]
	    set flag [my load [my getelementptr $flags $i] "flag"]
	    set obj [my load [my getelementptr $objv $i] "objPtr"]
	    set target [my getelementptr $ary $j]
	    my condBr $flag $expansionExpand $expansionSimple
	label expansionExpand "body.expansion.expand"
	    $api Tcl_ListObjGetElements {} $obj $objcPtr $objvPtr
	    set srclen [my load $objcPtr "objc"]
	    set source [my load $objvPtr "objv"]
	    my memcpy $target $source [my mult $srclen $tclobjSize]
	    my store [my add $j $srclen] $jPtr
	    my br $expansionNext
	label expansionSimple "body.expansion.simple"
	    my store $obj $target
	    my store [my add $j $1] $jPtr
	    my br $expansionNext
	label expansionNext "next.expansion"
	    my store [my add $i $1] $iPtr
	    my br $expansionTest
	label invoke:
	    my condBr [my nonnull $frame] $frameInvoke $stdInvoke
	label stdInvoke "invoke.standard"
	    $api Tcl_NREvalObjv $interp $len $ary $0
	    my ret [my null CALLFRAME]
	label frameInvoke "invoke.with.callframe"
	    set vfp [my gep $interp 0 Interp.varFramePtr]
	    set vf [my load $vfp]
	    my store $frame $vfp
	    $api Tcl_NREvalObjv $interp $len $ary $0
	    my ret $vf
	}

	##### Function tcl.restoreFrame #####
	#
	# Type signature: frame:CALLFRAME -> void
	#
	# Restores the callframe pointer when returning from a Tcl_NRAddCallback
	# chain.

	set f [$module local "tcl.restoreFrame" void<-CALLFRAME]
	params frame
	build {
	    nonnull $frame
	    set interp [$api tclInterp]
	    set vfp [my gep $interp 0 Interp.varFramePtr]
	    my store $frame $vfp
	    my ret
	}

	##### Function tcl.existsOrError #####
	#
	# Type signature: exists:int1 * message:STRING * ecvar:int* -> int1
	#
	# Conditionally generates an error about a non-existing variable.
	# Generated like this to avoid introducing extra basic blocks at the

		[my constString TCL] [my constString LOOKUP] \
		[my constString COMMAND] [$api Tcl_GetString $cmdName] {}
	    my store $1 $ecvar
	    my ret [my fail STRING]
	}

	my CallFrameFunctions $api

	my @coroFunctions $api

	##### Function: tcl.alloc #####
	#
	# Type signature: size:int32->char*
	#
	# Returns a pointer to allocated memory

	set f [$module local tcl.alloc char*<-int32]
	params size
	build {
	    my ret [$api Tcl_Alloc $size]
	}

	##### Function: tcl.free #####
	#
	# Type signature: char*->void
	#
	# Frees a block of memory allocated by Tcl_Alloc

	set f [$module local tcl.free void<-char*]
	params p
	build {
	    $api Tcl_Free $p
	    my ret
	}

	##### Function: tcl.vector.clear
	#
	# Type signature: int,STRING**->void
	#
	# Frees the strings in a vector.  Used to free the strings in
	# objc/objv combinations.

	set f [$module local tcl.vector.clear void<-int,STRING*]
	params objc objv
	build {
	    my br $entry
        label entry:
	    my br $loop
	label loop:
	    set objc.loop [PHI int {$objc ${objc.decr}} {$entry $freeOne} "objc.loop"]
	    set ok [my cmpInt ${objc.loop} SGT [Const 0 int] "objc.gt.0"]
	    my condBr $ok $freeOne $done
	label freeOne:
	    set objc.decr [my sub ${objc.loop} [Const 1 int] "objc.decr"]
	    set toDropPtr [my getelementptr $objv ${objc.decr} "objv.at.ind"]
	    set toDrop [my load $toDropPtr "element.to.drop"]
	    my dropReference $toDrop
	    my br $loop
	label done:
	    my ret
	}

    }

    export @apiFunctions
}

# Local Variables:
# mode: tcl
# fill-column: 78
# auto-fill-function: nil
# buffer-file-coding-system: utf-8-unix
# End:

#		The execution engine associated with the module. Only
#		available after one of the engine-construction methods (e.g.,
#		'mcjit', 'interpreter') has been called.

oo::class create Module {
    superclass llvmEntity
    variable module counter funcs builder myname globals externs engine
    variable machine layout
    variable dbty mainNS thunkNS initFunction dbbuild

    constructor {name {filename "/dev/null"}} {
	next
	variable ::LLVM::debugmeta
#	set status [ParseCommandLineOptions -print-before-all -time-passes]
#		Had also tried:		-debug-pass=Structure
#	puts "status = $status"

	set myname $name
	set module [ModuleCreateWithName $name]
	SetTarget $module [GetHostTriple]

	if {$debugmeta} {
	    set dbbuild [Debugging create DBBUILD [self] $filename]
	    oo::objdefine [self] forward debug $dbbuild

	} on error {} {
	    my Warn "no debugging type for %s in '%s'" \
		[PrintTypeToString $type] [lindex [info level -1] 2]
	    return $dbty([Type void*])
	}
    }

    # Module:sizeof --
    #
    #	Returns the ABI size of the given type
    #
    # Parameters:
    #	type - The LLVM type handle
    #
    # Results:
    #	An integer giving the size of the given type

    method sizeof {type} {
	if {![info exists layout]} {
	    return -code error "No data layout has been set for this module."
	} else {
	    return [ABISizeOfType $layout $type]
	}
    }

    # Module:alignof --
    #
    #	Returns the ABI alignment of the given type
    #
    # Parameters:
    #	type - The LLVM type handle
    #
    # Results:
    #	An integer giving the alignment of the given type

    method alignof {type} {
	if {![info exists layout]} {
	    return -code error "No data layout has been set for this module."
	} else {
	    return [ABIAlignmentOfType $layout $type]
	}
    }
    
    # Module:function.create --
    #
    #	Create an instance of the Function class.
    #
    # Parameters:
    #	name -	The suggested name of the function. This is used to generate
    #		both the *actual* name of the function and the name of the

    # Results:
    #	A TclOO object that encapsulates the function.

    method local {name signature args} {
	set oldfile [my debug file]
	my debug file [dict get [info frame -1] file]
	set f [my function.create $name [Type func{$signature}]]
	if {"noinline" ni $args && "inlinehint" ni $args} {
	    lappend args alwaysinline
	}
	$f private
	$f attribute {*}$args
	upvar 1 $name ref
	set ref [$f ref]
	my debug file $oldfile

    #		0 to 3.
    #
    # Results:
    #	None.

    method optimize {{level 3}} {
	set level [expr {max(0, min(3, int($level)))}]
	if {![info exists machine] || ![info exists layout]} {
	    return -code error "Target machine has not been set."
	}
	set bld [PassManagerBuilderCreate]
	AddCoroutinePassesToExtensionPoints $bld
	set pm [CreatePassManager] ; # Module pass manager
	set fpm [CreateFunctionPassManagerForModule $module]
	my verify
	my FinalizeDebuggingMetadata
	try {

	    # SetDataLayout $module $layout
	    # AddTargetData $td $pm
	    # AddTargetData $td $fpm

	    PassManagerBuilderSetOptLevel $bld $level
	    PassManagerBuilderSetDisableUnrollLoops $bld [expr {!$level}]
	    if {$level > 1} {
		PassManagerBuilderUseInlinerWithThreshold $bld \
		    [expr {$level > 2 ? 275 : 225 }]
	    }
	    PassManagerBuilderPopulateModulePassManager $bld $pm
	    PassManagerBuilderPopulateFunctionPassManager $bld $fpm

	    AddAnalysisPasses $machine $fpm
	    InitializeFunctionPassManager $fpm
	    for {set fn [GetFirstFunction $module]} \
		{$fn ne ""} \
		{set fn [GetNextFunction $fn]} {
		    VerifyFunction $fn LLVMPrintMessageAction
#		    DumpValue $fn
		    RunFunctionPassManager $fpm $fn
		}
	    FinalizeFunctionPassManager $fpm

	    AddAnalysisPasses $machine $pm
	    RunPassManager $pm $module

	} finally {
	    DisposePassManager $fpm
	    DisposePassManager $pm
	    PassManagerBuilderDispose $bld
	}
    }

    # Module:ref (property) --
    #

    #	code from this module.

    method mcjit {{optimisationLevel 2}} {
	if {[info exists engine]} {
	    return -code error "an engine has already been initialised"
	}
	set engine [CreateMCJITCompilerForModule $module $optimisationLevel]
	set machine [GetExecutionEngineTargetMachine $engine]
	set layout [GetExecutionEngineTargetData $engine]
	puts "Compiling for [GetTarget $module]"
	puts "Data Layout = [GetDataLayout $module]"
    }

    # Module:prepareToCompile --
    #
    #	Set the machine and layout to the current target triple, or the
    #	target triple passed as a parameter
    #
    # Parameters:
    #	triple - Target triple

    method prepareToCompile {{triple {}}} {
	set machine [MakeTargetMachine $triple]
	set triple [GetTargetMachineTriple $machine]
	set layout [CreateTargetDataLayout $machine]
	puts "prepareToCompile: Target data layout: [CopyStringRepOfTargetData $layout]"
	SetTarget $module $triple
	SetDataLayout $module [CopyStringRepOfTargetData $layout]
    }

    # Module:simple --
    #
    #	Set the execution engine for the module to be the simple execution
    #	engine. Note that it is an error for there to be multiple execution
    #	engines set.

	Type "NUMERIC BOOLEAN"

	# Debug-world delegates for the basic types
	DBTY void <- void   void "void"
	DBTY ptr  <- ClientData  pointer "ClientData" $void
	DBTY chr  <- char   int "char" 8
	DBTY chrs <- char*  pointer "char*" $chr
	DBTY chpp <- char** pointer "char**" $chrs
	DBTY i16  <- int16  int "Tcl_UniChar" 16
	DBTY ustr <- int16* pointer "Tcl_UniString" $i16
	DBTY i32  <- int    int "int" 32
	DBTY i32* <- int*   pointer "int*" $i32
	DBTY i64  <- int64  int "int64" 64
	DBTY bool <- bool   int "bool" 1
	DBTY b*   <- bool*  pointer "bool*" $bool

	    int8*
	}
	struct "" {
	    STRING
	    bool
	}

	DBTY ptrs <- ClientData*	  pointer "" $ptr
	set nrecbtype [Type func{int<-ClientData*,Interp*,int}*]
	DBTY NreCb <- [Type func{int<-ClientData*,Interp*,int}] \
	    function $i32 $ptrs $Interp $i32
	DBTY NreCbPtr <- $nrecbtype pointer "NreCallbackPtr" $NreCb

	return
    }
}

# Class Function --
#
#	This class handles LLVM functions when they are under construction, in

	#
	# Side effects:
	#	Stores data regarding the fixup in the variable '@phis@'
	#	in the caller

	proc PHI {type values sources {name {}}} {
	    upvar 1 @phis@ phis
	    set phi [uplevel 1 [list my phiStub [Type $type] $name]]
	    lappend phis $phi $sources $values
	    return $phi
	}

	# FixupPhis --
	#
	#	Backpatch the phi operations generated by PHI to have their

oo::class create ThunkBuilder {
    superclass BuildSupport
    variable m b metathunk metathunkblock metathunkerror metathunkref
    variable makingThunks thunkprocmeta
    variable 0 1 OK ERROR
    variable Tcl_UniChar mp_int Tcl_ObjCmdType Tcl_ObjCmdPtr
    variable Tcl_NRPostProcType Tcl_NRPostProcPtr
    variable Tcl_CmdDeleteProc Tcl_CmdDeletePtr
    variable tcl.obj.constant

    constructor {module} {
	next [set b [$module builder]]
	variable obj.constants.pending {}
	set m $module
	set 0 [set OK [Const 0]]
	set 1 [set ERROR [Const 1]]
	set makingThunks 0
	set thunkprocmeta {}

	set Tcl_CmdDeleteProc [Type func{void<-ClientData}]
	set Tcl_CmdDeletePtr [Type $Tcl_CmdDeleteProc*]
	set Tcl_UniChar [Int16Type]
	set Tcl_ObjCmdType [Type func{int<-ClientData,Interp*,int,Tcl_Obj**}]
	set Tcl_ObjCmdPtr [Type $Tcl_ObjCmdType*]
	set Tcl_NRPostProcType [Type func{int<-char**,Interp*,int}]
	set Tcl_NRPostProcPTr [Type $Tcl_NRPostProcType]
	oo::objdefine $b export Call
	my InitTclMathfuncs

	set name "[$module name]_Init"
	set metathunk [$module function.create $name func{int<-Interp*}]
	my buildInSection preface {
	    [$metathunk block "enter"] build-in $b

		}
	    }
	}
    }

    method buildInSection {id script} {
	set line [dict get {
 	    preface 1
	    API 2 APIvar 3
	    initConstant 4 commands 5
	    packageProvide 6
	} $id]
	$m debug scope "" {
	    $metathunk setAsCurrentDebuggingScope
	    $b @location $line

    #
    # Parameters:
    #	name -	The name of the command to create.
    #	func -	The LLVM value reference to the function that implements the
    #		command. NOTE that this function has to follow the
    #		Tcl_ObjCmdProc type signature; this does not bind the output
    #		of the code generator directly.
    #	wrapper - If non-empty, 'func' is an NR command proc, and 'wrapper'
    #	          is the wrapper function for non-NRE evaluation.
    #
    # Results:
    #	None.

    method InstallCommand {name func wrapper} {
	my variable interp
	my buildInSection commands {
	    $metathunkblock build-in $b
	    if {!$makingThunks} {
		set metathunkblock [$metathunk block createCommands]
		$b br $metathunkblock
		set makingThunks 1
		$metathunkblock build-in $b
	    }
	    set namestr [$b constString $name "name.thunk$name"]
	    if {$wrapper ne ""} {
		set result [my Tcl_NRCreateCommand $interp $namestr \
				[$wrapper ref] [$func ref] {} {}]
	    } else {
		set result [my Tcl_CreateObjCommand $interp $namestr \
				[$func ref] {} {}]
	    }
	    if {[dict exists $thunkprocmeta $name]} {
		set proc [dict get $thunkprocmeta $name]
		$b storeInStruct $proc Proc.cmdPtr $result
	    }
	    set metathunkblock [$metathunk block createCommands]
	    $b condBr [$b nonnull $result] $metathunkblock $metathunkerror
	}

	}
	my buildInSection packageProvide {
	    set block [$metathunk block leave]
	    $metathunkblock build $b {
		$b br $block
	    }
	    $block build $b {
		if 0 {
		    # ^^^ change to if 1 to stop right after loading the package
		    set llvm.debugtrap [$m intrinsic debugtrap]
		    $b call ${llvm.debugtrap} {}
		}
		if {$version ne ""} {
		    set pkgname tclquadcoded::[string trimleft [$m name] ":"]
		    $b ret [my Tcl_PkgProvideEx $interp \
			    [$b constString $pkgname "pkg.name"] \
			    [$b constString $version "pkg.version"] {}]
		} else {
		    $b ret $OK

    # Parameters:
    #	name -	The (fully-qualified) name of the Tcl command to generate.
    #	bytecode -
    #		The bytecode description dictionary that describes the
    #		original command. This is an augmented output of the
    #		[tcl::unsupported::getbytecode] command.
    #	func -	The TclOO handle to the function we are binding to.
    #	nre -   Flag that is true iff the function requires NRE
    #	returnType - LLVM type reference for the return type of the function
    #
    # Results:
    #	The function object for the wrapping function.

    method thunk {name bytecode func nre returnType} {

	# Make the thunk function
	set thunk [$m function.create cmd.thunk$name $Tcl_ObjCmdType]
	$thunk private

	# If the command requires NRE, make the post-processing function
	# and the Obj command proc
	if {$nre} {
	    set thunk2 [$m function.create cmd.thunk2$name \
			    $Tcl_NRPostProcType]
	    $thunk2 private
	    set thunk3 [$m function.create cmd.thunk3$name \
			    $Tcl_ObjCmdType]

	    my MakeObjCmdForNR $b $thunk3 [$thunk ref]
	} else {
	    set thunk3 {}
	}

	# Start building the thunk function

	set idx -1
	set block [$thunk block]
	$thunk setAsCurrentDebuggingScope
	$block build-in $b


	# Make code to declare parameters and handle variable args
	$b @location 1
	foreach paramName {clientData interp argc argv} {
	    set $paramName [$thunk param [incr idx] $paramName]
	}
	lassign [dict get $bytecode signature] restype argtypes
	set defaults [dict get $bytecode argumentDefaults]
	set argsIdx -1
	if {"args" eq [lindex $defaults end 0]} {
	    set argsIdx [llength $defaults]
	}

	my CheckArgcInRange $name $interp $argc $argv $defaults $argsIdx

	# Make code to set argument values and apply defaults for
	# varargs
	$b @location 2

	set realargs {}
	set idx 0
	foreach arginfo $defaults {
	    lassign $arginfo argName argDefaulted argDefault
	    incr idx
	    if {$argsIdx >= 0 && $idx >= $argsIdx} {
		set 0 [Const 0]

	    $b assume [$b gt [$b refCount $val] [Const 0]]
	    lappend realargs $val
	    if {[info exists argsToClear]} {
		break
	    }
	}

	# Make code to invoke the actual procedure

	$b @location 3
	set value [$b call [$func ref] $realargs "value"]
	SetTailCall $value 0
	if {$nre} {
	    $b NRAddCallback [$thunk2 ref] $value
	    $b launchCoroRunner $value
	}

	$b @location 4

	if {[info exists argsToClear]} {
	    my Tcl_DecrRefCount $argsToClear
	}
	if {$nre} {
	    $b ret [Const 0 int]
	    $b @loc {}
	    set block [$thunk2 block]
	    $thunk2 setAsCurrentDebuggingScope
	    $block build-in $b
	    $b @location 4
	    set data_ [$thunk2 param 0 "data"]
	    set interp_ [$thunk2 param 1 "interp"]
	    set result_ [$thunk2 param 2 "result"]
	    set handle [$b load [$b gep $data_ 0]]
	    set value [$b NRReturnToThunk $handle $returnType]
	    my MapResultToTcl $thunk2 $interp_ $value $returnType
	} else {
	    my MapResultToTcl $thunk $interp $value $returnType
	}
	$b @loc {}

	if {$nre} {
	    $thunk2 verify
	    $thunk3 verify
	}
	$thunk verify
	my InstallCommand $name $thunk $thunk3

	return $thunk
    }

    # ThunkBuilder:MakeObjCmdForNR --
    #
    #	Makes the 'objProc' for a command with an NRE implementation
    #
    # Parameters:
    #   b - Builder that is building LLVM-IR
    #	thunk - Wrapper function under construction
    #	nrProc - LLVM Tcl_ObjCmdProc reference for the NRE version to be wrapped
    #
    # Results:
    #	None.

    method MakeObjCmdForNR {b thunk nrProc} {
	set block [$thunk block]
	$thunk setAsCurrentDebuggingScope
	$block build-in $b
	$b @location 1
	set clientData [$thunk param 0 "clientData"]
	set interp [$thunk param 1 "interp"]
	set objc [$thunk param 2 "objc"]
	set objv [$thunk param 3 "objv"]
	my Tcl_NRCallObjProc $interp $nrProc $clientData $objc $objv
	$b ret [Const 0 int]
    }

    # ThunkBuilder:CheckArgcInRange --
    #
    #	Generate code to test whether the argument count to a command
    #	implementation matches that which is required for calling the
    #	function.
    #

    # ThunkBuilder:MapResultToTcl --
    #
    #	Generate code to create a Tcl value that represents the output of a
    #	function.
    #
    # Parameters:
    #	thunk -
    #		The thunk under cosntruction
    #	interp -
    #		The LLVM value reference to the Interp*.
    #	result -
    #		The LLVM value reference to the result of the wrapped
    #		function.
    #	resultType -
    #		The human-readable type descriptor for the result of the
    #		wrapped function. Note that this cannot be deduced from the
    #		value itself; some Tcl logical types may be convergently
    #		mapped at the LLVM level.
    #
    # Results:
    #	None.

    method MapResultToTcl {thunk interp result resultType} {

	# This only happens when all paths are failing paths
	if {$resultType in {"VOID FAIL" FAIL}} {
	    $b ret $result
	    return
	}
	if {[string match "FAIL *" $resultType]} {
	    # If a failure happened, the error message will have already been

	    }
	    ^double$ - ^DOUBLE$ {
		return [DoubleType]
	    }
	    ^float$ - ^FLOAT$ {
		return [FloatType]
	    }
	    ^COROHANDLE$ {
		return [Type char*]
	    }
	    ^CALLFRAME$ {
		return [Type named{CallFrame}*]
	    }
	    ^CALLFRAME {
		set packaged [Type [lrange $t 1 end]]
		return [Type struct{[Type CALLFRAME],$packaged}]
	    }

	list [catch {fixed w x y z} result] \
	    [regsub -all ::expandtest:: $result {}]
    }

    proc test12 {} {
	list [catch {fixed {*}[joinsp w x y z]} result] \
	    [regsub -all ::expandtest:: $result {}]
    }

    proc test13 {a b c} {
	list $c $b $a
    }
    proc test14 {pqr} {
	test13 {*}$pqr
    }
    proc test15 {cmd} {
	{*}$cmd y z
    }
}

namespace eval bug-0616bcf08e {
    proc mulsum {x y z} {
	expr {double($x) * double($y) + double($z)}
    }

    }
    set lcm 1
    dict for {p c} $primes {
	set lcm [expr {$lcm * $p ** $c}]
    }
    return $lcm
}

proc rectest1 {{n 3}} {
    if {$n == 0} {
	return {}
    } else {
	return .[rectest1 [expr {$n-1}]]
    }
}

proc rectest2 {{n 3}} {
    if {$n == 0} {
	return -code error "Error thrown from recursive proc"
    } else {
	return .[rectest2 [expr {$n-1}]]
    }
}

proc rectest3 {nv} {
    upvar 1 $nv nn
    if {[incr nn -1] <= 0} {
	return |
    } else {
	return .[rectest3 nn]
    }
}

proc openclose {} {
    close [open /dev/null w]
}

proc openclose2 {lst} {
    close [open {*}$lst]
}
    

proc treecollect {t} {
    set l {}
    treewalk l $t
    return $l
}
proc treewalk {lvar t} {
    upvar 1 $lvar l
    lappend l [lindex $t 0]
    foreach item [lrange $t 1 end] {
	treewalk l $item
    }
}

proc qsort {L {left 0} {right -1}} {
    set left [expr {int($left)}]
    set right [expr {int($right)}]
    if {$right < 0} {set right [expr {[llength $L] - 1}]}
    set pivot [lindex $L [expr {($left + $right) / 2}]]

    {expandtest::test1}
    {expandtest::test2}
    {expandtest::test3}
    # {expandtest::test5}   Needs support for loop exception ranges
    {expandtest::test6 {a b c d e} {2 2} x}
    {expandtest::test7}
    {expandtest::test8}
    {expandtest::test9}
    {expandtest::test10}
    {expandtest::test11}
    {expandtest::test12}
    {expandtest::test14 {i j k}}
    {expandtest::test15 {::expandtest::test13 x}}
    {expandtest::test15 {test13 x}}

    {bug-0616bcf08e::msrange 0 10}
    {bug-0616bcf08e::msrange2 0 10}
    {singleton::lforeach}
    {singleton::llindex}
    {singleton::srange}
    {rectest1}
    {treecollect {a {b {d {h i}} {e {j k}}} {c {f {l m}} {g {n o}}}}}
    {list [catch rectest2 result] $result}
    {set x 3; rectest3 x}
    {openclose}
    {openclose2 {/dev/null w}}
    {qsort {3 6 8 7 0 1 4 2 9 5}}
    {impure 0x0 0 0}
    {impure 0x3 0 0}
    {impure 0 1 1}
    {impure 10 10000 10}
    {impure 1 +2000 [string range "123" 2 2]}
    {impure-typecheck-int 10 10000 10}

    expandtest::test6
    expandtest::test7
    expandtest::test8
    expandtest::test9
    expandtest::test10
    expandtest::test11
    expandtest::test12
    # test13 is the *target* of expansion tests
    expandtest::test13
    expandtest::test14
    expandtest::test15

    # Combined feature tests
    lcmRange
    bug-0616bcf08e::*
    rectest1
    rectest2
    rectest3
    openclose
    openclose2
    treecollect
    treewalk
    qsort
    impure
    impure-caller
    impure-typecheck-int
    impure2
    comps
    bug-7c599d4029::*

		set starter 0
		set leader $pc
	    }
	    switch -exact -- [lindex $q 0 0] {
		"entry" - "param" {
		    set lastEntryPC $pc
		}
		"jump" - "NRE.suspend" {
		    set starter 1
		    set target [lindex $q 1 1]
		    dict set starters $target {}
		}
		"jumpTrue" - "jumpFalse" -
		"jumpMaybe" - "jumpMaybeNot" {
		    set starter 1

	    # Find the successors of the basic block, and add this
	    # block to their predecessor list

	    set content [lrange $quads $startpc [expr {$endpc - 1}]]
	    if {$endpc > $startpc} {
		set q [lindex $quads [expr {$endpc - 1}]]
		switch -exact -- [lindex $q 0 0] {
		    "jump" - "NRE.suspend" {
			set target [my bbindex [lindex $q 1 1]]
			my bblink $bbindex $target
			lset content end 1 [list bb $target]
		    }
		    "jumpTrue" - "jumpFalse" -
		    "jumpMaybe" - "jumpMaybeNot" {
			set target [my bbindex [lindex $q 1 1]]

	return {
	    reads 0 writes 0 readsNonLocal {} writesNonLocal {}
	    error "lsort with argument expansion is not supported yet"
	}
    }

    # Only [lsort -command] has an interesting frame effect

    # Only [lsort -command] might use callframe data

    lassign [my parse___lsort $q] usesCommand command
    if {!$usesCommand} {
	return {killable Inf noCallFrame {} pure {}}
    }

    # TODO: We can't analyze [lsort -command] yet, but we could. What it would
    #       take is to generate bytecode for the command prefix with two dummy
    #       arguments, and then determine the effect of the bytecode on the
    #       callframe.

    # error "lsort -command is not supported yet"
    return {

	error "lsort -command is not supported yet"
	nre {} reads 0 writes 0 readsNonLocal {} writesNonLocal {}
    }

}

# quadcode::specializer method frameEffect___regexp --
#
#	Determines the callframe effect of the [regexp] command

    dict set cmdAttr ::after \
        {noCallFrame {}}
    dict set cmdAttr ::cd \
        [dict get $cmdAttr ::after]
    dict set cmdAttr ::clock \
        {special {}}
    dict set cmdAttr ::close \
        {nre {} noCallFrame {}}
    dict set cmdAttr ::encoding \
        [dict get $cmdAttr ::clock]
    dict set cmdAttr ::eof \
        {nre {} killable Inf noCallFrame {}}
    dict set cmdAttr ::error \
        [dict get $cmdAttr ::after]
    dict set cmdAttr ::exit \
        [dict get $cmdAttr ::after]
    dict set cmdAttr ::fblocked \
        [dict get $cmdAttr ::eof]
    dict set cmdAttr ::fconfigure \
        {nre {} killable 3 noCallFrame {}}
    dict set cmdAttr ::fcopy \
        [dict get $cmdAttr ::close]
    dict set cmdAttr ::fileevent \
        [dict get $cmdAttr ::after]
    dict set cmdAttr ::flush \
        [dict get $cmdAttr ::close]
    dict set cmdAttr ::format \
        {pure {} killable Inf noCallFrame {}}
    dict set cmdAttr ::gets \
        {nre {} writes 2}
    dict set cmdAttr ::glob \
        {killable Inf noCallFrame {}}
    dict set cmdAttr ::interp \
        [dict get $cmdAttr ::clock]
    dict set cmdAttr ::join \
        [dict get $cmdAttr ::format]
    dict set cmdAttr ::lrange \
        [dict get $cmdAttr ::format]
    dict set cmdAttr ::lrepeat \
        [dict get $cmdAttr ::format]
    dict set cmdAttr ::lreplace \
        [dict get $cmdAttr ::format]
    dict set cmdAttr ::lreverse \
        [dict get $cmdAttr ::format]
    dict set cmdAttr ::lsearch \
        [dict get $cmdAttr ::format]
    dict set cmdAttr ::lsort \
        [dict get $cmdAttr ::clock]
    dict set cmdAttr ::oo::InfoClass::call \
        [dict get $cmdAttr ::glob]
    dict set cmdAttr ::oo::InfoClass::constructor \
        [dict get $cmdAttr ::glob]
    dict set cmdAttr ::oo::InfoClass::definition \
        [dict get $cmdAttr ::glob]
    dict set cmdAttr ::oo::InfoClass::destructor \
        [dict get $cmdAttr ::glob]
    dict set cmdAttr ::oo::InfoClass::filters \
        [dict get $cmdAttr ::glob]
    dict set cmdAttr ::oo::InfoClass::forward \
        [dict get $cmdAttr ::glob]
    dict set cmdAttr ::oo::InfoClass::instances \
        [dict get $cmdAttr ::glob]
    dict set cmdAttr ::oo::InfoClass::methods \
        [dict get $cmdAttr ::glob]
    dict set cmdAttr ::oo::InfoClass::methodtype \
        [dict get $cmdAttr ::glob]
    dict set cmdAttr ::oo::InfoClass::mixins \
        [dict get $cmdAttr ::glob]
    dict set cmdAttr ::oo::InfoClass::subclasses \
        [dict get $cmdAttr ::glob]
    dict set cmdAttr ::oo::InfoClass::superclasses \
        [dict get $cmdAttr ::glob]
    dict set cmdAttr ::oo::InfoClass::variables \
        [dict get $cmdAttr ::glob]
    dict set cmdAttr ::oo::InfoObject::call \
        [dict get $cmdAttr ::glob]
    dict set cmdAttr ::oo::InfoObject::definition \
        [dict get $cmdAttr ::glob]
    dict set cmdAttr ::oo::InfoObject::filters \
        [dict get $cmdAttr ::glob]
    dict set cmdAttr ::oo::InfoObject::forward \
        [dict get $cmdAttr ::glob]
    dict set cmdAttr ::oo::InfoObject::isa \
        [dict get $cmdAttr ::glob]
    dict set cmdAttr ::oo::InfoObject::methods \
        [dict get $cmdAttr ::glob]
    dict set cmdAttr ::oo::InfoObject::methodtype \
        [dict get $cmdAttr ::glob]
    dict set cmdAttr ::oo::InfoObject::mixins \
        [dict get $cmdAttr ::glob]
    dict set cmdAttr ::oo::InfoObject::variables \
        [dict get $cmdAttr ::glob]
    dict set cmdAttr ::oo::InfoObject::vars \
        [dict get $cmdAttr ::glob]
    dict set cmdAttr ::open \
        [dict get $cmdAttr ::close]
    dict set cmdAttr ::pid \
        [dict get $cmdAttr ::format]
    dict set cmdAttr ::platform::generic \
        [dict get $cmdAttr ::format]
    dict set cmdAttr ::platform::identify \
        [dict get $cmdAttr ::format]
    dict set cmdAttr ::platform::patterns \
        [dict get $cmdAttr ::format]
    dict set cmdAttr ::puts \
        [dict get $cmdAttr ::close]
    dict set cmdAttr ::pwd \
        [dict get $cmdAttr ::glob]
    dict set cmdAttr ::read \
        [dict get $cmdAttr ::close]
    dict set cmdAttr ::regexp \
        [dict get $cmdAttr ::clock]
    dict set cmdAttr ::regsub \
        [dict get $cmdAttr ::clock]
    dict set cmdAttr ::scan \
        {writes -3}
    dict set cmdAttr ::seek \
        [dict get $cmdAttr ::close]
    dict set cmdAttr ::socket \
        [dict get $cmdAttr ::close]
    dict set cmdAttr ::split \
        [dict get $cmdAttr ::format]
    dict set cmdAttr ::tcl::binary::decode::base64 \
        [dict get $cmdAttr ::format]
    dict set cmdAttr ::tcl::binary::decode::hex \
        [dict get $cmdAttr ::format]
    dict set cmdAttr ::tcl::binary::decode::uuencode \

    dict set cmdAttr ::tcl::binary::format \
        [dict get $cmdAttr ::format]
    dict set cmdAttr ::tcl::binary::scan \
        [dict get $cmdAttr ::scan]
    dict set cmdAttr ::tcl::chan::blocked \
        [dict get $cmdAttr ::eof]
    dict set cmdAttr ::tcl::chan::close \
        [dict get $cmdAttr ::close]
    dict set cmdAttr ::tcl::chan::copy \
        [dict get $cmdAttr ::close]
    dict set cmdAttr ::tcl::chan::create \
        [dict get $cmdAttr ::close]
    dict set cmdAttr ::tcl::chan::eof \
        [dict get $cmdAttr ::eof]
    dict set cmdAttr ::tcl::chan::event \
        [dict get $cmdAttr ::close]
    dict set cmdAttr ::tcl::chan::flush \
        [dict get $cmdAttr ::close]
    dict set cmdAttr ::tcl::chan::gets \
        [dict get $cmdAttr ::gets]
    dict set cmdAttr ::tcl::chan::names \
        [dict get $cmdAttr ::glob]
    dict set cmdAttr ::tcl::chan::pending \
        [dict get $cmdAttr ::glob]
    dict set cmdAttr ::tcl::chan::pipe \
        [dict get $cmdAttr ::close]
    dict set cmdAttr ::tcl::chan::pop \
        [dict get $cmdAttr ::after]
    dict set cmdAttr ::tcl::chan::postevent \
        [dict get $cmdAttr ::close]
    dict set cmdAttr ::tcl::chan::push \
        [dict get $cmdAttr ::after]
    dict set cmdAttr ::tcl::chan::puts \
        [dict get $cmdAttr ::close]
    dict set cmdAttr ::tcl::chan::read \
        [dict get $cmdAttr ::close]
    dict set cmdAttr ::tcl::chan::seek \
        [dict get $cmdAttr ::close]
    dict set cmdAttr ::tcl::chan::tell \
        [dict get $cmdAttr ::eof]
    dict set cmdAttr ::tcl::chan::truncate \
        [dict get $cmdAttr ::close]
    dict set cmdAttr ::tcl::clock::clicks \
        [dict get $cmdAttr ::glob]
    dict set cmdAttr ::tcl::clock::microseconds \
        [dict get $cmdAttr ::glob]
    dict set cmdAttr ::tcl::clock::milliseconds \
        [dict get $cmdAttr ::glob]
    dict set cmdAttr ::tcl::clock::seconds \
        [dict get $cmdAttr ::glob]
    dict set cmdAttr ::tcl::dict::keys \
        [dict get $cmdAttr ::format]
    dict set cmdAttr ::tcl::dict::values \
        [dict get $cmdAttr ::format]




    dict set cmdAttr ::tcl::file::atime \

        {killable 3 noCallFrame {}}
    dict set cmdAttr ::tcl::file::attributes \
        {killable 4 noCallFrame {}}
    dict set cmdAttr ::tcl::file::channels \
        [dict get $cmdAttr ::glob]
    dict set cmdAttr ::tcl::file::copy \
        [dict get $cmdAttr ::close]
    dict set cmdAttr ::tcl::file::delete \
        [dict get $cmdAttr ::after]
    dict set cmdAttr ::tcl::file::dirname \
        [dict get $cmdAttr ::format]
    dict set cmdAttr ::tcl::file::executable \
        [dict get $cmdAttr ::glob]
    dict set cmdAttr ::tcl::file::exists \
        [dict get $cmdAttr ::glob]
    dict set cmdAttr ::tcl::file::extension \
        [dict get $cmdAttr ::format]
    dict set cmdAttr ::tcl::file::isdirectory \
        [dict get $cmdAttr ::after]
    dict set cmdAttr ::tcl::file::isfile \
        [dict get $cmdAttr ::glob]
    dict set cmdAttr ::tcl::file::join \
        [dict get $cmdAttr ::format]
    dict set cmdAttr ::tcl::file::link \
        [dict get $cmdAttr ::after]
    dict set cmdAttr ::tcl::file::lstat \
        {writes 3}
    dict set cmdAttr ::tcl::file::mkdir \
        [dict get $cmdAttr ::after]
    dict set cmdAttr ::tcl::file::mtime \
        [dict get $cmdAttr ::tcl::file::atime]
    dict set cmdAttr ::tcl::file::nativename \
        [dict get $cmdAttr ::glob]
    dict set cmdAttr ::tcl::file::normalize \
        [dict get $cmdAttr ::glob]
    dict set cmdAttr ::tcl::file::owned \
        [dict get $cmdAttr ::glob]
    dict set cmdAttr ::tcl::file::pathtype \
        [dict get $cmdAttr ::format]
    dict set cmdAttr ::tcl::file::readable \
        [dict get $cmdAttr ::glob]
    dict set cmdAttr ::tcl::file::readlink \
        [dict get $cmdAttr ::glob]
    dict set cmdAttr ::tcl::file::rename \
        [dict get $cmdAttr ::after]
    dict set cmdAttr ::tcl::file::rootname \
        [dict get $cmdAttr ::format]
    dict set cmdAttr ::tcl::file::separator \
        [dict get $cmdAttr ::format]
    dict set cmdAttr ::tcl::file::size \
        [dict get $cmdAttr ::glob]
    dict set cmdAttr ::tcl::file::split \
        [dict get $cmdAttr ::format]
    dict set cmdAttr ::tcl::file::stat \
        [dict get $cmdAttr ::tcl::file::lstat]
    dict set cmdAttr ::tcl::file::system \
        [dict get $cmdAttr ::glob]
    dict set cmdAttr ::tcl::file::tail \
        [dict get $cmdAttr ::format]
    dict set cmdAttr ::tcl::file::tempfile \
        [dict get $cmdAttr ::after]
    dict set cmdAttr ::tcl::file::type \
        [dict get $cmdAttr ::glob]
    dict set cmdAttr ::tcl::file::volumes \
        [dict get $cmdAttr ::glob]
    dict set cmdAttr ::tcl::file::writable \
        [dict get $cmdAttr ::glob]
    dict set cmdAttr ::tcl::info::args \
        [dict get $cmdAttr ::glob]
    dict set cmdAttr ::tcl::info::body \
        [dict get $cmdAttr ::glob]
    dict set cmdAttr ::tcl::info::cmdcount \
        [dict get $cmdAttr ::glob]
    dict set cmdAttr ::tcl::info::commands \
        [dict get $cmdAttr ::glob]
    dict set cmdAttr ::tcl::info::complete \
        [dict get $cmdAttr ::format]
    dict set cmdAttr ::tcl::info::default \
        [dict get $cmdAttr ::tcl::file::lstat]
    dict set cmdAttr ::tcl::info::errorstack \
        [dict get $cmdAttr ::glob]
    dict set cmdAttr ::tcl::info::frame \
        [dict get $cmdAttr ::glob]
    dict set cmdAttr ::tcl::info::functions \
        [dict get $cmdAttr ::glob]
    dict set cmdAttr ::tcl::info::globals \
        [dict get $cmdAttr ::glob]
    dict set cmdAttr ::tcl::info::hostname \
        [dict get $cmdAttr ::format]
    dict set cmdAttr ::tcl::info::library \
        [dict get $cmdAttr ::format]
    dict set cmdAttr ::tcl::info::loaded \
        [dict get $cmdAttr ::glob]
    dict set cmdAttr ::tcl::info::locals \
        {killable Inf reads -1}
    dict set cmdAttr ::tcl::info::nameofexecutable \
        [dict get $cmdAttr ::format]
    dict set cmdAttr ::tcl::info::patchlevel \
        [dict get $cmdAttr ::format]
    dict set cmdAttr ::tcl::info::procs \
        [dict get $cmdAttr ::glob]
    dict set cmdAttr ::tcl::info::script \
        {killable 2 noCallFrame {}}
    dict set cmdAttr ::tcl::info::sharedlibextension \
        [dict get $cmdAttr ::format]
    dict set cmdAttr ::tcl::info::tclversion \
        [dict get $cmdAttr ::format]
    dict set cmdAttr ::tcl::info::vars \

    dict set cmdAttr ::tcl::mathfunc::srand \
        [dict get $cmdAttr ::after]
    dict set cmdAttr ::tcl::mathfunc::tan \
        [dict get $cmdAttr ::format]
    dict set cmdAttr ::tcl::mathfunc::tanh \
        [dict get $cmdAttr ::format]
    dict set cmdAttr ::tcl::mathfunc::wide \
        [dict get $cmdAttr ::format]
    dict set cmdAttr ::tcl::string::bytelength \
        [dict get $cmdAttr ::format]
    dict set cmdAttr ::tcl::string::equal \
        [dict get $cmdAttr ::format]
    dict set cmdAttr ::tcl::string::first \
        [dict get $cmdAttr ::format]
    dict set cmdAttr ::tcl::string::last \
        [dict get $cmdAttr ::format]

# In the following, the columns are to be interpreted as:

# idem - The command is idempotent in the sense that invoking it multiple
#        times with the same args in the same interp will always return the
#        same result
#
# kill - The command is killable in that nothing depends on its side effects,
#        so if its result is not used, the call may be eliminated entirely.
#        This is 0, 1, or 'objc<=N'
#
# nre - This command, and all commads that call it, must be invoked
#       with non-recursive eval, This includes the core 'yield',
#       'yieldm' and 'yieldTo' commands, coroutine creation and
#       invocation, and any Core command that requires evaluating
#       unknown Tcl code, expressions, substitutions, or assembly language.
#       It also includes any command that cannot be fully analyzed
#       at compile time
#
# reads - What variables does the command read from the callframe? For
#         the builtins in this table, the result is either 'all' or
#         empty.
#
# writes - What variables does the command write to the callframe?
#          This is empty, a list of numbers N (indicating that objv[N]
#          contains the name of an output variable, or N+ (indicating that
#          objv[N] and all following args contain the names of output
#          variables).


#GLOBAL NAMESPACE

#name                                   idem    kill    nre     reads   writes  notes

after                                   0       0       0
cd                                      0       0       0
clock                                   SPECIAL                                 <4>
close                                   0       0       1
encoding                                SPECIAL                                 <4>

eof                                     0       1       1
error                                   0       0       0
exit                                    0       0       0
fblocked                                0       1       1
fconfigure                              0       objc<=3 1
fcopy                                   0       0       1

fileevent                               0       0       0
flush                                   0       0       1
format                                  1       1       0
gets                                    0       0       1               objv[2]
glob                                    0       1       0
interp                                  SPECIAL                                 <?>

join                                    1       1       0
lrange                                  1       1       0
lrepeat                                 1       1       0
lreplace                                1       1       0
lreverse                                1       1       0
lsearch                                 1       1       0
lsort                                   SPECIAL                                 <1>

open                                    0       0       1
pid                                     1       1       0
puts                                    0       0       1
pwd                                     0       1       0
read                                    0       0       1

regexp                                  SPECIAL                                 <2>
regsub                                  SPECIAL                                 <3>
scan                                    0       0       0               objv[3+]
seek                                    0       0       1
socket                                  0       0       1

split                                   1       1       0
tell                                    0       1       1

#<1> lsort needs the callframe if -command is used, and needs whatever
#    variable access that the command needs. It's unkillable if the
#    command is unkillable. Without -command (the common case!) it doesn't
#    touch the callframe. Even most of the -commands will wind up being
#    killable and not need the callframe, but it's probably best to
#    ignore the case initially and simply announce that [lsort
#    -command] is not compilable. [lsort -command] also must be recorded
#    as depending on the given command, and requires NRE if the command
#    does.
#
#<2> 'regexp' needs to parse out the switches in order to decide what
#    position on the command line is the 'exp'. The following position
#    is the 'string', and after that are the match variables. 'regexp'
#    reads nothing from the callframe and writes the match variables.
#    For nonconstant args, it's safe to assume it writes everything.
#    If there are no match variables (or if no match variables are
#    live), 'regexp' is killable. It does not require NRE
#
#<3> 'regsub' needs to parse out the switches in order to decide
#    whether a 'varName' arg is present. It reads nothing from the
#    callframe and writes only the 'varName'. For nonconstant args,
#    it's safe to assume that it writes everything. If there is no
#    match variable (or if the match variable is not live), 'regsub' is
#    killable. It does not require NRE.
#
#<4> 'clock' and 'encoding' are not yet compilable ensembles. They
#    probably ought to get made into such before attempting to analyze
#    them in the quadcode compiler.
    

#THE [platform] NAMESPACE

# name                                  idem    kill    nre     reads   writes  notes
platform::generic                       1       1       0
platform::identify                      1       1       0
platform::patterns                      1       1       0


#THE [binary] ENSEMBLE

# name                                  idem    kill    nre     reads   writes  notes
tcl::binary::decode::*                  1       1       0
tcl::binary::encode::*                  1       1       0
tcl::binary::format                     1       1       0
tcl::binary::scan                       0       0       0               objv[3+]


#THE [chan] ENSEMBLE

# name                                  idem    kill    nre     reads   writes  notes
tcl::chan::blocked                      0       1       1
tcl::chan::close                        0       0       1
tcl::chan::copy                         0       0       1
tcl::chan::create                       0       0       1
tcl::chan::eof                          0       1       1

tcl::chan::event                        0       0       1
tcl::chan::flush                        0       0       1
tcl::chan::gets                         0       0       1               objv[2]
tcl::chan::names                        0       1       0
tcl::chan::pending                      0       1       0

tcl::chan::pipe                         0       0       1
tcl::chan::pop                          0       0       0
tcl::chan::postevent                    0       0       1
tcl::chan::push                         0       0       0
tcl::chan::read                         0       0       1

tcl::chan::puts                         0       0       1
tcl::chan::seek                         0       0       1
tcl::chan::tell                         0       1       1
tcl::chan::truncate                     0       0       1

# THE [clock] ENSEMBLE

# name                                  idem    kill    nre     reads   writes  notes
tcl::clock::add                         0       1       0
tcl::clock::clicks                      0       1       0
tcl::clock::format                      0       1       0
tcl::clock::microseconds                0       1       0
tcl::clock::milliseconds                0       1       0

tcl::clock::scan                        0       1       0
tcl::clock::seconds                     0       1       0

# THE [dict] ENSEMBLE

# Not all the subcommands of [dict] are compiled in all circumstances

#name                                   idem    kill    nre     reads   writes
tcl::dict::keys                         1       1       0
tcl::dict::values                       1       1       0

# THE [encoding] ENSEMBLE

#name                                   idem    kill    nre     reads   writes
tcl::encoding::convertfrom              1       1       0
tcl::encoding::convertto                1       1       0
tcl::encoding::dirs                     0       objc<=1 0
tcl::encoding::names                    0       1       0       
tcl::encoding::system                   0       objc<=1 0

#THE [file] ENSEMBLE

#name                                   idem    kill    nre     reads   writes  notes
tcl::file::atime                        0       objc<=3 0
tcl::file::attributes                   0       objc<=4 0
tcl::file::channels                     0       1       0
tcl::file::copy                         0       0       1
tcl::file::delete                       0       0       0

tcl::file::dirname                      1       1       0
tcl::file::executable                   0       1       0
tcl::file::exists                       0       1       0
tcl::file::extension                    1       1       0
tcl::file::isdirectory                  0       1	0

tcl::file::isfile                       0       1       0
tcl::file::join                         1       1       0
tcl::file::link                         0       0       0
tcl::file::lstat                        0       0       0               objv[3]  <5>
tcl::file::mkdir                        0       0       0

tcl::file::mtime                        0       objc<=3 0
tcl::file::nativename                   0       1       0
tcl::file::normalize                    0       1       0
tcl::file::owned                        0       1       0
tcl::file::pathtype                     1       1       0

tcl::file::readable                     0       1       0
tcl::file::readlink                     0       1       0
tcl::file::rename                       0       0       0
tcl::file::rootname                     1       1       0
tcl::file::separator                    1       1       0

tcl::file::size                         0       1       0
tcl::file::split                        1       1       0
tcl::file::stat                         0       0       0               objv[3]  <5>
tcl::file::system                       0       1       0
tcl::file::tail                         1       1       0

tcl::file::tempfile                     0       0       0
tcl::file::type                         0       1       0
tcl::file::volumes                      0       1       0
tcl::file::writable                     0       1       0

# <5> For tcl::file::lstat and tcl::file::stat, objv[3] is an array, not a
#     scalar variable

#THE [info] ENSEMBLE

#name                                   idem    kill    nre     reads   writes  notes
tcl::info::args                         0       1       0
tcl::info::body                         0       1       0
tcl::info::cmdcount                     0       1       0
tcl::info::commands                     0       1       0
tcl::info::complete                     1       1       0

tcl::info::default                      0       0       0               objv[3]
tcl::info::errorstack                   0       1       0
tcl::info::frame                        0       1       0
tcl::info::functions                    0       1       0
tcl::info::globals                      0       1       0

tcl::info::hostname                     1       1       0
tcl::info::library                      1       1       0
tcl::info::loaded                       0       1       0
tcl::info::locals                       0       1       0       all
tcl::info::nameofexecutable             1       1       0

tcl::info::patchlevel                   1       1       0
tcl::info::procs                        0       1       0
tcl::info::script                       0       objc<=2 0
tcl::info::sharedlibextension           1       1       0
tcl::info::tclversion                   1       1       0

tcl::info::vars                         0       1       0       all

# tcl::info::vars and tcl::info::locals need only the variable names to
# be correct in the callframe. The variable values can be anything.


# THE [info class] SUBENSEMBLE

#name                                   idem    kill    nre     reads   writes  notes
oo::InfoClass::call                     0       1       0
oo::InfoClass::constructor              0       1       0
oo::InfoClass::definition               0       1       0
oo::InfoClass::destructor               0       1       0
oo::InfoClass::filters                  0       1       0

oo::InfoClass::forward                  0       1       0
oo::InfoClass::instances                0       1       0
oo::InfoClass::methods                  0       1       0
oo::InfoClass::methodtype               0       1       0
oo::InfoClass::mixins                   0       1       0

oo::InfoClass::subclasses               0       1       0
oo::InfoClass::superclasses             0       1       0
oo::InfoClass::variables                0       1       0


# The [info object] SUBENSEMBLE

#name                                   idem    kill    nre     reads   writes  notes
oo::InfoObject::call                    0       1       0
oo::InfoObject::definition              0       1       0
oo::InfoObject::filters                 0       1       0
oo::InfoObject::forward                 0       1       0
oo::InfoObject::isa                     0       1       0

oo::InfoObject::methods                 0       1       0
oo::InfoObject::methodtype              0       1       0
oo::InfoObject::mixins                  0       1       0
oo::InfoObject::variables               0       1       0
oo::InfoObject::vars                    0       1       0


# THE MATHFUNCS

#name                                   idem    kill    nre     reads   writes  notes
tcl::mathfunc::abs                      1       1       0
tcl::mathfunc::acos                     1       1       0
tcl::mathfunc::asin                     1       1       0
tcl::mathfunc::atan                     1       1       0
tcl::mathfunc::atan2                    1       1       0

tcl::mathfunc::bool                     1       1       0
tcl::mathfunc::ceil                     1       1       0
tcl::mathfunc::cos                      1       1       0
tcl::mathfunc::cosh                     1       1       0
tcl::mathfunc::double                   1       1       0

tcl::mathfunc::entier                   1       1       0
tcl::mathfunc::exp                      1       1       0
tcl::mathfunc::floor                    1       1       0
tcl::mathfunc::fmod                     1       1       0
tcl::mathfunc::hypot                    1       1       0

tcl::mathfunc::int                      1       1       0
tcl::mathfunc::isqrt                    1       1       0
tcl::mathfunc::log                      1       1       0
tcl::mathfunc::log10                    1       1       0
tcl::mathfunc::max                      1       1       0

tcl::mathfunc::min                      1       1       0
tcl::mathfunc::pow                      1       1       0
tcl::mathfunc::rand                     0       0       0
tcl::mathfunc::round                    1       1       0
tcl::mathfunc::srand                    0       0       0

tcl::mathfunc::sin                      1       1       0
tcl::mathfunc::sinh                     1       1       0
tcl::mathfunc::sqrt                     1       1       0
tcl::mathfunc::tan                      1       1       0
tcl::mathfunc::tanh                     1       1       0

tcl::mathfunc::wide                     1       1       0


# THE [string] ENSEMBLE

#name                                   idem    kill    nre     reads   writes  notes
tcl::string::bytelength                 1       1       0
tcl::string::equal                      1       1       0
tcl::string::first                      1       1       0
tcl::string::last                       1       1       0
tcl::string::repeat                     1       1       0

tcl::string::reverse                    1       1       0

		    "@debug-line" - "@debug-script" -
		    "dictIterStart" - "directAppend" - "directArrayAppend" -
		    "directArrayLappend" - "directArrayLappendList" -
		    "directArraySet" - "directArrayUnset" - "directExists" -
		    "directGet" - "directLappend" - "directLappendList" -
		    "directSet" - "directUnset" - "directIsArray" -
		    "directMakeArray" - "foreachStart" - "entry" -
		    "extractExists" - "extractFail" - "extractMaybe" -
		    "initArray" - "initException" -
		    "jump" - "jumpFalse" - "jumpMaybe" - "jumpTrue" -
		    "NRE.suspend" - "originCmd" -
		    "purify" - "resolveCmd" - "setReturnCode" -
		    "split" - "unshareList" {

			# do nothing - these insns are not killable
			# this case goes away once I have a better handle
			# on what's killable.
			# Note that the "direct..." operations are probably
			# never killable due to the potential for global
			# effects (because of traces).
			lset bbcontent $b [incr newpc] $q

#
# Parameters:
#	b - Basic block
#	pc - Program counter within the basic block
#
# Results:
#	Returns a list comprising the source file,
#	the line number, the active script fragment, and
#	the current context.

oo::define quadcode::transformer method sourceInfo {b pc} {

    while {![info exists debugLines]
	   || ![info exists debugScript]
	   || ![info exists debugContext]} {
	if {[incr pc -1] >= 0} {

	set blockMap [lrepeat [llength $bbcontent] -123456]
	set newBlocks {}
	set changed 0

	# Number the blocks depth-first. Blocks that precede the entry are
	# unreachable.
	set prevb -1
	set neworder [my bborder]
	my debug-deadbb {
	    puts "New basic block order: $neworder"
	}
	set pb -1
	foreach b $neworder {
	    if {$b < $pb} {
		set changed 1
	    } else {
		set pb $b
	    }
	    if {$b > 0 && !$seenEntry} {
		# block b is unreachable and will be deleted. It is no longer
		# the predecessor of any other block. Removing the link allows
		# for more aggressive coalescence of the remaining blocks.
		foreach s [my bbsucc $b] {
		    my removePred $s $b
		}

		    set src [lindex $q 2]
		    if {[lindex $src 0] in {"temp" "var"}} {
			dict set uses $src $b 1
		    }
		}

		"return" - "NRE.return" {

		    # Record that the return value is live on exit from
		    # the block that returns
		    
		    foreach src [lrange $q 2 end] {
			if {[lindex $src 0] in {"temp" "var"}} {
			    dict set uses $src $b 1

# nre.tcl --
#
#	Code to check, locally, whether a particular quadcode sequence
#	does anything locally to require non-recursive evaluation (NRE).
#
# Copyright (c) 2018 by Kevin B. Kenny
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
#------------------------------------------------------------------------------

# quadcode::transformer method needsNRE --
#
#	Computes whether a given quadcode sequence requires
#	non-recursive evaluation.
#
# Results:
#	Returns 1 if NRE is required, 0 otherwise.
#
# NRE is needed if the sequence invokes any command that requires NRE,
# or if it does anything that might switch coroutine, or if it tailcalls
# or evaluates uncontrolled code.

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

    # If the answer is already known, just return it

    if {[info exists nre]} {
	return $nre
    }

    # Walk the quads to determine whether NRE is needed.

    set b -1
    foreach bb $bbcontent {
	incr b
	set pc -1
	foreach q $bb {
	    incr pc
	    switch -exact [lindex $q 0] {
		"invoke" - "invokeExpanded" {

		    # If we're invoking an unknown callee, we have to be NRE

		    set callee [lindex $q 3]
		    if {[lindex $callee 0] ne "literal"} {
			return [set nre 1]
		    }

		    # Find the argument types for this invoke

		    set alist [lrange $q 4 end]
		    set atypes [lmap a $alist {
			::quadcode::typeOfOperand $types $a
		    }]

		    if {[$specializer needsNRE $q $atypes]} {
			return [set nre 1]
		    }
		}
	    }
	}
    }
    return [set nre 0]
}

# quadcode::transformer method promoteNREOperations --
#
#	Promote 'entry', 'return' and 'invoke' operations that refer to
#	procedures that need non-recursive eval.
#
# Results:
#	None.
#
# Side effects:
#	'entry' is replaced with 'entryNRE'. 'return' is replaced with
#	'returnNRE'. 'invoke' is more complex. It causes the basic block
#	to be split with an unconditional jump immediately following the
#	'invoke', and the 'invoke' to be replaced with 'invokeNRE'.

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

    namespace upvar ::quadcode::dataType \
        COROHANDLE COROHANDLE CALLFRAME CALLFRAME

    my debug-nre {
	puts "Before NRE promotion: "
	my dump-bb
    }

    set bbcount [llength $bbcontent]
    for {set bbno 0} {$bbno < $bbcount} {incr bbno} {
	my debug-nre {
	    puts "Basic block $bbno"
	}
	set b $bbno
	lassign [my bbUnlinkTail $b 0] - bb
	set newbb {}
	
	set pc -1
	foreach q $bb {
	    incr pcq

            lassign $q opcode
	    switch -exact -- $opcode {

		"entry" {
		    if {[my needsNRE]} {
			lset q 0 "NRE.entry"
		    }
		    my debug-nre {
			puts "$b:[llength $newbb]: $q"
		    }
		    my bbEmitAndTrack $b newbb $q
		}

		"return" {
		    if {[my needsNRE]} {
			lset q 0 "NRE.return"
		    }
		    my debug-nre {
			puts "$b:[llength $newbb]: $q"
		    }
		    my bbEmitAndTrack $b newbb $q
		}

		"invoke" - "invokeExpanded" {

		    set args [lassign $q opcode result cfin command]
		    if {[lindex $command 0] ne "literal"} {
			set usenre 1
		    } else {
			set atypes [lmap a $args {
			    typeOfOperand $types $a
			}]
			set usenre [$specializer nreRequired $q $atypes]
		    }

		    if {$usenre} {
			set resultv [lindex $q 1]
                        set inty [typeOfOperand $types $cfin]
			lset q 0 [list NRE.$opcode [dict get $types $resultv]]
			set coroHandle [my newVarInstance $resultv]
			lset q 1 $coroHandle
			dict set types $coroHandle \
			    [expr {$COROHANDLE | ($inty & $CALLFRAME)}]
			my debug-nre {
			    puts "$b:[llength $newbb]: $q"
			}
			my bbEmitAndTrack $b newbb $q
			set continuation [my bbCreate]
			my debug-nre {
			    puts "$b:[llength $newbb]: \
                                  [list NRE.suspend [list bb $continuation] \
				  $coroHandle]"
			}
			my bbEmitAndTrack $b newbb \
			    [list "NRE.suspend" [list bb $continuation] \
				$coroHandle]
			lset bbcontent $b $newbb
			set newbb {}
			set b $continuation
			lset q 0 "NRE.returnFromInvoke"
			lset q 1 $resultv
			lset q 2 $coroHandle
		    }
                    my debug-nre {
                        puts "$b:[llength $newbb]: $q"
                    }
                    my bbEmitAndTrack $b newbb $q
		}

		default {
		    my debug-nre {
			if {$b != $bbno} {
			    puts "$b:[llength $newbb]: $q"
			}
		    }
		    my bbEmitAndTrack $b newbb $q

		}
	    }
	}

	lset bbcontent $b $newbb
    }

    my bbidom
    my bblevel

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

#
# Results:
#	Writes an edited version of 'builtins.tcl.in' to the file,
#	'builtins.tcl', substituting %DICT% with the dictionary.

proc main {} {

    set keys {idem kill nre reads writes notes}
    set haveAttr {}

    set f [open builtins.txt r]
    set data [split [read $f] \n]
    close $f

    foreach line $data {

		lappend att special {}
	    }
	    default {
		error "what does idem [dict get $attrs idem] mean?"
	    }
	}
	if {![dict exists $att special]} {
	    switch -exact -- [dict get $attrs nre] {
		0 - {} {
		}
		1 {
		    lappend att nre {}
		}
		default {
		    error "what does nre [dict get $attrs nre] mean?"
		}
	    }
	    switch -regexp -matchvar m -- [dict get $attrs kill] {
		0 {
		}
		1 {
		    lappend att killable Inf
		}
		{objc<=(\d+)} {

    #	         processed further.
    #   frameEffect - Dictionary whose keys are instance names and whose
    #	              values are dictionaries describing the procedure
    #		      instances' effect on the caller's callframe.
    #   instanceBeingAnalyzed - Holds the instance name of the current procedure
    #	                        during a call to type analysis in the quadcode
    #		                database.
    #	nreActive - Dictionary whose keys are instance names of procedures
    #	            being analyzed for NRE requirement, and whose values
    #	            are immaterial. A procedure is present if it is currently
    #	            being analyzed; this flag is used to check whether the
    #	            procedure is recursive.
    #	nreRequired - Dictonary whose types are instance names of procedures
    #	              and whose values are immaterial. If an instance is present
    #	              in 'nreRequired', then NRE code generation must be
    #                 performed for it.
    #   onWorklist - Dictionary whose keys are the instance names of the
    #	             procedures on the worklist for analysis and whose values
    #	             are their positions in the heap.
    #   precedence - Dictionary whose keys are fully qualified procedure names
    #	             (without types) and whose values are the positions of
    #	             those procedures in depth-first numbering and hence
    #		     the order in which they should be analyzed.
    #   requiredInstances - Two level dictionary. The first level keys are
    #		            fully qualified procedure names (without types)
    #	                    and the second level keys are lists of types.
    #			    The values are immaterial. This dictionary tracks
    #                       procedure instances explicity requested by an
    #	                    external caller
    #   returnType - Dictionary whose keys are instance names and whose values
    #	             are the return types of those procedure instances.
    #	typeInf - Dictionary whose keys are instance names and whose values
    #	          are quadcode databases for the instances

    variable canInline cmdAttr database dependencies dependents \
	diagnostics diagnosticSeq failed frameEffect nreActive \
	nreRequired \
	instanceBeingAnalyzed onWorklist precedence requiredInstances \
	returnType typeInf

    # Local commands:
    #   worklist - List of procedures awaiting type analysis. This list is
    #	           organized as a binary heap in order by precedence of the
    #	           procedure, and within that, in lexicographic order by

#
# Side effects:
#	The procedure's name is resolve in the caller's scope to a fully
#	qualified name. The procedure is converted to quadcode and its
#	quadcode database is added to the 'database' dictionary.

oo::define quadcode::specializer method register {procName} {

    my debug-specializer {
	puts "REGISTER: procName"
    }

    # Fully qualify the procedure names and resolve imports.
    set realProc [uplevel 1 [list namespace which $procName]]

    if {$realProc eq {}} {
	puts stderr "Skipping $procName because the compiler can't resolve\
                     its name."

# Results:
#	None.
#
# Side effects:
#	Procedure instance is added to 'requiredInstances'.

oo::define quadcode::specializer method require {procName argTypes} {

    my debug-specializer {
	puts "REQUIRE: $procName ([lmap t $argTypes {nameOfType $t}])"
    }

    # Resolve the procedure name and handle namespace imports
    set realProc [uplevel 1 [list namespace which $procName]]
    set origin [uplevel 1 [list namespace origin $realProc]]

    # Add the procedure instance to the set of requred instances.
    dict set requiredInstances $origin $argTypes {}

		    if {[$inf expandInlines]} {
			my AddToWorklist 0 {*}$inst
		    }
		}
	    }
	}
    }

    # Once all the procedures are fully typed, there's a final pass needed
    # to determine which ones can be called directly, and which ones must
    # be NRE.

    my debug-specializer {
	puts "Analyze NRE requirements"
    }
    my calcNRERequired
}

# quadcode::specializer method searchForInlines --
#
#	Try to find opportunities to inline procedure instances into their
#	callers.
#

    }
	
    my debug-inline {
	puts "Can $inst be inlined? [dict get $canInline $inst]"
    }
    return [dict get $canInline $inst]
}

# quadcode::specializer calcNRERequired --
#
#	Determines which procedure instances in the call graph require
#	non-recursive evaluation.
#
# Results:
#	None.
#
# Side effects:
#	Calls the translator instance to set the 'NRE' flag on any procedure
#	requiring non-recursive evaluation
#
# A procedure requires NRE for any of the following reasons:
#
#	1. It does anything that might change the active coroutine.
#	2. It invokes unknown, non-compiled commands.
#	3. It invokes any Core command that requires NRE.
#	4. It is directly or indirectly recursive.
#	5. It invokes, directly or indirectly, any other command that
#	   might require NRE.
#
# We perform a depth-first traversal of the call graph to analyze NRE.
# This is done with the help of the quadcode::transformer object. We call
# the transformer's 'needsNRE' method for each required instance, and it
# calls back to the specializer's 'needsNRE' method for each invoked command.

oo::define quadcode::specializer method calcNRERequired {} {

    set nreActive {}
    set nreRequired {}

    dict for {instance db} $typeInf {
	my debug-specializer {
	    puts "NRE: $instance"
	}
	dict set nreActive $instance {}
	set needs [$db needsNRE]
	my debug-specializer {
	    puts [format {NRE: %s %s NRE} $instance \
		      [expr {$needs ? "needs" : "does not need"}]]
	}
	if {$needs} {
	    dict set nreRequired $instance {}
	}
	dict unset nreActive $instance

    }
}

# quadcode::specializer method needsNRE --
#
#	Tests whether an individual procedure instance requires NRE.
#
# Parameters:
#	name - Name of the command to analyze
#	alist - List of quadcode values for the command's arguments
#	atypes - List of typecodes of the types of the arguments.
#
# Results:
#	Returns 1 if the command needs NRE, 0 otherwise.

oo::define quadcode::specializer method needsNRE {q atypes} {

    set name [lindex $q 3 1]
    my debug-specializer {
	puts [format "%*s  Does %s(%s) need NRE?" [dict size $nreActive] {} \
		  $name $atypes]
    }
    set instance [list $name $atypes]
    if {[dict exists $nreActive $instance]} {
	my debug-specializer {
	    puts [format "%*s  %s needs NRE, it is recursive" \
		      [dict size $nreActive] {} $instance]
	}
	dict set nreRequired $instance {}
	return 1;		# The procedure is recursive.
    }
    
    if {[dict exists $typeInf $instance]} {
	# The instance is a compiled command that we have not
	# visited. Find out whether it needs NRE
	set db [dict get $typeInf $instance]
	dict set nreActive $instance {}
	set result [$db needsNRE]
	dict unset nreActive $instance
	my debug-specializer {
	    puts [format "%*s  %s %s NRE. Translator says so." \
		      [dict size $nreActive] {} \
		      $instance \
		      [expr {$result ? "needs" : "does not need"}]]
	}
	if {$result} {
	    dict set nreRequired $instance {}
	}
	return $result
    }

    # The instance is not a compiled command. It may be a builtin.

    tailcall my nonCompiledNeedsNRE $q $atypes
}

# quadcode::specializer method nonCompiledNeedsNRE --
#
#	Tests whether a non-compiled command invocation needs non-recursive
#	eval.
#
# Parameters:
#	q - Quadcode instruction that invokes a non-compiled command
#	argTypes - List of types of the arguments of the command
#
# Results:
#	Returns 1 if NRE must be used, 0 otherwise

oo::define quadcode::specializer method nonCompiledNeedsNRE {q argTypes} {

    if {[lindex $q 3 0] ne "literal"} {
	return 1;		# Unknown command invocation is always NRE
    }
    set name [lindex $q 3 1]
    set instance [list $name $argTypes]
    my debug-specializer {
	puts "Does $name ([lmap x $argTypes {nameOfType $x}]) need NRE?"
    }
    if {[dict exists $cmdAttr $name]} {
	set attrs [dict get $cmdAttr $name]
	if {[dict exists $attrs special]} {
	    set method frameEffect_[string map {:: __} $name]
	    set attrs [my $method $q]
	}
	if {! [dict exists $attrs nre]} {
	    my debug-specializer {
		puts [format "%*s  %s does not need NRE,\
                              it's a simple builtin" \
			  [dict size $nreActive] {} $instance]
	    }
	    return 0
	}
    }

    # We don't know what the instance is, so require NRE

    my debug-specializer {
	puts [format "%*s  %s needs NRE, it is not compiled, \
                      and not asserted to be safe." \
		  [dict size $nreActive] {} $instance]
    }
    return 1
}

# quadcode::specializer method nreRequired --
#
#	Tests whether a procedure must be processed with non-recursive
#	evaluation.
#
# Parameters:
#	procName - Name of the procedure being examined
#	argTypes - List of argument types
#
# Preconditions:
#	calcNRERequired must already have run
#
# Results:
#	Returns 1 if the procedure needs non-recursive eval, 0 otherwise

oo::define quadcode::specializer method nreRequired {q argTypes} {
    if {[lindex $q 3 0] ne "literal"} {
	return 1;		# Invocation of unknown command
    }
    set procName [lindex $q 3 1]
    set inst [list $procName $argTypes]
    if {![dict exists $typeInf $inst]} {
	my debug-specializer {
	    puts "$inst is not compiled; need to test its NRE requirement"
	}
	tailcall my nonCompiledNeedsNRE $q $argTypes
    } else {
	my debug-specializer {
	    puts "Test NRE requirement for $inst : [dict exists $nreRequired $inst]"
	}
	tailcall dict exists $nreRequired $inst
    }
}

# quadcode::specializer method frameEffect --
#
#	Looks up what the effect of a command is on the callframe.
#
# Parameters:
#	q - Quadcode instruction that invokes the command

# Side effects:
#	The message is added to the diagnostics to be reported.
#	If the severity is 'fatal', the procedure is marked 'failed'
#	and further attempts to compile it are abandoned. If the
#	severity is 'error' or 'fatal', it will not be included
#	when 'instancesNeeded' gets the list of procedures to compile.

oo::define quadcode::specializer method diagnostic {ctx argTypes
						    file line script
						    severity message args} {

    namespace upvar ::quadcode severities severities

    if {[dict exists $severities $severity]} {
	set severity [dict get $severities $severity]
    }
    if {![string is integer $severity]} {
	error "Unknown severity: $severity"
    }
    if {$severity <= 1} {
	if {[lindex $ctx 0] eq "proc"} {
	    set pname [lindex $ctx 1]
	    dict set failed $pname $argTypes $severity
	}
    }

    if {[string length $script] > 50} {
	set script [string range $script 0 46]...
    }

    set tuple [list $file $line $script $severity $ctx $message $args]
    if {![dict exists $diagnostics $tuple]} {
	dict set diagnostics $tuple [incr diagnosticSeq]
    }

}

# quadcode::specializer method printDiagnostics --

oo::define quadcode::specializer method printDiagnostics {ch} {

    namespace upvar ::quadcode severities severities

    set messages {}
    dict for {tuple seq} $diagnostics {
	lassign $tuple file line script severity ctx message arglist
	lappend messages $file $line $seq $script $severity \
	    $ctx $message $arglist
    }

    set messages [lsort -stride 8 -index 2 -integer $messages]
    set messages [lsort -stride 8 -index 1 -integer $messages]
    set messages [lsort -stride 8 -index 0 $messages]

    set lastScript {}
    set lastCtx {}
    foreach {file line seq script severity ctx message arglist} $messages {
	if {$ctx ne $lastCtx} {
	    # TODO - l10n would need to go here!
	    puts $ch "In $ctx:"
	    set lastCtx $ctx
	}
	if {$script ne $lastScript} {
	    # TODO - l10n would need to go here!
	    puts $ch "$file:$line: note: in script \"$script\""

    set todo {}
    dict for {proc d} $failed {
	dict for {arglist -} $d {
	    lappend todo [list $proc $arglist]
	}
    }

    while {[llength $todo] > 0} {
	set instance [lindex $todo end]
	set todo [lrange $todo 0 end-1]
	lassign $instance procn argl
	set fullname $procn\([lmap x $argl {nameOfType $x}]\)

	if {[dict exists $dependents $instance]} {
	    dict for {dep -} [dict get $dependents $instance] {
		lassign $dep dprocn dargl
		if {![dict exists $failed $dprocn $dargl]} {
		    dict set failed $dprocn $dargl 0
		    lappend todo $dep
		}
	    }
	}
    }

    # Set a work list to the empty set, and empty a dictionary whose
    # keys will be the needed instances.

    set todo {}
    set examined {}

    # Begin by adding explicitly required procedure instances to the work list
    # and setting them as needed.

    dict for {proc d} $requiredInstances {
	dict for {arglist -} $d {
	    if {![dict exists $failed $proc $arglist]} {
		lappend todo [list $proc $arglist]
		dict set examined [list $proc $arglist] {}
	    }
	}

# transformer.tcl --
#
#	Common base for quadcode-transforming logic.
#
# Copyright (c) 2015, 2016, 2017 by Kevin B. Kenny
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
#------------------------------------------------------------------------------

if {[info exists quadcode::sourced]} { return }

namespace eval ::quadcode {

    variable sourced 1

    variable libdir [file dirname [info script]]

    namespace export \
	builtinCommandType \
	nameOfType \
	typeOfLiteral \
	typeOfOperand

    #			3 - the variable has been analyzed, and might or
    #			    might not exist depending on code path.
    #
    #				TYPE INFERENCE
    #
    #	types - Dictionary whose keys are variable names and whose values
    #		are the numeric codes for the variable types.
    #
    #	nre - Flag that is 1 if this procedure requires non-recursive
    #	      evaluation, and 0 otherwise

    variable bytecode quadindex fixup
    variable debugged specializer originProc sourcefile ns
    variable quads vars links bbstart
    variable bbcontent bbpred
    variable bbidom bbkids bblevel bbnlevels varcount
    variable duchain udchain
    variable varExists
    variable types
    variable nre
    variable ptype ns_counters

    # Constructor -
    #
    # Keyword arguments (following the positional arguments):
    #	-debug {list}
    #		Accepts a list of keys. For each key in the list, a

    #	version.
    #
    # Results:
    #	Returns a four-element list: return type, list of parameter types,
    #	list of variable types, list of quadcode instructions.

    method getFlattenedQuads {} {

	# Promote entry to, return from, and invocation of procedures
	# and commands that require non-recursive evaluation.
	my promoteNREOperations

	# Promoting NRE operations will have put basic blocks out of
	# topologic order, so fix that.
	my deadbb

	# Make sure basic block begin with debug info

	my propDebugInfo

	# Insert instructions to widen types at phis.
	my widen

#	b, pc - Basic block and program counter
#	message - Message to print
#	args - Arguments to subsitute into the message

oo::define quadcode::transformer method diagnostic {severity b pc
						    message args} {
    lassign [my sourceInfo $b $pc] file lines script ctx

    $specializer diagnostic $ctx $ptype $file [lindex $lines 0] $script \
	$severity $message {*}$args
}

# quadcode::transformer method audit-phis --
#
#	Audit the quadcode to make sure that no phi follows a non-phi

source [file join $quadcode::libdir flatten.tcl]
source [file join $quadcode::libdir fqcmd.tcl]
source [file join $quadcode::libdir inline.tcl]
source [file join $quadcode::libdir invoke.tcl]
source [file join $quadcode::libdir liveranges.tcl]
source [file join $quadcode::libdir narrow.tcl]
source [file join $quadcode::libdir nodesplit.tcl]
source [file join $quadcode::libdir nre.tcl]
source [file join $quadcode::libdir renameTemps.tcl]
source [file join $quadcode::libdir ssa.tcl]
source [file join $quadcode::libdir translate.tcl]
source [file join $quadcode::libdir typecheck.tcl]
source [file join $quadcode::libdir types.tcl]
source [file join $quadcode::libdir upvar.tcl]
source [file join $quadcode::libdir utils.tcl]
source [file join $quadcode::libdir varargs.tcl]
source [file join $quadcode::libdir widen.tcl]

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

    variable DICTITER		[expr 0x20000]

    # ARRAY - the value is an array and not an actual value, a failure or a
    #	      missing value.  This type is always pure as it has no string
    #	      representation; there are no constants of this type.

    variable ARRAY		[expr 0x40000]

    # COROHANDLE - the value is the handle returned from an LLVM coroutine
    #              operation

    variable COROHANDLE		[expr 0x1000000]

    # EXPANDED - the value must go through argument expansion in
    #            'invokeExpanded'

    variable EXPANDED           [expr 0x2000000]

    # OTHERSTRING - the value is a string that is none of the above.

    variable NEXIST             [expr 0x40000000]

    # STRING - the value is an actual value, not a failure nor a missing value
    #               This type is always impure, and its internal representation
    #               may be void because the string representation is the
    #               only representation.

    variable STRING		[expr {~($CALLFRAME | $FAIL | $NEXIST
					 | $DICTITER | $FOREACH | $EXPANDED
					 | $ARRAY | $COROHANDLE)}]

    # TOP - means no information. We do not know whether a value exists;
    #       we do not know its type; we do not know whether it resulted from
    #       an error in a computation. Also should not happen except possibly
    #       as an initial value in an iterative calculation of types.

    variable TOP		-1

    set result {}

    foreach {name wname} {
	CALLFRAME		CALLFRAME
	NEXIST			NEXIST
	FAIL			FAIL
	COROHANDLE		COROHANDLE
	ARRAY			ARRAY
	DICTITER		DICTITER
	FOREACH			FOREACH
	EXPANDED		EXPANDED
	OTHERSTRING		STRING
	IMPURE			IMPURE
	EMPTY			EMPTY

oo::define quadcode::transformer method typeOfResult {q} {
    namespace upvar ::quadcode::dataType {*}{
	DOUBLE DOUBLE INT INT STRING STRING FAIL FAIL EMPTY EMPTY
	ZEROONE ZEROONE
	BOOL_INT BOOL BOOLWORD BOOLWORD
	ENTIER ENTIER NUMERIC NUMERIC IMPURE IMPURE
	VOID VOID CALLFRAME CALLFRAME DICTITER DICTITER FOREACH FOREACH
	ARRAY ARRAY NEXIST NEXIST EXPANDED EXPANDED COROHANDLE COROHANDLE
    }

    switch -exact -- [lindex $q 0 0] {
	debug-value {
	    return [typeOfOperand $types [lindex $q 3]]
	}
	widenTo {

		return $t1
	    }
	    return [expr {$EXPANDED | $t1}]
	}
	verifyList {
	    return [expr {$FAIL | [typeOfOperand $types [lindex $q 2]]}]
	}
	"invoke" - "NRE.returnFromInvoke" {
	    # We know the result type of a handful of the things
	    # that might be invoked
	    if {[lindex $q 3 0] eq "literal"} {
		set rtype [my typeOfInvoke [lindex $q 3 1] [lrange $q 4 end]]
	    } else {
		set rtype [expr {$FAIL | $STRING}]
	    }
	    set inty [typeOfOperand $types [lindex $q 2]]
	    return [expr {($inty & $CALLFRAME) | $rtype}]
	}
	"NRE.invoke" {
	    set inty [typeOfOperand $types [lindex $q 2]]
	    return [expr {$COROHANDLE | ($inty & $CALLFRAME)}]
	}
	invokeExpanded {
	    # We can eliminate callframe in a smaller set of cases than
	    # with 'invoke' - but punt for now.
	    set inty [typeOfOperand $types [lindex $q 2]]
	    return [expr {($inty & $CALLFRAME) | $FAIL | $STRING}]
	}
	callFrameNop - startCatch {

		    foreach {localVar source} [lrange $q 3 end] {
			if {[lindex $localVar 0] ne "literal"} {
			    my diagnostic error $b $pc \
				"double dereference is not implemented"
			    set localVar [list literal \ufffderror]
			}
			set localVarName [lindex $localVar 1]
			if {![dict exists $resFrame $localVarName]
			    && ($source ne "Nothing")} {
			    dict set resFrame $localVarName local
			}
		    }

		}
		nsupvar - variable {

# utils.tcl --
#
#	Code that supports various quadcode transformations and is
#	shared among multiple different transformations.
#
# Copyright (c) 2018 by Kevin B. Kenny
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
#------------------------------------------------------------------------------

# quadcode::transformer method bbUnlinkTail --
#
#	Unlinks all the quadruples from a given instruction through
#	the end of its basic block from du- and ud-chains, and basic
#	block predecessor and successor relations.
#
# Parameters:
#	b - Number of the basic block
#	pc - Program counter of the first instruction being deleted
#	bb - Content of the basic block being edited, or {} if the
#	     content should be retrieved from 'bbcontent'
#
# Results:
#	Returns a two-element list comprising the head and tail of
#	the split block.
#
# Side effects:
#	Linkages are destroyed.
#
# This call is used when carrying out a transformation that will involve
# splitting one basic block into two or more. The 'pc' argument will be the
# point after the last instruction in the basic block that will be preserved
# unchanged, and the remaining instructions will be isolated and returned
# as a list. Presumably they, or functional equivalents, will be inserted
# elsewhere in the program.

oo::define quadcode::transformer method bbUnlinkTail {b pc {bb {}}} {

    # Get the basic block content, and split it into head (preserved)
    # and tail (unlinked and returned).

    if {[llength $bb] == 0} {
	set bb [lindex $bbcontent $b]
    }

    set head [lrange $bb 0 [expr {$pc-1}]]
    set tail [lrange $bb $pc end]

    # Unlink the operands of quads in the tail from ud- and du-chains, one
    # by one.

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


    # Unlink the block from its successors
    
    foreach b2 [my bbsucc $b] {
        my removePred $b2 $b
    }
    
    # Store the head of the block that remains, back into bbcontent

    lset bbcontent $b $head

    return [list $head $tail]
}

# quadcode::transformer method bbEmitAndTrack --
#
#	Emits a quadcode instruction to a basic block under construction
#	and tracks its effects
#
# Parameters:
#	b - Basic block number
#	bbVar - Variable containing the content of the basic block under
#		construction.
#	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.
#
# This call is intended for use of transformations that perform extensive
# rewriting on quadcode, possibly giving rise to new basic blocks. It
# allows all the bookkeeping of ud- and du-chains, and of basic block
# predecessor and successor, to be maintained in one place.

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

    upvar 1 $bbVar bb

    set res [lindex $q 1]
    switch -exact -- [lindex $res 0] {
        "bb" {
            my bblink $b [lindex $res 1]
        }
        "temp" - "var" {
            dict set udchain $res $b
        }
    }

    foreach arg [lrange $q 2 end] {
        switch -exact -- [lindex $arg 0] {
            "temp" - "var" {
                my addUse $arg $b
            }
        }
    }

    puts "--> $b:[llength $bb]: $q"

    lappend bb $q

    return
}

# quadcode::transformer method bbCreate --
#
#	Creates a new basic block when rewriting a code sequence.
#
# Parameters:
#	None
#
# Results:
#	Returns the index of the new basic block, which will be empty
#	and have no predecessors.

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

    set b [llength $bbcontent]

    lappend bbcontent {}
    lappend bbpred {}

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

    $call analyze [self] $b $pc

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

    lassign [my bbUnlinkTail $b [$call pc0]] bb

    # Create the basic blocks for the actual invocation sequences. We make
    # them in advance to avoid backpatching.
    # Blocks 'err0b', 'norm0b', 'err1b' and 'norm1b' will be empty and are
    # present in order to split critical edges.

    set norm0b [my bbCreate]

    set err0b [my bbCreate]

    set notokb [my bbCreate]

    set norm1b [my bbCreate]

    set err1b [my bbCreate]



    set normb [my bbCreate]
    set errorb [my bbCreate]

    set errorphis {}

    # Create the first part of the 'invoke' instruction
    set invokeres [my newVarInstance $cfin]
    set newq [list invoke $invokeres $cfin $calleeLit]

    # Generate code for the 'wrong # args' case
    set notokbb {}
    set invexpres [my newVarInstance [$call retval]]
    foreach qq [my varargsEmitWrongArgs $invexpres {} Nothing $calleeLit] {
        my bbEmitAndTrack $notokb notokbb $qq
    }
    dict set normphis [$call retval] [list bb $norm1b] $invexpres
    dict set errorphis [$call retval] [list bb $err1b] $invexpres
    dict set normphis [$call cfout] [list bb $norm1b] [$call cfin]
    dict set errorphis [$call cfout] [list bb $err1b] [$call cfin]
    my bbEmitAndTrack $notokb notokbb \
        [list jumpMaybe [list bb $err1b] $invexpres]
    my bbEmitAndTrack $notokb notokbb [list jump [list bb $norm1b]]
    lset bbcontent $notokb $notokbb

    # Split the critical edges
    foreach {edge target} [list $norm0b $normb $err0b $errorb \
                               $norm1b $normb $err1b $errorb] {
        set splitbb {}
        my bbEmitAndTrack $edge splitbb [list jump [list bb $target]]
        lset bbcontent $edge $splitbb
    }

    # Now start the parameter checking logic

    set nPlainParams [llength $arginfo]
    set haveargs 0

    set listLoc [my varargsExpandFixed 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 bbEmitAndTrack $b bb [list listLength $lenLoc1 $listLoc]
    my bbEmitAndTrack $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

    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 [my bbCreate]


        set i $firstOptional
        while {$i < $nPlainParams} {
            info default $callee [lindex $arginfo $i] defaultVal
            lassign [my varargsUnpackOptional tempIndex b bb \
                         $finishB $compTemp $listLoc $lenLoc $j] \
                fromBlock argLoc
            lappend optInfo [list $fromBlock $defaultVal $argLoc]

    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 bbEmitAndTrack $b bb $q2
        set cfin $cf2
        lset newq 2 $cfin
    }
    
    # 2. Emit the call as rewritten
    my bbEmitAndTrack $b bb $newq

    # 3. Make the 'retrieveResult'
    set okresult [my newVarInstance [$call retval]]
    my bbEmitAndTrack $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 bbEmitAndTrack $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 bbEmitAndTrack $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 bbEmitAndTrack $b bb [list jumpMaybe [list bb $err0b] $okresult]
    my bbEmitAndTrack $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 bbEmitAndTrack $normb normbb [list phi $v {*}$sources]
    }
    my bbEmitAndTrack $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 bbEmitAndTrack $errorb errorbb [list phi $v {*}$sources]
    }
    my bbEmitAndTrack $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
    }
    
    return
}








































# quadcode::transformer method varargsNonExpandedArgument --
#
#	Transfer a leading non-expanded argument into a quad
#	under construction when rewriting 'invokeExpanded'
#
# Parameters:

        if {4 + $pos >= [llength $q]} {
            set listLoc "literal {}"
        } else {
            set arg [lindex $q [expr {4 + $pos}]]
            switch -exact -- [lindex $arg 0] {
                "literal" {
                    set listLoc [my newVarInstance $listTemp]
                    my bbEmitAndTrack $b bb [list list $listLoc $arg]
                }
                "temp" - "var" {
                    lassign [my findDef $arg] defb defpc defstmt
                    if {[lindex $defstmt 0] eq "expand"} {
                        set listLoc [lindex $defstmt 2]
                    } else {
                        set listLoc [my newVarInstance $listTemp]
                        my bbEmitAndTrack $b bb [list list $listLoc $arg]
                    }
                }
            }
        }

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

                }
            }

            # Make variable to hold Maybe result from the concatenation,
            # and emit the concatenation.
            # This can't fail, $listTemp is known to be a list
            set nloc [my newVarInstance $listTemp]
            my bbEmitAndTrack $b bb [list $op $nloc $listLoc $arg]

            # extract the result from the Maybe
            set listLoc [my newVarInstance $listTemp]
            my bbEmitAndTrack $b bb [list extractMaybe $listLoc $nloc]
        }

        return $listLoc
    }

# quadcode::transformer method varargsCheckEnough --
#

# Results:
#	Returns the new basic block number; this method ends the block.

oo::define quadcode::transformer method varargsCheckEnough {b bb lenLoc compTemp
                                                            nMandatory errorB} {
    # Emit {$nMandatory > $lenLoc}
    set compLoc [my newVarInstance $compTemp]
    my bbEmitAndTrack $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 [my bbCreate]


    set newb [my bbCreate]



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

    lset bbcontent $b $bb
    set bb {}

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

    return $newb
}

# quadcode::transformer method varargsUnpackMandatory --

    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 bbEmitAndTrack $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 bbEmitAndTrack $b bb [list extractMaybe $argLoc2 $argLoc]

        # Put the extracted arg on the 'invoke' instruction
        lappend newq $argLoc2
    }
}

# quadcode::transformer method varargsUnpackOptional --

    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 bbEmitAndTrack $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 [my bbCreate]


    my bbEmitAndTrack $b bb [list jumpTrue [list bb $intb] $compLoc]

    # Create the next block and jump to it
    set newb [my bbCreate]


    my bbEmitAndTrack $b bb [list jump [list bb $newb]]
    lset bbcontent $b $bb

    # Make the intermediate block
    set b $intb
    set bb {}
    my bbEmitAndTrack $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 bbEmitAndTrack $b bb [list listIndex $argLoc1 $listLoc $pos]

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

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

}

# quadcode::transformer method varargsFinishOptional --

                                                               newqVar finishB
                                                               optInfo} {

    upvar 1 $bVar b $bbVar bb $newqVar newq

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

    my bbEmitAndTrack $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 bbEmitAndTrack $b bb $q
        lappend newq $newTemp
    }
}

# quadcode::transformer method varargsDoArgs --
#
#	Emits code to extract the parameter sequence needed to fill '$args'

    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 bbEmitAndTrack $b bb [list listRange $argsLoc1 $listLoc \
                                   [list literal $i] [list literal end]]
        set argsLoc2 [my newVarInstance $argsTemp]
        my bbEmitAndTrack $b bb [list extractMaybe $argsLoc2 $argsLoc1]
        lappend newq $argsLoc2
    }
}

# quadcode::transformer method varargsCheckTooMany --
#
#	Emits a codeburst to check whether an 'invokeExpanded' has

                                                             compTemp i
                                                             errorB} {

    upvar 1 $bVar b $bbVar bb


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

    set intb [my bbCreate]


    my bbEmitAndTrack $b bb [list jumpTrue [list bb $intb] $compLoc]

    set newb [my bbCreate]


    my bbEmitAndTrack $b bb [list jump [list bb $newb]]
    lset bbcontent $b $bb

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

    set b $newb
    set bb {}

}


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

}

# quadcode::transformer method bbEmitAndTrack --
#
#	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 bbEmitAndTrack {b bbVar q} {

    upvar 1 $bbVar bb

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

	}

	# Also widen the operand of any 'return' instruction

	# Make sure we have the current content of the basic block
	set content [lindex $bbcontent $b]
	set q [lindex $content end]
	if {[lindex $q 0] in {"return" "NRE.return"}} {

	    set source [lindex $q 3]
	    set desttype [dict get $types "return"]
	    if {[typeOfOperand $types $source] != $desttype} {

		# The return value needs to be widened
		set newvar [my newVarInstance {temp 0}]
		lset bbcontent $b {}
		set content \
		    [lreplace $content[set content {}] end end \
			 [list [list widenTo $desttype [nameOfType $desttype]] \
			      $newvar $source] \
			 [list [lindex $q 0] {} [lindex $q 2] $newvar]]
		lset bbcontent $b $content
		dict set udchain $newvar $b
		my addUse $newvar $b
		my removeUse $source $b
		dict set types $newvar $desttype
	    }
	}