tclquadcode: Artifact [e6111dcf16]

Artifact e6111dcf163c26f49e65b55b96d57875ae8b2604:

File codegen/stdlib.tcl — part of check-in [e03627d13b] at 2017-09-14 12:33:05 on branch trunk — Generate correct errorinfo traces on error. Has a negative performance impact. (user: dkf size: 138344) [more...]
# stdlib.tcl --
#
#	Implementations of the majority of quadcodes in LLVM IR. The
#	implementations are generated as mandatory-inline functions that are
#	added onto the Builder class, so that it can issue them by just
#	generating a call to the implementation function. This allows us to
#	inject extra basic blocks without disturbing the analysis from the
#	reasoning engine.
#
#	See build.tcl for where these functions are called from.
#
# Copyright (c) 2015-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.
#
#------------------------------------------------------------------------------

oo::define Builder {
    # Variables holding implementations of Tcl's string operators
    variable tcl.stringify.double tcl.stringify.int tcl.stringify.numeric
    variable tcl.addReference tcl.dropReference
    variable tcl.addFailReference tcl.dropFailReference
    variable tcl.addNExistReference tcl.dropNExistReference
    variable tcl.unshare tcl.unshare.copy
    variable tcl.strlen tcl.append.string tcl.streq tcl.strcmp tcl.strmatch
    variable tcl.stridx tcl.stridx.idx
    variable tcl.strrange tcl.strrange.idx tcl.strreplace tcl.strreplace.idx
    variable tcl.strfind.fwd tcl.strfind.rev
    variable tcl.strmap tcl.strtrim tcl.strcase tcl.strclass
    variable tcl.regexp tcl.concatenate tcl.booleanTest tcl.not.string
    variable tcl.resolveCmd tcl.originCmd

    # Variables holding implementations of Tcl's list operators
    variable tcl.list.create tcl.list.length tcl.list.append tcl.list.concat
    variable tcl.list.foreach.getStep tcl.list.foreach.mayStep
    variable tcl.list.foreach.nextStep tcl.list.foreach.start tcl.list.unshare
    variable tcl.list.range tcl.list.range1 tcl.list.in
    variable tcl.list.index tcl.list.index1 tcl.list.indexList
    variable tcl.list.set tcl.list.set1 tcl.list.setList

    # Variables holding implementations of Tcl's dict operators
    variable tcl.dict.get1 tcl.dict.get tcl.dict.set1 tcl.dict.set
    variable tcl.dict.exists1 tcl.dict.exists tcl.dict.unset1 tcl.dict.unset
    variable tcl.dict.iterStart tcl.dict.iterNext tcl.dict.iterDone
    variable tcl.dict.iterKey tcl.dict.iterValue tcl.dict.addIterReference
    variable tcl.dict.addIterFailReference
    variable tcl.dict.dropIterReference tcl.dict.dropIterFailReference
    variable tcl.dict.append tcl.dict.lappend tcl.dict.incr tcl.dict.size
    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.invoke.command
    variable tcl.logCommandInfo

    # Helper functions
    variable tcl.impl.trimleft tcl.impl.trimright obj.cleanup
    variable tcl.impl.getIndex tcl.impl.listDupe

    # Reference to the module object
    variable m

    # Builder:ReferenceFunctions --
    #
    #	Generate the functions that implement Tcl_Obj reference management.
    #	Only called from @apiFunctions method.
    #
    # Parameters:
    #	api -	The handle of the Tcl API object (currently an instance of the
    #		Thunk class).
    #
    # Results:
    #	None.

    method ReferenceFunctions {api} {
	set 0 [Const 0]

	##### Closure Build:refCountPtr #####
	#
	#	Get a pointer the reference count of a Tcl_Obj reference.
	#
	# Parameters:
	#	value -	An LLVM value handle holding a STRING/Tcl_Obj
	#		reference.
	# Results:
	#	A pointer to the reference count, as a LLVM value.

	my closure refCountPtr {value {name "refCountPtr"}} {
	    my getelementptr $value [list $0 $0] $name
	}

	##### Function tcl.refCount #####
	##### Closure Build:refCount #####
	#
	#	Get the reference count of a Tcl_Obj reference.
	#
	# Parameters:
	#	objPtr -
	#		An LLVM value handle holding a STRING/Tcl_Obj
	#		reference.
	# Results:
	#	The reference count, as a LLVM value.

	set f [$m local "tcl.refCount" int<-Tcl_Obj* readonly]
	params value:objPtr
	build {
	    nonnull $value
	    my ret [my load [my refCountPtr $value] "refCount"]
	}
	my closure refCount {objPtr {resultName "refCount"}} {
	    my call [$f ref] [list $objPtr] $resultName
	}

	##### tcl.shared -> shared #####
	##### Closure Build:shared #####
	#
	#	Get whether a Tcl_Obj reference is shared.
	#
	# Parameters:
	#	objPtr -
	#		An LLVM value handle holding a STRING/Tcl_Obj
	#		reference.
	# Results:
	#	The flag, as a boolean (int1) LLVM value.

	set f [$m local "tcl.shared" bool<-Tcl_Obj* readonly]
	params value:objPtr
	build {
	    nonnull $value
	    my ret [my gt [my refCount $value] [Const 1] "shared"]
	}
	my closure shared {objPtr {resultName "shared"}} {
	    my call [$f ref] [list $objPtr] $resultName
	}

	##### tcl.addReference #####
	#
	# Type signature: objPtr:Tcl_Obj* -> void
	#
	# Increment the reference count of a Tcl_Obj reference.

	set f [$m local "tcl.addReference" void<-Tcl_Obj*]
	params value:objPtr
	build {
	    nonnull $value
	    $api Tcl_IncrRefCount $value
	    my ret
	}

	##### tcl.dropReference #####
	#
	# Type signature: objPtr:Tcl_Obj* -> void
	#
	# Decrement the reference count of a Tcl_Obj reference, and delete it
	# if the reference count drops to zero.

	set f [$m local "tcl.dropReference" void<-Tcl_Obj*]
	params value:objPtr
	build {
	    nonnull $value
	    $api Tcl_DecrRefCount $value
	    my ret
	}

	##### tcl.addFailReference #####
	#
	# Type signature: objPtr:Tcl_Obj*? -> void
	#
	# Increment the reference count of a Tcl_Obj reference if the
	# object is supplied

	set f [$m local "tcl.addFailReference" void<-Tcl_Obj*?]
	params value:maybeObjPtr
	build {
	    my condBr [my maybe $value] $nothing $incr
	label incr "action.required"
	    set value [my unmaybe $value "objPtr"]
	    $api Tcl_IncrRefCount $value
	    my ret
	label nothing "nothing.to.do"
	    my ret
	}

	##### tcl.dropFailReference #####
	#
	# Type signature: objPtr:Tcl_Obj*? -> void
	#
	# Decrement the reference count of a Maybe containing a Tcl_Obj
	# reference, and delete it if the reference count drops to zero.

	set f [$m local "tcl.dropFailReference" void<-Tcl_Obj*?]
	params value:maybeObjPtr
	build {
	    my condBr [my maybe $value] $nothing $decr
	label decr "action.required"
	    set value [my unmaybe $value "objPtr"]
	    $api Tcl_DecrRefCount $value
	    my ret
	label nothing "nothing.to.do"
	    my ret
	}

	##### tcl.addNExistReference #####
	#
	# Type signature: objPtr:Tcl_Obj*! -> void
	#
	# Increment the reference count of a Tcl_Obj reference if the
	# object is supplied

	set f [$m local "tcl.addNExistReference" void<-Tcl_Obj*!]
	params value:maybeObjPtr
	build {
	    my condBr [my maybe $value] $nothing $incr
	label incr "action.required"
	    set value [my unmaybe $value "objPtr"]
	    $api Tcl_IncrRefCount $value
	    my ret
	label nothing "nothing.to.do"
	    my ret
	}

	##### tcl.dropNExistReference #####
	#
	# Type signature: objPtr:Tcl_Obj*! -> void
	#
	# Decrement the reference count of a Maybe containing a Tcl_Obj
	# reference, and delete it if the reference count drops to zero.

	set f [$m local "tcl.dropNExistReference" void<-Tcl_Obj*!]
	params value:maybeObjPtr
	build {
	    my condBr [my maybe $value] $nothing $decr
	label decr "action.required"
	    set value [my unmaybe $value "objPtr"]
	    $api Tcl_DecrRefCount $value
	    my ret
	label nothing "nothing.to.do"
	    my ret
	}

	##### tcl.unshare #####
	#
	# Type signature: objPtr:Tcl_Obj* -> Tcl_Obj*
	#
	# Create and return an unshared version of a Tcl_Obj reference. This
	# only duplicates the Tcl_Obj if necessary.

	set f [$m local "tcl.unshare" Tcl_Obj*<-Tcl_Obj*]
	params value:objPtr
	build {
	    nonnull $value
	    set refCount [my refCount $value]
	    my switch [my refCount $value] $b2 \
		0 $b0 1 $b1
	label b0 "noReference"
	    my addReference(STRING) $value
	    my addReference(STRING) $value
	    my ret $value
	label b1 "noDuplicate"
	    my ret $value
	label b2 "duplicated"
	    set value2 [$api Tcl_DuplicateObj $value]
	    my addReference(STRING) $value2
	    my dropReference $value
	    my ret $value2
	}

	##### tcl.unshare.copy #####
	#
	# Type signature: objPtr:Tcl_Obj* -> Tcl_Obj*
	#
	# Duplicate a Tcl_Obj reference and return it. This *always*
	# duplicates.

	set f [$m local "tcl.unshare.copy" Tcl_Obj*<-Tcl_Obj* readonly]
	params value:objPtr
	build {
	    nonnull $value
	    set dupe [$api Tcl_DuplicateObj $value]
	    my addReference(STRING) $dupe
	    my ret $dupe
	}

	return
    }

    # Builder:StringFunctions --
    #
    #	Generate the functions that implement the string-related quadcodes.
    #	Only called from @apiFunctions method.
    #
    # Parameters:
    #	api -	The handle of the Tcl API object (currently an instance of the
    #		Thunk class).
    #
    # Results:
    #	None.

    method StringFunctions {api} {
	set sizeof(Tcl_UniChar) [Const 2]
	set sizeof(UTF_BYTES) [Const 8]
	set 0 [Const 0]
	set 1 [Const 1]
	set -1 [Const -1]
	set size_t [Type int]; # TODO really size_t, not int

	##### Closure Build:printref #####
	#
	# Type signature: val:STRING -> void
	#
	# Print a description of the given Tcl_Obj reference. Used for
	# debugging reference counts.

	set f [$m local writeref void<-int,STRING,char* noinline]
	params pr val prefix
	build {
	    nonnull $val
	    set chan [$api Tcl_GetStdChannel [Const [expr 1<<3]]]
	    my condBr [my nonnull $prefix] $printPrefix $printRef
	label printPrefix "print.prefix"
	    set str [$api Tcl_NewStringObj $prefix [Const -1]]
	    $api Tcl_WriteObj $chan $str
	    $api Tcl_DecrRefCount $str
	    my br $printRef
	label printRef "print.reference"
	    # Multi-stage print so we still get something useful when memory
	    # is corrupted.
	    set str [$api Tcl_ObjPrintf \
			 [my constString "%d:0x%X"] \
			 $pr [my castPtr2Int $val int]]
	    $api Tcl_WriteObj $chan $str
	    $api Tcl_DecrRefCount $str
	    set rc [my refCount $val]
	    set str [$api Tcl_ObjPrintf \
			 [my constString "(%.30s) => %d\n"] \
			 [$api Tcl_GetString $val] $rc]
	    $api Tcl_WriteObj $chan $str
	    $api Tcl_DecrRefCount $str
	    my ret
	}
	set f [$m local writeref? void<-int,STRING?,char*]
	params pr val prefix
	build {
	    my condBr [my maybe $val] $done $print
	label print:
	    my Call writeref $pr [my unmaybe $val] $prefix
	    my ret
	label done:
	    my ret
	}
	my closure printref {val {prefix ""}} {
	    if {![info exists ::env(TQC_PRINT_REFERENCE_MANAGEMENT)]} {
		return
	    }
	    if {[TypeOf $val] eq [Type STRING]} {
		set writerFunc writeref
	    } elseif {[TypeOf $val] eq [Type STRING?]} {
		set writerFunc writeref?
	    } elseif {[GetTypeKind [TypeOf $val]] eq "LLVMStructTypeKind"} {
		set idx -1
		foreach t [GetStructElementTypes [TypeOf $val]] {
		    incr idx
		    if {$t eq [Type STRING] || $t eq [Type STRING?]
			    || [GetTypeKind $t] eq "LLVMStructTypeKind"} {
			my printref [my extract $val $idx] $prefix
		    }
		}
		return
	    } else {
		my Warn "printref incomplete for \"%s\"" \
		    [PrintValueToString $val]
		return
	    }
	    if {$prefix ne ""} {
		set prefix [my constString $prefix]
	    } else {
		set prefix [my null char*]
	    }
	    variable prcount
	    set pr [Const [incr prcount]]
	    # set name [format %.30s... [PrintValueToString $val]]
	    my Call $writerFunc $pr $val $prefix
	    return
	}

	##### Closure Build:memcpy #####
	#
	# Type signature: target:[?]* * source:[?]* * length:int[?] -> void
	#
	# Copy memory of size 'length' from 'source' to 'target'.

	my closure memcpy {target source length} {
	    set vt [Type void*]
	    set memcpy [$m intrinsic memcpy $vt $vt [TypeOf $length]]
	    if {[TypeOf $target] ne $vt} {
		set target [my cast(ptr) $target void]
	    }
	    if {[TypeOf $source] ne $vt} {
		set source [my cast(ptr) $source void]
	    }
	    my Call memcpy $target $source $length \
		    [Const 0] [Const false bool]
	    return
	}

	##### Closure Build:bzero #####
	#
	# Type signature: memoryBlock:[?]* * length:int[?] -> void
	#
	# Zeroes memory of size 'length' starting at 'memoryBlock'. An
	# optional alignment may be given (as a simple Tcl integer); it
	# defaults to the platform alignment size, which is ideal for zeroing
	# normal structures on modern architectures.

	my closure bzero {target length {alignment -1}} {
	    if {$alignment < 0} {
		set alignment $::tcl_platform(wordSize)
	    }
	    set vt [Type void*]
	    set memset [$m intrinsic memset $vt [TypeOf $length]]
	    if {[TypeOf $target] ne $vt} {
		set target [my cast(ptr) $target void]
	    }
	    my Call memset $target [Const 0 int8] $length \
		[Const $alignment] [Const false bool]
	    return
	}

	##### Closure Build:memcmp #####
	#
	# Type signature: a:[?]* * b:[?]* * length:int[?] -> int
	#
	# Compare memory of size 'length' between 'a' and 'b'.

	set memcmp [$m function.extern memcmp \
		[Type func{int<-void*,void*,$size_t}] readonly]
	my closure memcmp {bytes1 bytes2 length {name "cmp"}} {
	    set vt [Type void*]
	    if {[TypeOf $bytes1] ne $vt} {
		set bytes1 [my cast(ptr) $bytes1 void]
	    }
	    if {[TypeOf $bytes2] ne $vt} {
		set bytes2 [my cast(ptr) $bytes2 void]
	    }
	    if {[TypeOf $length] ne [Type $size_t]} {
		set length [my castInt2Int $length $size_t]
	    }
	    my call $memcmp [list $bytes1 $bytes2 $length] $name
	}

	my StringInspectionFunctions $api
	my StringWritingFunctions $api
	my ListFunctions $api
	my DictionaryFunctions $api
	my StringComparisonFunctions $api

	return
    }

    # Builder:StringInspectionFunctions --
    #
    #	Generate the functions that implement the read-only string operations.
    #	Only called from StringFunctions method.
    #
    # Parameters:
    #	api -	The handle of the Tcl API object (currently an instance of the
    #		Thunk class).
    #
    # Results:
    #	None.

    method StringInspectionFunctions {api} {
	upvar 1 sizeof sizeof 0 0 1 1

	##### Function tcl.strlen #####
	#
	# Type signature: objPtr:STRING -> INT
	#
	# Quadcode implementation ('strlen')
	#
	# Returns the length of the string in *characters*.

	set f [$m local "tcl.strlen" INT<-STRING]
	params value:objPtr
	build {
	    nonnull $value
	    set refCount [my refCountPtr $value]
	    set before [my load $refCount "before"]
	    set result [my packInt32 [$api Tcl_GetCharLength $value]]
	    set after [my load $refCount "after"]
	    my assume [my eq $before $after]
	    my ret $result
	}

	##### Function tcl.isPureByteArray #####
	##### Closure Build:isByteArray #####
	#
	# Type signature: objPtr:STRING -> int1
	#
	# Test if a STRING is actually a true byte array, that it can be
	# processed as bytes and not as unicode characters.

	set f [$m local "tcl.isPureByteArray" int1<-STRING readonly]
	params objPtr
	build {
	    nonnull $objPtr
	    set baType [$api tclByteArrayType]
	    set typePtr [my dereference $objPtr 0 Tcl_Obj.typePtr]
	    my condBr [my eq $baType $typePtr] $puretest $notBA
	label puretest:
	    my condBr [my nonnull [my dereference $objPtr 0 Tcl_Obj.bytes]] \
		$notBA $isBA
	label isBA:
	    my ret [Const true bool]
	label notBA:
	    my ret [Const false bool]
	}
	my closure isByteArray {STRING {name ""}} {
	    my call ${tcl.isPureByteArray} [list $STRING] $name
	}

	##### Function tcl.isUnicodeString #####
	##### Closure Build:isUnicodeString #####
	#
	# Type signature: objPtr:STRING -> int1
	#
	# Test if a STRING is stored internally as a sequence of Tcl_UniChar
	# (instead of as a sequence of Unicode characters encoded as UTF-8).

	set f [$m local "tcl.isUnicodeString" int1<-STRING readonly]
	params objPtr
	build {
	    nonnull $objPtr
	    set strType [$api tclStringType]
	    set type [my dereference $objPtr 0 Tcl_Obj.typePtr]
	    my ret [my eq $type $strType]
	}
	my closure isUnicodeString {STRING {name ""}} {
	    my call ${tcl.isUnicodeString} [list $STRING] $name
	}

	##### 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
	# to ensure that scope lifetime gets better understood.

	set f [$m local "tcl.impl.getDouble" struct{int1,double}<-STRING]
	my closure GetDouble {valueObj} {
	    my call ${tcl.impl.getDouble} [list $valueObj] "result"
	}
	params valueObj
	build {
	    nonnull $valueObj
	    set dblVar [my alloc double "dblPtr"]
	    set code [$api Tcl_GetDoubleFromObj {} $valueObj $dblVar]
	    set res [my undef struct{int1,double}]
	    set res [my insert $res [my eq $code [Const 0]] 0]
	    set res [my insert $res [my load $dblVar "dbl"] 1]
	    my ret $res
	}
	unset -nocomplain valueObj

	##### Function tcl.impl.getWide #####
	##### MAPPED CALL TO METHOD: Build:GetWide #####
	#
	# Type signature: valueObj:STRING -> bool * int64
	#
	# Gets an int64 from a Tcl string. Wrapper around Tcl API to ensure
	# that scope lifetime gets better understood.

	set f [$m local "tcl.impl.getWide" struct{int1,int64}<-STRING]
	my closure GetWide {valueObj {name "result"}} {
	    my call ${tcl.impl.getWide} [list $valueObj] $name
	}
	params valueObj
	build {
	    nonnull $valueObj
	    set intVar [my alloc int64 "intPtr"]
	    set code [$api Tcl_GetWideIntFromObj {} $valueObj $intVar]
	    set res [my undef struct{bool,int64}]
	    set res [my insert $res [my eq $code [Const 0]] 0]
	    set res [my insert $res [my load $intVar "int"] 1 "result"]
	    my ret $res
	}
	unset -nocomplain valueObj

	##### Function tcl.impl.getString #####
	##### MAPPED CALL TO METHOD: Build:GetString #####
	#
	# Type signature: stringObj:STRING -> int * int8[]
	#
	# Gets the (pseudo-)UTF-8 version of a string. Wrapper around Tcl API
	# to ensure that scope lifetime gets better understood.

	set f [$m local "tcl.impl.getString" struct{int,int8*}<-STRING readonly]
	my closure GetString {string name} {
	    set data [my Call tcl.impl.getString $string]
	    set len [my extract $data 0 "$name.length"]
	    set chars [my extract $data 1 "$name.string"]
	    return [list $len $chars]
	}
	params stringObj
	build {
	    nonnull $stringObj
	    set var [my alloc int "lengthPtr"]
	    set chars [$api Tcl_GetStringFromObj $stringObj $var]
	    set res [my undef struct{int,int8*}]
	    set res [my insert $res [my load $var "length"] 0]
	    set res [my insert $res $chars 1 "result"]
	    my ret $res
	}

	##### Function tcl.impl.getUnicode #####
	##### MAPPED CALL TO METHOD: Build:GetUnicode #####
	#
	# Type signature: stringObj:STRING -> int * int16[]
	#
	# Gets the unicode (UCS-2?) version of a string. Wrapper around Tcl
	# API to ensure that scope lifetime gets better understood.

	set f [$m local "tcl.impl.getUnicode" struct{int,int16*}<-STRING readonly]
	my closure GetUnicode {string name} {
	    set data [my Call tcl.impl.getUnicode $string]
	    set len [my extract $data 0 "$name.length"]
	    set unichars [my extract $data 1 "$name.string"]
	    return [list $len $unichars]
	}
	params stringObj
	build {
	    nonnull $stringObj
	    set var [my alloc int "lengthPtr"]
	    set chars [$api Tcl_GetUnicodeFromObj $stringObj $var]
	    set res [my undef struct{int,int16*}]
	    set res [my insert $res [my load $var "length"] 0]
	    set res [my insert $res $chars 1 "result"]
	    my ret $res
	}

	##### Function tcl.impl.getBytes #####
	##### MAPPED CALL TO METHOD: Build:GetBytes #####
	#
	# Type signature: stringObj:STRING -> int * int8[]
	#
	# Gets the byte array version of a string. Wrapper around Tcl API to
	# ensure that scope lifetime gets better understood.

	set f [$m local "tcl.impl.getBytes" struct{int,int8*}<-STRING readonly]
	my closure GetBytes {string name} {
	    set data [my Call tcl.impl.getBytes $string]
	    set len [my extract $data 0 "$name.length"]
	    set bytes [my extract $data 1 "$name.bytes"]
	    return [list $len $bytes]
	}
	params stringObj
	build {
	    nonnull $stringObj
	    set var [my alloc int "lengthPtr"]
	    set chars [$api Tcl_GetByteArrayFromObj $stringObj $var]
	    set res [my undef struct{int,int8*}]
	    set res [my insert $res [my load $var "length"] 0]
	    set res [my insert $res $chars 1 "result"]
	    my ret $res
	}

	##### Function tcl.strfind.fwd #####
	#
	# Type signature: needlePtr:STRING * haystackPtr:STRING -> INT
	#
	# Quadcode implementation ('strfind')
	#
	# Returns the index where the first instance of the string haystackPtr
	# is found in the string needlePtr, or -1 if the string is not found.

	set f [$m local "tcl.strfind.fwd" INT<-STRING,STRING]
	params needlePtr haystackPtr
	unset -nocomplain loop
	build {
	    nonnull $needlePtr $haystackPtr
	    lassign [my GetUnicode $haystackPtr haystack] len1 haystack
	    lassign [my GetUnicode $needlePtr needle] len2 needle
	    my condBr [my gt $len2 $0] $checklen $noMatch
	label checklen:
	    my condBr [my le $len2 $len1] $loop(init) $noMatch
	label loop(init) "doSearch.init"
	    set end [my getelementptr $haystack \
		    [list [my add [my sub $len1 $len2] $1]] "end"]
	    set needle_0 [my load $needle "needle.0"]
	    set ptr [my alloc [TypeOf $haystack] "ptr"]
	    my store $haystack $ptr
	    my br $loop(check)
	label loop(check) "doSearch.check"
	    my condBr [my lt [my load $ptr] $end] $loop(1) $noMatch
	label loop(next) "doSearch.next"
	    my store [my gep [my load $ptr] 1] $ptr
	    my br $loop(check)
	label loop(1) "doSearch.loop1"
	    set p [my load $ptr "p"]
	    my condBr [my eq [my load $p] $needle_0] $loop(2) $loop(next)
	label loop(2) "doSearch.loop2"
	    set testResult [my memcmp $needle $p \
		    [my mult $sizeof(Tcl_UniChar) $len2]]
	    my condBr [my eq $testResult $0] $found $loop(next)
	label found:
	    my ret [my packInt32 [my cast(int) [my diff $p $haystack]]]
	label noMatch:
	    my ret [my int -1]
	}

	##### Function tcl.strfind.rev #####
	#
	# Type signature: needlePtr:STRING * haystackPtr:STRING -> INT
	#
	# Quadcode implementation ('strrfind')
	#
	# Returns the index where the last instance of the string haystackPtr
	# is found in the string needlePtr, or -1 if the string is not found.

	set f [$m local "tcl.strfind.rev" INT<-STRING,STRING]
	params needlePtr haystackPtr
	unset -nocomplain loop
	build {
	    nonnull $needlePtr $haystackPtr
	    lassign [my GetUnicode $haystackPtr haystack] len1 haystack
	    lassign [my GetUnicode $needlePtr needle] len2 needle
	    my condBr [my gt $len2 $0] $checklen $noMatch
	label checklen:
	    my condBr [my le $len2 $len1] $loop(init) $noMatch
	label loop(init) "doSearch.init"
	    set needle_0 [my load $needle "needle.0"]
	    set ptr [my alloc [TypeOf $haystack] "ptr"]
	    my store [my getelementptr $haystack [list [my sub $len1 $len2]]]\
		$ptr
	    my br $loop(check)
	label loop(check) "doSearch.check"
	    my condBr [my ge [my load $ptr] $haystack] $loop(1) $noMatch
	label loop(next) "doSearch.next"
	    my store [my gep [my load $ptr] -1] $ptr
	    my br $loop(check)
	label loop(1) "doSearch.loop1"
	    set p [my load $ptr "p"]
	    my condBr [my eq [my load $p] $needle_0] $loop(2) $loop(next)
	label loop(2) "doSearch.loop2"
	    set testResult [my memcmp $needle $p \
		    [my mult $sizeof(Tcl_UniChar) $len2]]
	    my condBr [my eq $testResult $0] $found $loop(next)
	label found:
	    my ret [my packInt32 [my cast(int) [my diff $p $haystack]]]
	label noMatch:
	    my ret [my int -1]
	}

	##### Function tcl.impl.trimleft #####
	# Replacement for non-exposed TclTrimLeft
	#
	# Type signature: bytes:char* * numBytes:int32 * trim:char* *
	#			numTrim:int32 -> int32
	#
	# Part of quadcode implementation ('strtrim')
	#
	# Returns the number of bytes to be trimmed from the beginning of the
	# string 'bytes' (length 'numBytes'), where the characters to be
	# trimmed are in the string 'trim' (length 'numTrim'). Works on UTF-8.

	set f [$m local "tcl.impl.trimleft" int<-char*,int,char*,int readonly]
	params bytes numBytes trim numTrim
	build {
	    nonnull $bytes $trim
	    set chVar [my alloc int16]
	    set pLoop [my uniqueUndef char* "p"]
	    set nbLoop [my uniqueUndef int "nb"]
	    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 p [my phi [list $bytes $pLoop] $sources "p"]
	    set numBytes [my phi [list $numBytes $nbLoop] $sources "numBytes"]
	    set pInc [$api Tcl_UtfToUniChar $p $chVar]
	    SetValueName $pInc "pInc"
	    set ch1 [my load $chVar "ch1"]
	    set qLoop [my uniqueUndef char* "q"]
	    set blLoop [my uniqueUndef int "bl"]
	    my br $innerLoop
	label innerLoop:
	    set sources [list $outerLoop $nextInner]
	    set q [my phi [list $trim $qLoop] $sources "q"]
	    set bytesLeft [my phi [list $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:
	    ReplaceAllUsesWith $qLoop [my getelementptr $q [list $qInc] "q"]
	    ReplaceAllUsesWith $blLoop \
		[set bytesLeft2 [my sub $bytesLeft $qInc "bytesLeft"]]
	    my condBr [my gt $bytesLeft2 $0] $innerLoop $doneInner
	label doneInner:
	    set sources [list $innerLoop $nextInner]
	    set bytesLeft [my phi [list $bytesLeft $bytesLeft2] $sources "bytesLeft"]
	    my condBr [my le $bytesLeft $0] $doneOuter $nextOuter
	label nextOuter:
	    ReplaceAllUsesWith $pLoop \
		[set p2 [my getelementptr $p [list $pInc] "p"]]
	    ReplaceAllUsesWith $nbLoop \
		[set numBytes [my sub $numBytes $pInc "numBytes"]]
	    my condBr [my gt $numBytes $0] $outerLoop $doneOuter
	label doneOuter:
	    set p [my phi [list $p $p2] [list $doneInner $nextOuter] "p"]
	    my ret [my cast(int) [my diff $p $bytes]]
	}

	##### Function tcl.impl.trimright #####
	# Replacement for non-exposed TclTrimRight
	#
	# Type signature: bytes:char* * numBytes:int32 * trim:char* *
	#			numTrim:int32 -> int32
	#
	# Part of quadcode implementation ('strtrim')
	#
	# Returns the number of bytes to be trimmed from the end of the string
	# 'bytes' (length 'numBytes'), where the characters to be trimmed are
	# in the string 'trim' (length 'numTrim'). Works on UTF-8.

	set f [$m local "tcl.impl.trimright" int<-char*,int,char*,int readonly]
	params bytes numBytes trim numTrim
	build {
	    nonnull $bytes $trim
	    set chVar [my alloc int16]
	    set pLoop [my uniqueUndef char* "p"]
	    set nbLoop [my uniqueUndef int "nb"]
	    set p [my getelementptr $bytes [list $numBytes] "p"]
	    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 p [my phi [list $p $pLoop] $sources "p"]
	    set numBytes [my phi [list $numBytes $nbLoop] $sources "numBytes"]
	    set p [$api Tcl_UtfPrev $p $bytes]
	    SetValueName $p "p"
	    set pInc [$api Tcl_UtfToUniChar $p $chVar]
	    SetValueName $pInc "pInc"
	    set ch1 [my load $chVar "ch1"]
	    set qLoop [my uniqueUndef char* "q"]
	    set blLoop [my uniqueUndef int "bl"]
	    my br $innerLoop
	label innerLoop:
	    set sources [list $outerLoop $nextInner]
	    set q [my phi [list $trim $qLoop] $sources "q"]
	    set bytesLeft [my phi [list $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:
	    ReplaceAllUsesWith $qLoop [my getelementptr $q [list $qInc] "q"]
	    ReplaceAllUsesWith $blLoop \
		[set bytesLeft [my sub $bytesLeft $qInc "bytesLeft"]]
	    my condBr [my gt $bytesLeft $0] $innerLoop $fixP
	label nextOuter:
	    ReplaceAllUsesWith $pLoop $p
	    ReplaceAllUsesWith $nbLoop $numBytes
	    my condBr [my gt $p $bytes] $outerLoop $doneOuter
	label fixP:
	    set p0 [my phi [list $p $p] [list $doneInner $nextInner] "p"]
	    set p2 [my getelementptr $p0 [list $pInc] "p"]
	    my br $doneOuter
	label doneOuter:
	    set p [my phi [list $p $p2] [list $nextOuter $fixP] "p"]
	    my ret [my sub $numBytes [my cast(int) [my diff $p $bytes]]]
	}

	##### Function tcl.impl.isAscii #####
	# Replacement for non-exposed UniCharIsAscii
	#
	# Type signature: ch:int16 -> int1
	#
	# Part of quadcode implementation ('strclass')
	#
	# Returns whether the character 'ch' is in the ASCII range.

	set f [$m local "tcl.impl.isAscii" bool<-int16 readnone]
	params ch
	build {
	    my ret [my and [my ge $ch [Const 0 int16]] \
			[my lt $ch [Const 0x80 int16]]]
	}

	##### Function tcl.impl.isXdigit #####
	# Replacement for non-exposed UniCharIsXdigit
	#
	# Type signature: ch:int16 -> int1
	#
	# Part of quadcode implementation ('strclass')
	#
	# Returns whether the character 'ch' is a hex digit.

	set f [$m local "tcl.impl.isXdigit" bool<-int16 readnone]
	params ch
	build {
	    my switch $ch $not \
		0x30 $ok 0x31 $ok 0x32 $ok 0x33 $ok 0x34 $ok \
		0x35 $ok 0x36 $ok 0x37 $ok 0x38 $ok 0x39 $ok \
		0x41 $ok 0x42 $ok 0x43 $ok 0x44 $ok 0x45 $ok 0x46 $ok \
		0x61 $ok 0x62 $ok 0x63 $ok 0x64 $ok 0x65 $ok 0x66 $ok
	label ok:
	    my ret [Const true bool]
	label not:
	    my ret [Const false bool]
	}

	##### Function tcl.strclass #####
	#
	# Type signature: objPtr:STRING * class:int32 -> ZEROONE
	#
	# Quadcode implementation ('strclass')
	#
	# Returns whether all the characters in the string 'objPtr' are in the
	# character class given by 'class' (enumeration encoded as int32).

	set f [$m local "tcl.strclass" ZEROONE<-STRING,int]
	params objPtr class
	build {
	    nonnull $objPtr
	    lassign [my GetUnicode $objPtr obj] length string
	    set p0 [my uniqueUndef int16* "p"]
	    set p1 [my uniqueUndef int16* "p"]
	    set p2 [my uniqueUndef int16* "p"]
	    set p3 [my uniqueUndef int16* "p"]
	    set p4 [my uniqueUndef int16* "p"]
	    set p5 [my uniqueUndef int16* "p"]
	    set p6 [my uniqueUndef int16* "p"]
	    set p7 [my uniqueUndef int16* "p"]
	    set p8 [my uniqueUndef int16* "p"]
	    set p9 [my uniqueUndef int16* "p"]
	    set p10 [my uniqueUndef int16* "p"]
	    set p11 [my uniqueUndef int16* "p"]
	    set p12 [my uniqueUndef int16* "p"]
	    my condBr [my gt $length $0] $test $match
	label test:
	    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 [my phi [list $string $p0] [list $test $alnumNext] "p"]
	    my condBr [my neq [$api Tcl_UniCharIsAlnum [my load $p]] $0] \
		$alnumNext $fail
	label alnumNext "alnum.next"
	    ReplaceAllUsesWith $p0 [set p [my getelementptr $p $n "p"]]
	    my condBr [my lt $p $end] $alnum $match
	label alpha:
	    set p [my phi [list $string $p1] [list $test $alphaNext] "p"]
	    my condBr [my neq [$api Tcl_UniCharIsAlpha [my load $p]] $0] \
		$alphaNext $fail
	label alphaNext "alpha.next"
	    ReplaceAllUsesWith $p1 [set p [my getelementptr $p $n "p"]]
	    my condBr [my lt $p $end] $alpha $match
	label ascii:
	    set p [my phi [list $string $p2] [list $test $asciiNext] "p"]
	    my condBr [my Call tcl.impl.isAscii [my load $p]] \
		$asciiNext $fail
	label asciiNext "ascii.next"
	    ReplaceAllUsesWith $p2 [set p [my getelementptr $p $n "p"]]
	    my condBr [my lt $p $end] $ascii $match
	label control:
	    set p [my phi [list $string $p3] [list $test $controlNext] "p"]
	    my condBr [my neq [$api Tcl_UniCharIsControl [my load $p]] $0] \
		$controlNext $fail
	label controlNext "control.next"
	    ReplaceAllUsesWith $p3 [set p [my getelementptr $p $n "p"]]
	    my condBr [my lt $p $end] $control $match
	label digit:
	    set p [my phi [list $string $p4] [list $test $digitNext] "p"]
	    my condBr [my neq [$api Tcl_UniCharIsDigit [my load $p]] $0] \
		$digitNext $fail
	label digitNext "digit.next"
	    ReplaceAllUsesWith $p4 [set p [my getelementptr $p $n "p"]]
	    my condBr [my lt $p $end] $digit $match
	label graph:
	    set p [my phi [list $string $p5] [list $test $graphNext] "p"]
	    my condBr [my neq [$api Tcl_UniCharIsGraph [my load $p]] $0] \
		$graphNext $fail
	label graphNext "graph.next"
	    ReplaceAllUsesWith $p5 [set p [my getelementptr $p $n "p"]]
	    my condBr [my lt $p $end] $graph $match
	label lower:
	    set p [my phi [list $string $p6] [list $test $lowerNext] "p"]
	    my condBr [my neq [$api Tcl_UniCharIsLower [my load $p]] $0] \
		$lowerNext $fail
	label lowerNext "lower.next"
	    ReplaceAllUsesWith $p6 [set p [my getelementptr $p $n "p"]]
	    my condBr [my lt $p $end] $lower $match
	label print:
	    set p [my phi [list $string $p7] [list $test $printNext] "p"]
	    my condBr [my neq [$api Tcl_UniCharIsPrint [my load $p]] $0] \
		$printNext $fail
	label printNext "print.next"
	    ReplaceAllUsesWith $p7 [set p [my getelementptr $p $n "p"]]
	    my condBr [my lt $p $end] $print $match
	label punct:
	    set p [my phi [list $string $p8] [list $test $punctNext] "p"]
	    my condBr [my neq [$api Tcl_UniCharIsPunct [my load $p]] $0] \
		$punctNext $fail
	label punctNext "punct.next"
	    ReplaceAllUsesWith $p8 [set p [my getelementptr $p $n "p"]]
	    my condBr [my lt $p $end] $punct $match
	label space:
	    set p [my phi [list $string $p9] [list $test $spaceNext] "p"]
	    my condBr [my neq [$api Tcl_UniCharIsSpace [my load $p]] $0] \
		$spaceNext $fail
	label spaceNext "space.next"
	    ReplaceAllUsesWith $p9 [set p [my getelementptr $p $n "p"]]
	    my condBr [my lt $p $end] $space $match
	label upper:
	    set p [my phi [list $string $p10] [list $test $upperNext] "p"]
	    my condBr [my neq [$api Tcl_UniCharIsUpper [my load $p]] $0] \
		$upperNext $fail
	label upperNext "upper.next"
	    ReplaceAllUsesWith $p10 [set p [my getelementptr $p $n "p"]]
	    my condBr [my lt $p $end] $upper $match
	label word:
	    set p [my phi [list $string $p11] [list $test $wordNext] "p"]
	    my condBr [my neq [$api Tcl_UniCharIsWordChar [my load $p]] $0] \
		$wordNext $fail
	label wordNext "word.next"
	    ReplaceAllUsesWith $p11 [set p [my getelementptr $p $n "p"]]
	    my condBr [my lt $p $end] $word $match
	label xdigit:
	    set p [my phi [list $string $p12] [list $test $xdigitNext] "p"]
	    my condBr [my Call tcl.impl.isXdigit [my load $p]] \
		$xdigitNext $fail
	label xdigitNext "xdigit.next"
	    ReplaceAllUsesWith $p12 [set p [my getelementptr $p $n "p"]]
	    my condBr [my lt $p $end] $xdigit $match
	label match:
	    my ret [Const true bool]
	label fail:
	    my ret [Const false bool]
	}

	##### Function tcl.impl.getIndex #####
	##### Closure Build:GetIndex #####
	#
	# Type signature: interp:Interp* * objPtr:Tcl_Obj* * end:int
	#			-> int1 * int
	#
	# Converts an index string into an offset into something (i.e., a
	# string or list). Returns a tuple of whether the conversion succeeded
	# (a boolean) and the index.

	set f [$m local "tcl.impl.getIndex" \
		   struct{bool,int}<-Interp*,Tcl_Obj*,int readonly]
	unset -nocomplain objPtr end
	my closure GetIndex {interp objPtr end {indexVar dummy}} {
	    upvar 1 $indexVar index
	    if {$interp eq ""} {
		set interp [my null Interp*]
	    }
	    set res [my Call tcl.impl.getIndex $interp $objPtr $end]
	    set index [my extract $res 1 "getIndex.index"]
	    return [my extract $res 0 "getIndex.result"]
	}
	params interp objPtr end
	build {
	    noalias $interp $objPtr
	    nonnull $objPtr
	    set ret [my undef struct{bool,int}]
	    my condBr [my eq [my dereference $objPtr 0 Tcl_Obj.typePtr] \
			   [$api tclIntType]] \
		$direct $call
	label direct:
	    set repPtr [my gep $objPtr 0 Tcl_Obj.internalRep]
	    set retD [my insert $ret [Const true bool] 0]
	    my ret [my insert $retD \
		[my load [my cast(ptr) $repPtr int] "longValue"] 1]
	label call:
	    set idxPtr [my alloc int "index"]
	    set code [$api TclGetIntForIndex $interp $objPtr $end $idxPtr]
	    set retC [my insert $ret [my eq $code $0] 0]
	    my ret [my insert $retC [my load $idxPtr] 1]
	}
    }

    # Builder:StringWritingFunctions --
    #
    #	Generate the functions that implement the string-creating operators.
    #	Only called from StringFunctions method.
    #
    # Parameters:
    #	api -	The handle of the Tcl API object (currently an instance of the
    #		Thunk class).
    #
    # Results:
    #	None.

    # Note that each of these (that returns a string at all) *must* increment
    # the reference count of the values it returns; the general engine assumes
    # that this is necessarily so.
    method StringWritingFunctions {api} {
	upvar 1 sizeof sizeof 0 0 1 1 -1 -1

	##### Function tcl.setFromAny #####
	##### Closure Build:setFromAny #####
	#
	# Type signature: typePtr:ObjType* * interp:Interp*
	#			* objPtr:STRING -> int
	#
	# Call the given type's setFromAnyProc on the given object.

	set f [$m local "tcl.setFromAny" int<-ObjType*,Interp*,STRING]
	params typePtr interp objPtr
	build {
	    noalias $typePtr $interp $objPtr
	    nonnull $typePtr $objPtr
	    set func [my dereference $typePtr 0 ObjType.setFromAnyProc]
	    set code [my Call $func $interp $objPtr]
	    SetValueName $code "code"
	    AddCallAttribute $code 1 nocapture
	    AddCallAttribute $code 2 nocapture
	    my ret $code
	}
	my closure setFromAny {TYPE INTERP VALUE {name "code"}} {
	    my call ${tcl.setFromAny} [list $TYPE $INTERP $VALUE] $name
	}

	##### Functions obj.dedup, obj.cleanup #####
	##### Closure: Build:Dedup #####
	#
	# Type signatures: obj:STRING -> {STRING,bool}
	#		   objdupe:{STRING,bool} -> void
	#
	# Helpers for the dictionary updating functions that reduce the amount
	# of explicit branch management in the code by factoring out common
	# patterns of reference handling.

	set f [$m local "obj.dedup" struct{STRING,int1}<-STRING]
	params obj
	build {
	    set duped [my shared $obj]
	    SetValueName $duped "duped"
	    set res [my insert [my undef struct{STRING,int1}] $duped 1]
	    my condBr $duped $duplicated $unshared
	label duplicated:
	    set dupe [$api Tcl_DuplicateObj $obj]
	    SetValueName $dupe "duplicateObj"
	    my ret [my insert $res $dupe 0]
	label unshared:
	    my ret [my insert $res $obj 0]
	}
	my closure Dedup {varName} {
	    upvar 1 $varName var
	    set token [my Call obj.dedup $var]
	    set var [my extract $token 0 [GetValueName $var]]
	    return $token
	}

	set f [$m local "obj.cleanup" void<-struct{STRING,int1}]
	params objdupe
	build {
	    my condBr [my extract $objdupe 1] $duplicated $unshared
	label duplicated:
	    my dropReference [my extract $objdupe 0]
	    my ret
	label unshared:
	    my ret
	}

	##### Function tcl.append.string #####
	#
	# Type signature: bufferObjPtr:STRING * valueObjPtr:STRING -> void
	#
	# Part of quadcode implementation ('strcat')
	#
	# Appends the string in 'valueObjPtr' to the string in 'bufferObjPtr'.
	# The buffer must be unshared.

	set f [$m local "tcl.append.string" void<-STRING,STRING]
	params buffer:bufferObjPtr value:valueObjPtr
	build {
	    noalias $buffer $value
	    nonnull $buffer $value
	    set refCountBuf [my refCountPtr $buffer]
	    set beforeBuf [my load $refCountBuf "before.buf"]
	    my assume [my le $beforeBuf $1]
	    set refCountVal [my refCountPtr $value]
	    set beforeVal [my load $refCountVal "before.val"]
	    $api Tcl_AppendObjToObj $buffer $value
	    set afterBuf [my load $refCountBuf "after.buf"]
	    my assume [my eq $beforeBuf $afterBuf]
	    set afterVal [my load $refCountVal "after.val"]
	    my assume [my eq $beforeVal $afterVal]
	    my ret
	}

	##### Function tcl.stridx #####
	#
	# Type signature: objPtr:STRING * indexInt:INT -> STRING
	#
	# Quadcode implementation ('stridx')
	#
	# Returns the character (as a single character string) at index
	# 'indexInt' of string 'objPtr', or the empty string if the index does
	# not refer to a position inside the string.

	set f [$m local "tcl.stridx" STRING<-STRING,INT]
	params str:objPtr idxInt:indexInt
	build {
	    nonnull $str
	    set idx [my cast(int) [my getInt64 $idxInt] "index"]
	    my condBr [my lt $idx $0] $empty $testTooLong
	label empty:
	    set emptyResult [$api Tcl_NewObj]
	    my br $done
	label testTooLong:
	    set len [$api Tcl_GetCharLength $str]
	    my condBr [my ge $idx $len] $empty $isPure
	label isPure:
	    my condBr [my isByteArray $str] $baIdx $nexttest
	label nexttest:
	    my condBr [my nonnull [my dereference $str 0 Tcl_Obj.bytes]] \
		$nexttest2 $strIdx
	label nexttest2:
	    my condBr [my eq $len [my dereference $str 0 Tcl_Obj.length]] \
		$byteIndex $strIdx
	label baIdx "byteArrayIndexing"
	    set bytes [$api Tcl_GetByteArray $str]
	    set bytePtr [my getelementptr $bytes [list $idx]]
	    set byteResult [$api Tcl_NewByteArrayObj $bytePtr $1]
	    my br $done
	label byteIndex "fastStringIndexing"
	    set bytes [my dereference $str 0 Tcl_Obj.bytes]
	    set bytePtr [my getelementptr $bytes [list $idx]]
	    set asciiResult [$api Tcl_NewStringObj $bytePtr $1]
	    my br $done
	label strIdx "slowStringIndexing"
	    set ch [my cast(uint) [$api Tcl_GetUniChar $str $idx] "ch"]
	    set buf [my arrayAlloc char $sizeof(UTF_BYTES) "buf"]
	    set len [$api Tcl_UniCharToUtf $ch $buf]
	    set unicodeResult [$api Tcl_NewStringObj $buf $len]
	    my br $done
	label done:
	    set result [my phi \
		    [list $emptyResult $byteResult $asciiResult $unicodeResult] \
		    [list $empty $baIdx $byteIndex $strIdx] "result"]
	    my addReference(STRING) $result
	    my ret $result
	}

	##### Function tcl.stridx.idx #####
	#
	# Type signature: objPtr:STRING * index:STRING * ecvar:int* -> STRING?
	#
	# Quadcode implementation ('stridx')
	#
	# Returns the character (as a single character string) at index
	# 'indexInt' of string 'objPtr', or the empty string if the index does
	# not refer to a position inside the string.

	set f [$m local "tcl.stridx.idx" STRING?<-STRING,STRING,int*]
	params str:objPtr idx:index ecvar
	build {
	    noalias $ecvar
	    nonnull $str $idx $ecvar
	    set interp [$api tclInterp]
	    set len [$api Tcl_GetCharLength $str]
	    set end [my sub $len $1 "end"]
	    my condBr [my GetIndex $interp $idx $end idx] $testBefore $failed
	label testBefore:
	    my condBr [my lt $idx $0] $empty $testTooLong
	label empty:
	    set emptyResult [$api Tcl_NewObj]
	    my br $done
	label testTooLong:
	    my condBr [my ge $idx $len] $empty $isPure
	label isPure:
	    my condBr [my isByteArray $str] $baIdx $nexttest
	label nexttest:
	    my condBr [my nonnull [my dereference $str 0 Tcl_Obj.bytes]] \
		$nexttest2 $strIdx
	label nexttest2:
	    my condBr [my eq $len [my dereference $str 0 Tcl_Obj.length]] \
		$byteIndex $strIdx
	label baIdx "byteArrayIndexing"
	    set bytes [$api Tcl_GetByteArray $str]
	    set bytePtr [my getelementptr $bytes [list $idx]]
	    set byteResult [$api Tcl_NewByteArrayObj $bytePtr $1]
	    my br $done
	label byteIndex "fastStringIndexing"
	    set bytes [my dereference $str 0 Tcl_Obj.bytes]
	    set bytePtr [my getelementptr $bytes [list $idx]]
	    set asciiResult [$api Tcl_NewStringObj $bytePtr $1]
	    my br $done
	label strIdx "slowStringIndexing"
	    set ch [my cast(uint) [$api Tcl_GetUniChar $str $idx] "ch"]
	    set buf [my arrayAlloc char $sizeof(UTF_BYTES) "buf"]
	    set len [$api Tcl_UniCharToUtf $ch $buf]
	    set unicodeResult [$api Tcl_NewStringObj $buf $len]
	    my br $done
	label done:
	    set result [my phi \
		    [list $emptyResult $byteResult $asciiResult $unicodeResult] \
		    [list $empty $baIdx $byteIndex $strIdx] "result"]
	    my addReference(STRING) $result
	    my ret [my ok $result]
	label failed:
	    my store $1 $ecvar
	    my ret [my fail STRING]
	}

	##### Function tcl.strrange #####
	#
	# Type signature: objPtr:STRING * fromInt:INT * toInt:INT -> STRING
	#
	# Quadcode implementation ('strrange')
	#
	# Returns the string that is the substring of string 'objPtr' between
	# indices 'fromInt' and 'toInt' (which are both internally clamped to
	# the bounds of the string), or the empty string if 'fromInt' does not
	# precede 'toInt'.

	set f [$m local "tcl.strrange" STRING<-STRING,INT,INT]
	params str:objPtr from to
	build {
	    nonnull $str
	    set from [my max $0 [my cast(int) [my getInt64 $from]] "from"]
	    set len [my sub [$api Tcl_GetCharLength $str] $1]
	    set to [my min $len [my cast(int) [my getInt64 $to]] "to"]
	    my condBr [my ge $to $from] $realSubstring $empty
	label empty:
	    set value1 [$api Tcl_NewObj]
	    my br $finish
	label realSubstring:
	    set value2 [$api Tcl_GetRange $str $from $to]
	    my br $finish
	label finish:
	    set result [my phi [list $value1 $value2] \
		    [list $empty $realSubstring] "result"]
	    my addReference(STRING) $result
	    my ret $result
	}

	##### Function tcl.strrange.idx #####
	#
	# Type signature: objPtr:STRING * fromIdx:STRING * toIdx:STRING
	#			* ecvar:int* -> STRING?
	#
	# Quadcode implementation ('strrange')
	#
	# Returns the string that is the substring of string 'objPtr' between
	# indices 'fromIdx' and 'toIdx' (which are to be decoded as indices),
	# or the empty string if 'fromIdx' does not precede 'toIdx'.

	set f [$m local "tcl.strrange.idx" STRING?<-STRING,STRING,STRING,int*]
	params str:objPtr fromIdx toIdx ecvar
	build {
	    noalias $ecvar
	    nonnull $str $fromIdx $toIdx $ecvar
	    set interp [$api tclInterp]
	    set len [$api Tcl_GetCharLength $str]
	    set end [my sub $len $1 "end"]
	    my condBr [my GetIndex $interp $fromIdx $end from] \
		$getTo $failed
	label getTo:
	    my condBr [my GetIndex $interp $toIdx $end to] \
		$rangeCheck $failed
	label rangeCheck:
	    set from [my max $0 $from "fromIdx"]
	    set to [my min [my sub $len $1] $to "toIdx"]
	    my condBr [my ge $to $from] $realSubstring $empty
	label empty:
	    set value1 [$api Tcl_NewObj]
	    my br $finish
	label realSubstring:
	    set value2 [$api Tcl_GetRange $str $from $to]
	    my br $finish
	label finish:
	    set result [my phi [list $value1 $value2] \
		    [list $empty $realSubstring] "result"]
	    my addReference(STRING) $result
	    my ret [my ok $result]
	label failed:
	    my store $1 $ecvar
	    my ret [my fail STRING]
	}

	##### Function tcl.strreplace #####
	#
	# Type signature: objPtr:STRING * fromInt:INT * toInt:INT
	#			* substringPtr:STRING -> STRING
	#
	# Quadcode implementation ('strreplace')
	#
	# Returns the string that has the substring of string 'objPtr' between
	# indices 'fromInt' and 'toInt' (which are both internally clamped to
	# the bounds of the string) replaced with the string 'substringPtr'.

	set f [$m local "tcl.strreplace" STRING<-STRING,INT,INT,STRING]
	params str:stringPtr fromInt toInt substr:substringPtr
	build {
	    nonnull $str $substr
	    set from [my max $0 [my getInt32 $fromInt] "from"]
	    set to [my getInt32 $toInt "to"]
	    set length [my getInt32 [my strlen(STRING) $str] "length"]
	    my condBr [my or [my gt $from $to] [my gt $from $length]] \
		$returnString $checkIfTrivial
	label returnString "return.string"
	    my br $replaceDone
	label returnSubstring "return.substring"
	    my br $replaceDone
	label checkIfTrivial "check.trivial"
	    set to [my min $length $to "to"]
	    my condBr [my and [my eq $from $0] [my eq $to $length]] \
		$returnSubstring $checkRemoveTail
	label checkRemoveTail "check.remove.tail"
	    set length3 [my getInt32 [my strlen(STRING) $substr] "length3"]
	    set refCount [my refCount $str "refCount"]
	    my condBr [my and [my eq $length3 $0] [my eq $to $length]] \
		$testUnshared $checkIfInPlace
	label testUnshared "check.unshared"
	    my condBr [my le $refCount $1] $trimTail $checkIfInPlace
	label trimTail "replace.remove.tail"
	    $api Tcl_SetObjLength $str $from
	    my br $returnString
	label checkIfInPlace "check.in.place"
	    my condBr [my eq [my sub $length3 $1] [my sub $to $from]] \
		$inPlace $complex
	label inPlace "in.place"
	    my condBr [my le $refCount $1] $inPlaceTypecheck $inPlaceAlloc
	label inPlaceAlloc "in.place.dup"
	    set allocated [$api Tcl_DuplicateObj $str]
	    my br $inPlaceTypecheck
	label inPlaceTypecheck "in.place.typecheck"
	    set strIP [my phi [list $str $allocated] \
		    [list $inPlace $inPlaceAlloc]]
	    my condBr [my and \
		    [my isByteArray $strIP] \
		    [my isByteArray $substr]] \
		$inPlaceBA $inPlaceUni
	label inPlaceBA "in.place.bytes"
	    set bytes1 [$api Tcl_GetByteArray $strIP]
	    set bytes2 [$api Tcl_GetByteArray $substr]
	    my memcpy [my getelementptr $bytes1 [list $from]] $bytes2 $length3
	    $api TclInvalidateStringRep $strIP
	    my br $replaceDone
	label inPlaceUni "in.place.unicode"
	    set bytes1 [$api Tcl_GetUnicode $strIP]
	    set bytes2 [$api Tcl_GetUnicode $substr]
	    my memcpy [my getelementptr $bytes1 [list $from]] $bytes2 \
		[my mult $length3 $sizeof(Tcl_UniChar)]
	    my store $0 [my getelementptr [my cast(ptr) \
		    [my gep $strIP 0 Tcl_Obj.internalRep] int] [list $1]]
	    $api TclInvalidateStringRep $strIP
	    my br $replaceDone
	label complex "replace"
	    lassign [my GetUnicode $str str] length ustring1
	    my condBr [my eq $length3 $0] $removeSubstr $replaceSubstr
	label removeSubstr "replace.remove"
	    my condBr [my eq $from $0] $removeFront $removeBody
	label removeFront "replace.remove.front"
	    set newstrFront [$api Tcl_NewUnicodeObj \
		    [my getelementptr $ustring1 [my add $to $1]] \
		    [list [my sub $length $to]]]
	    my br $replaceDone
	label removeBody "replace.remove.body"
	    set newstr [$api Tcl_NewUnicodeObj $ustring1 $from]
	    my condBr [my lt $to $length] $removeBodyMid $replaceDone
	label removeBodyMid "replace.remove.body.mid"
	    $api Tcl_AppendUnicodeToObj $newstr \
		[my getelementptr $ustring1 [list [my add $to $1]]] \
		[my sub $length $to]
	    my br $replaceDone
	label replaceSubstr "replace.substr"
	    my condBr [my gt $from $0] $replaceMid $replaceFrontTest
	label replaceFrontTest "replace.substr.front.test"
	    my condBr [my shared $substr] \
		$replaceFrontShared $replaceFrontUnshared
	label replaceMid "replace.substr.mid"
	    set newstrMid [$api Tcl_NewUnicodeObj $ustring1 $from]
	    $api Tcl_AppendObjToObj $newstrMid $substr
	    my condBr [my lt $to $length] $replaceTail $replaceDone
	label replaceFrontShared "replace.substr.front.shared"
	    set newstrShared [$api Tcl_DuplicateObj $substr]
	    my condBr [my lt $to $length] $replaceTail $replaceDone
	label replaceFrontUnshared "replace.subst.front.unshared"
	    my condBr [my lt $to $length] $replaceTail $replaceDone
	label replaceTail "replace.subst.tail"
	    set sources [list $replaceMid $replaceFrontShared $replaceFrontUnshared]
	    set newstrTail [my phi [list $newstrMid $newstrShared $substr] \
		    $sources "tail"]
	    $api Tcl_AppendUnicodeToObj $newstrTail \
		[my getelementptr $ustring1 [list [my add $to $1]]] \
		[my sub [my sub $length $to] $1]
	    my br $replaceDone
	label replaceDone "done"
	    set sources [list $returnString $returnSubstring $inPlaceBA \
		    $inPlaceUni $removeFront $removeBody $removeBodyMid \
		    $replaceMid $replaceFrontShared $replaceFrontUnshared \
		    $replaceTail]
	    set values [list $str $substr $strIP $strIP $newstrFront $newstr \
		    $newstr $newstrMid $newstrShared $substr $newstrTail]
	    set newstr [my phi $values $sources]
	    my addReference(STRING) $newstr
	    my ret $newstr
	}

	##### Function tcl.strreplace.idx #####
	#
	# Type signature: objPtr:STRING * fromIdx:STRING * toIdx:STRING *
	#			* substringPtr:STRING * ecvar:int* -> STRING?
	#
	# Quadcode implementation ('strreplace')
	#
	# Returns the string that has the substring of string 'objPtr' between
	# indices 'fromIdx' and 'toIdx' (which are both internally clamped to
	# the bounds of the string) replaced with the string 'substringPtr'.

	set f [$m local "tcl.strreplace.idx" \
		   STRING?<-STRING,STRING,STRING,STRING,int*]
	params str:stringPtr fromIdx toIdx substr:substringPtr ecvar
	build {
	    noalias $ecvar
	    nonnull $str $fromIdx $toIdx $substr $ecvar
	    set interp [$api tclInterp]
	    set end [my sub [$api Tcl_GetCharLength $str] $1 "end"]
	    my condBr [my GetIndex $interp $fromIdx $end from] \
		$getTo $failed
	label getTo:
	    my condBr [my GetIndex $interp $toIdx $end to] \
		$rangeCheck $failed
	label rangeCheck:
	    set from [my packInt32 $from]
	    set to [my packInt32 $to]
	    set replaced [my Call tcl.strreplace $str $from $to $substr]
	    my ret [my ok $replaced]
	label failed:
	    my store $1 $ecvar
	    my ret [my fail STRING]
	}

	##### Function tcl.strmap #####
	#
	# Type signature: sourceObj:STRING * targetObj:STIRNG *
	#			stringObj:STRING -> STRING
	#
	# Quadcode implementation ('strmap')
	#
	# Returns the string that is a copy of string 'stringObj' with every
	# occurrence of string 'sourceObj' replaced with string 'targetObj'.

	set f [$m local "tcl.strmap" STRING<-STRING,STRING,STRING]
	params sourceObj targetObj stringObj
	build {
	    nonnull $sourceObj $targetObj $stringObj
	    my condBr [my eq $targetObj $sourceObj] $done $trivial1
	label trivial1:
	    my condBr [my eq $stringObj $sourceObj] $done $trivial2
	label trivial2:
	    lassign [my GetUnicode $stringObj "string"] strLen strPtr
	    my condBr [my eq $strLen $0] $done $trivial3
	label trivial3:
	    lassign [my GetUnicode $sourceObj "source"] srcLen srcPtr
	    my condBr [my or [my gt $srcLen $strLen] [my eq $srcLen $0]] \
		$done $trivial4
	label trivial4:
	    my condBr [my eq $strLen $srcLen] $wholesale $map
	label wholesale:
	    set cmp [my memcmp $strPtr $srcPtr \
		    [my mult $strLen $sizeof(Tcl_UniChar)]]
	    set wsres [my select [my eq $cmp $0] $targetObj $stringObj]
	    my br $done
	label map:
	    lassign [my GetUnicode $targetObj "target"] tgtLen tgtPtr
	    set result [$api Tcl_NewUnicodeObj $strPtr $0]
	    set srcPtr0 [my load $srcPtr]
	    set prevLoop [my uniqueUndef [TypeOf $strPtr] "prev"]
	    set curLoop [my uniqueUndef [TypeOf $strPtr] "cur"]
	    set end [my getelementptr $strPtr [list $strLen]]
	    my br $maplooptest1
	label maplooptest1 "map.loop.test"
	    set sources [list $map $maploopnext]
	    set cur [my phi [list $strPtr $curLoop] $sources "cur"]
	    set prev [my phi [list $strPtr $prevLoop] $sources "prev"]
	    my condBr [my lt $cur $end] $maplooptest2 $mapdone
	label maplooptest2 "map.loop.test"
	    my condBr [my eq [my load $cur] $srcPtr0] \
		$maplooptest3 $maploopnext
	label maplooptest3 "map.loop.test"
	    my condBr [my eq $srcLen $1] $maplooptest5 $maplooptest4
	label maplooptest4 "map.loop.test"
	    set cmp [my memcmp $cur $srcPtr \
		    [my mult $srcLen $sizeof(Tcl_UniChar)]]
	    my condBr [my eq $cmp $0] $maplooptest5 $maploopnext
	label maplooptest5 "map.loop.test"
	    my condBr [my eq $prev $cur] $maploopbody1 $maploopbody2
	label maploopbody1 "map.loop.body"
	    my br $maploopbody3
	label maploopbody2 "map.loop.body"
	    $api Tcl_AppendUnicodeToObj $result $prev \
		[my cast(int) [my diff $cur $prev] "len"]
	    my br $maploopbody3
	label maploopbody3 "map.loop.body"
	    set sources [list $maploopbody1 $maploopbody2]
	    set prev2 [my phi [list $prev $cur] $sources "prev"]
	    set prev3 [my getelementptr $prev2 [list $srcLen] "prev"]
	    set cur2 [my getelementptr $prev3 [list ${-1}] "cur"]
	    $api Tcl_AppendUnicodeToObj $result $tgtPtr $tgtLen
	    my br $maploopnext
	label maploopnext "map.loop.next"
	    set sources [list $maplooptest2 $maplooptest4 $maploopbody3]
	    set prev4 [my phi [list $prev $prev $prev3] $sources "prev"]
	    set cur3 [my phi [list $cur $cur $cur2] $sources "cur"]
	    ReplaceAllUsesWith $prevLoop $prev4
	    ReplaceAllUsesWith $curLoop \
		[my getelementptr $cur3 [list $1] "cur"]
	    my br $maplooptest1
	label mapdone "map.done"
	    my assume [my not [my shared $result]]
	    my condBr [my eq $prev $cur] $done $maplast
	label maplast "map.addLast"
	    $api Tcl_AppendUnicodeToObj $result $prev \
		[my cast(int) [my diff $cur $prev] "len"]
	    my assume [my not [my shared $result]]
	    my br $done
	label done:
	    set sources [list $entry $trivial1 $trivial2 $trivial3 \
		    $wholesale $mapdone $maplast]
	    set result [my phi [list $stringObj $targetObj $stringObj \
		    $stringObj $wsres $result $result] $sources "result"]
	    my addReference(STRING) $result
	    my ret $result
	}

	##### Function tcl.strtrim #####
	#
	# Type signature: stringObj:STRING * trimsetObj:STRING * which:int32
	#			-> STRING
	#
	# Quadcode implementation ('strtrim')
	#
	# Returns the string that is a copy of 'stringObj' with the characters
	# that are in the string 'trimsetObj' removed from the start and/or
	# end. The 'which' parameter determines where the characters are to be
	# removed from; when less than zero it removes from the beginning,
	# when greater than zero from the end, and when zero it removes from
	# both the beginning and the end.

	set f [$m local "tcl.strtrim" STRING<-STRING,STRING,int]
	params stringObj trimsetObj which
	build {
	    nonnull $stringObj $trimsetObj
	    lassign [my GetString $stringObj "string"] stringLen string
	    lassign [my GetString $trimsetObj "trimset"] trimsetLen trimset
	    my condBr [my or [my eq $stringLen $0] [my eq $trimsetLen $0]] \
		$returnString $okToSearch
	label okToSearch:
	    my condBr [my le $which $0] $computeLeft $next
	label computeLeft:
	    set left0 [my call ${tcl.impl.trimleft} [list \
		    $string $stringLen $trimset $trimsetLen] "left"]
	    my br $next
	label next:
	    set sources [list $okToSearch $computeLeft]
	    set left [my phi [list $0 $left0] $sources "left"]
	    my condBr [my and [my ge $which $0] [my lt $left $stringLen]] \
		    $computeRight $createTrimmedString
	label computeRight:
	    set right0 [my call ${tcl.impl.trimright} [list \
		    $string $stringLen $trimset $trimsetLen] "right"]
	    my br $createTrimmedString
	label createTrimmedString:
	    set sources [list $next $computeRight]
	    set right [my phi [list $0 $right0] $sources "right"]
	    my condBr [my and [my eq $left $0] [my eq $right $0]] \
		$returnString $doTrim
	label doTrim:
	    set result [$api Tcl_NewStringObj \
		    [my getelementptr $string [list $left] "C"] \
		    [my sub [my sub $stringLen $left "A"] $right "B"]]
	    my br $returnString
	label returnString:
	    set sources [list $entry $createTrimmedString $doTrim]
	    set result [my phi [list $stringObj $stringObj $result] $sources \
		    "result"]
	    my addReference(STRING) $result
	    my ret $result
	}

	##### Function tcl.strcase #####
	#
	# Type signature: string:STRING * kind:int32 -> STRING
	#
	# Quadcode implementation ('strrange')
	#
	# Returns the string that is a copy of 'string' with the case
	# transformation described in 'kind' applied. 0 means convert to upper
	# case, 1 means convert to lower case, and 2 means convert to title
	# case.

	set f [$m local "tcl.strcase" STRING<-STRING,int]
	params string kind
	build {
	    nonnull $string
	    my condBr [my shared $string] $duplicate $apply
	label duplicate:
	    lassign [my GetString $string "string"] l1 s1
	    set copy [$api Tcl_NewStringObj $s1 $l1]
	    my br $apply
	label apply:
	    set sources [list $entry $duplicate]
	    set string [my phi [list $string $copy] $sources "string"]
	    set copied [my phi [list [Const false bool] [Const true bool]] \
		    $sources "copied"]
	    set content [$api Tcl_GetString $string]
	    my switch $kind $title 0 $upper 1 $lower
	label upper:
	    set len1 [$api Tcl_UtfToUpper $content]
	    my br $setLength
	label lower:
	    set len2 [$api Tcl_UtfToLower $content]
	    my br $setLength
	label title:
	    set len3 [$api Tcl_UtfToTitle $content]
	    my br $setLength
	label setLength "set.length"
	    set length [my phi [list $len1 $len2 $len3] \
		    [list $upper $lower $title] "length"]
	    $api Tcl_SetObjLength $string $length
	    my condBr $copied $releaseIntRep $done
	label releaseIntRep "release.internal.representation"
	    $api TclFreeIntRep $string
	    my br $done
	label done:
	    my addReference(STRING) $string
	    my ret $string
	}

	##### Function tcl.maptoint #####
	#
	# Type signature: value:STRING * mapping:STRING * notThere:int -> INT
	#
	# Quadcode implementation ('maptoint')
	#
	# Returns the INT looked up in 'mapping' that corresponds to 'value'.
	# If the value is absent, returns the 'notThere' value.

	set f [$m local "tcl.maptoint" INT<-STRING,HashTable*,int]
	params value mapping notThere
	build {
	    nonnull $value $mapping
	    set offset [$api TclFindHashEntry $mapping $value]
	    SetValueName $offset "offsetPtr"
	    my condBr [my nonnull $offset] $present $absent
	label present:
	    set offset [$api Tcl_GetHashValue $offset int]
	    SetValueName $offset "offset"
	    my ret [my packInt32 $offset]
	label absent:
	    my ret [my packInt32 $notThere]
	}

	##### Function tcl.concatenate #####
	#
	# Type signature: len:int * ary:STRING* -> STRING
	#
	# Quadcode implementation ('concat')
	#
	# Returns the application of Tcl_ConcatObj() to the given values, so
	# much so that it is just a very thin wrapper around that function.

	set f [$m local "tcl.concatenate" STRING<-int,STRING*]
	params len ary
	build {
	    nonnull $ary
	    set result [$api Tcl_ConcatObj $len $ary]
	    my addReference(STRING) $result
	    my ret $result
	}
    }

    # Builder:ListFunctions --
    #
    #	Generate the functions that implement the list-handling operators.
    #	Only called from StringFunctions method.
    #
    # Parameters:
    #	api -	The handle of the Tcl API object (currently an instance of the
    #		Thunk class).
    #
    # Results:
    #	None.

    method ListFunctions {api} {
	upvar 1 0 0 1 1 -1 -1

	##### Function tcl.impl.listDupe #####
	##### Closure Build:ListDupe #####
	#
	# Type signature: interp:Interp* * obj:STRING -> STRING
	#
	# Replacement for non-exposed TclListObjCopy().

	set f [$m local "tcl.impl.listDupe" STRING<-Interp*,STRING]
	unset -nocomplain interp objPtr name
	my closure ListDupe {interp objPtr {name ""}} {
	    if {$interp eq ""} {
		set interp [my null Interp*]
	    }
	    my call ${tcl.impl.listDupe} [list $interp $objPtr] $name
	}
	params interp obj
	build {
	    noalias $interp $obj
	    nonnull $obj
	    set listType [$api tclListType]
	    set typePtr [my dereference $obj 0 Tcl_Obj.typePtr]
	    my condBr [my neq $typePtr $listType] \
		$forceType $ok
	label forceType:
	    my condBr [my eq [my setFromAny $listType $interp $obj] $0] \
		$ok $fail
	label ok:
	    set new [$api Tcl_NewObj]
	    $api TclInvalidateStringRep $new
	    set func [my dereference $listType 0 ObjType.dupIntRepProc]
	    set call [my Call $func $obj $new]
	    AddCallAttribute $call 1 nocapture
	    AddCallAttribute $call 2 nocapture
	    my ret $new
	label fail:
	    my ret [my null STRING]
	}

	##### Function tcl.list.create #####
	#
	# Type signature: objc:int * objv:STRING* -> STRING
	#
	# Core of quadcode implementation ('list')
	#
	# Wrapper around Tcl_NewListObj that exposes it to the general
	# instruction issuing code.

	set f [$m local "tcl.list.create" STRING<-int,STRING*]
	params objc objv
	build {
	    nonnull $objv
	    set val [$api Tcl_NewListObj $objc $objv]
	    my addReference(STRING) $val
	    my ret $val
	}

	##### Function tcl.list.length #####
	#
	# Type signature: list:STRING * ecvar:int* -> INT?
	#
	# Core of quadcode implementation ('listLength')
	#
	# Wrapper around Tcl_ListObjLength that exposes it to the general
	# instruction issuing code.

	set f [$m local "tcl.list.length" INT?<-STRING,int*]
	params list ecvar
	build {
	    noalias $list $ecvar
	    nonnull $list $ecvar
	    set interp [$api tclInterp]
	    set var [my alloc int "length"]
	    set code [$api Tcl_ListObjLength $interp $list $var]
	    my condBr [my eq $code $0] $ok $fail
	label ok:
	    my ret [my cast(INT?) [my load $var]]
	label fail:
	    my store $1 $ecvar
	    my ret [my fail INT]
	}

	##### Function tcl.list.append #####
	#
	# Type signature: list:STRING * value:STRING * ecvar:int* -> STRING?
	#
	# Core of quadcode implementation ('listAppend')
	#
	# Wrapper around Tcl_ListObjLength that exposes it to the general
	# instruction issuing code.

	set f [$m local "tcl.list.append" STRING?<-STRING,STRING,int*]
	params list value ecvar
	build {
	    noalias $ecvar
	    nonnull $list $value $ecvar
	    set interp [$api tclInterp]
	    my condBr [my shared $list] $sharedDupe $unshared
	label sharedDupe "shared.duplicate"
	    set copy [my ListDupe $interp $list "copy"]
	    my condBr [my nonnull $copy] $shared $error
	label shared:
	    $api Tcl_ListObjAppendElement {} $copy $value
	    my br $return
	label unshared:
	    set code [$api Tcl_ListObjAppendElement $interp $list $value]
	    my condBr [my eq $code $0] $return $error
	label return:
	    set list [my phi [list $copy $list] [list $shared $unshared] "list"]
	    $api TclInvalidateStringRep $list
	    my addReference(STRING) $list
	    my condBr [my shared $value] $exit $extraRef
	label extraRef "add.extra.reference.to.value"
	    my addReference(STRING) $value
	    my br $exit
	label exit:
	    my ret [my ok $list]
	label error:
	    my store $1 $ecvar
	    my ret [my fail STRING]
	}

	##### Function tcl.list.concat #####
	#
	# Type signature: list:STRING * value:STRING * ecvar:int* -> STRING?
	#
	# Core of quadcode implementation ('listConcat')
	#
	# Wrapper around Tcl_ListObjLength that exposes it to the general
	# instruction issuing code.

	set f [$m local "tcl.list.concat" STRING?<-STRING,STRING,int*]
	params list value ecvar
	build {
	    noalias $ecvar
	    nonnull $list $value $ecvar
	    set interp [$api tclInterp]
	    set objc [my alloc int "objc"]
	    set objv [my alloc STRING* "objv"]
	    set code [$api Tcl_ListObjLength $interp $list $objc]
	    my condBr [my eq $code $0] $checkValue $error
	label checkValue "check.value.for.listness"
	    set len [my load $objc "len"]
	    set code [$api Tcl_ListObjGetElements $interp $value $objc $objv]
	    my condBr [my eq $code $0] $checkDupe $error
	label checkDupe "check.whether.to.duplicate"
	    my condBr [my shared $list] $dupe $concat
	label dupe "duplicate"
	    set copy [my ListDupe {} $list "copy"]
	    my br $concat
	label concat:
	    set working [my phi [list $list $copy] [list $checkDupe $dupe] "list"]
	    set objc [my load $objc "objc"]
	    set objv [my load $objv "objv"]
	    $api Tcl_ListObjReplace {} $working $len $0 $objc $objv
	    my addReference(STRING) $working
	    my ret [my ok $working]
	label error:
	    my store $1 $ecvar
	    my ret [my fail STRING]
	}

	##### Function tcl.list.index #####
	#
	# Type signature: list:STRING * idxc:int * idxv:STRING* * ecvar:int*
	#			-> STRING?
	#
	# Core of quadcode implementation ('listIndex')
	#
	# Effectively an implementation of TclLindexFlat.

	set f [$m local "tcl.list.index" STRING?<-STRING,int,STRING*,int*]
	params list idxc idxv ecvar
	build {
	    noalias $list $idxv $ecvar
	    nonnull $list $idxv $ecvar
	    set interp [$api tclInterp]
	    set iPtr [my alloc int "&i"]
	    set listPtr [my alloc STRING "&list"]
	    set listLenPtr [my alloc int "&listLen"]
	    set elemPtrsPtr [my alloc STRING* "&elemPtrs"]
	    my addReference(STRING) $list
	    my store $0 $iPtr
	    my store $list $listPtr
	    my br $loopTest
	label loopTest:
	    set i [my load $iPtr "i"]
	    set list [my load $listPtr "list"]
	    my condBr [my and [my lt $i $idxc] [my nonnull $list]] \
		$loop $done
	label loop:
	    my store $0 $listLenPtr
	    my store [my null STRING*] $elemPtrsPtr
	    set sublistCopy [my ListDupe $interp $list "sublistCopy"]
	    my dropReference $list
	    my store [my null STRING] $listPtr
	    my condBr [my nonnull $sublistCopy] $loop2 $error
	label loop2:
	    $api Tcl_ListObjGetElements {} $sublistCopy $listLenPtr $elemPtrsPtr
	    set listLen [my load $listLenPtr "listLen"]
	    set elemPtrs [my load $elemPtrsPtr "elemPtrs"]
	    my condBr [my GetIndex $interp \
			[my load [my getelementptr $idxv [list $i]]] \
			[my sub $listLen $1] index] \
		$loopIndex $loopNext
	label loopIndex:
	    my condBr [my and [my ge $index $0] [my lt $index $listLen]] \
		$loopIndexInRange $loopIndexOutOfRange
	label loopIndexInRange:
	    set list [my load [my getelementptr $elemPtrs [list $index]] "list"]
	    my store $list $listPtr
	    my addReference(STRING) $list
	    my br $loopNext
	label loopIndexOutOfRange:
	    my store [set i [my add [my load $iPtr] $1 "i"]] $iPtr
	    my condBr [my lt $i $idxc] $loopIndexValidityCheck $loopEmpty
	label loopEmpty:
	    my store [set list [$api Tcl_NewObj]] $listPtr
	    my addReference(STRING) $list
	    my br $loopNext
	label loopIndexValidityCheck:
	    my condBr [my GetIndex $interp \
		    [my load [my getelementptr $idxv [list $i]]] ${-1}] \
		$loopIndexOutOfRange $loopIndexBad
	label loopIndexBad:
	    my dropReference $sublistCopy
	    my br $error
	label loopNext:
	    my dropReference $sublistCopy
	    my store [my add [my load $iPtr "i"] $1] $iPtr
	    my br $loopTest
	label done:
	    set list [my load $listPtr "list"]
	    my ret [my ok $list]
	label error:
	    my store $1 $ecvar
	    my ret [my fail STRING]
	}

	##### Function tcl.list.index1 #####
	#
	# Type signature: list:STRING * index:INT * ecvar:int* -> STRING?
	#
	# Core of quadcode implementation ('listIndex')
	#
	# Basic list indexing in the case where we know that the index is an
	# integer, which avoids many of the failure modes.

	set f [$m local "tcl.list.index1" STRING?<-STRING,INT,int*]
	params list index ecvar
	build {
	    noalias $list $ecvar
	    nonnull $list $ecvar
	    set interp [$api tclInterp]
	    set idx [my getInt32 $index]
	    set objc [my alloc int "objc"]
	    set objv [my alloc STRING* "objv"]
	    set code [$api Tcl_ListObjGetElements $interp $list $objc $objv]
	    my condBr [my eq $code $0] $ok $fail
	label ok:
	    my condBr [my and [my ge $idx $0] [my lt $idx [my load $objc]]] \
		$realIndex $outOfBounds
	label realIndex "real.index"
	    set objv [my load $objv "objv"]
	    set obj [my load [my getelementptr $objv [list $idx]] "objPtr"]
	    my addReference(STRING) $obj
	    my ret [my ok $obj]
	label outOfBounds "out.of.bounds"
	    set obj [$api Tcl_NewObj]
	    my addReference(STRING) $obj
	    my ret [my ok $obj]
	label fail:
	    my store $1 $ecvar
	    my ret [my fail STRING]
	}

	##### Function tcl.list.indexList #####
	#
	# Type signature: list:STRING * index:STRING * ecvar:int* -> STRING?
	#
	# Core of quadcode implementation ('listIndex')
	#
	# Effectively an implementation of TclLindexList.

	set f [$m local "tcl.list.indexList" STRING?<-STRING,STRING,int*]
	params list index ecvar
	build {
	    noalias $ecvar
	    nonnull $list $index $ecvar
	    set interp [$api tclInterp]
	    set objc [my alloc int "objc"]
	    set objv [my alloc STRING* "objv"]
	    set code [$api Tcl_ListObjGetElements $interp $list $objc $objv]
	    my condBr [my eq $code $0] $checkType $notList
	label notList:
	    # We're not a list and we know it right now
	    my store $1 $ecvar
	    my ret [my fail STRING]
	label checkType:
	    my condBr [my neq [my dereference $index 0 Tcl_Obj.typePtr] \
			[$api tclListType]] \
		$checkIndex $slowPath
	label checkIndex:
	    set len [my load $objc]
	    my condBr [my GetIndex {} $index $len idx] \
		$immediateIndex $slowPath
	label immediateIndex:
	    my condBr [my and [my ge $idx $0] [my lt $idx $len]] \
		$realIndex $outOfBounds
	label realIndex "real.index"
	    set objv [my load $objv "objv"]
	    set obj [my load [my getelementptr $objv [list $idx]] "objPtr"]
	    my addReference(STRING) $obj
	    my ret [my ok $obj]
	label outOfBounds "out.of.bounds"
	    set obj [$api Tcl_NewObj]
	    my addReference(STRING) $obj
	    my ret [my ok $obj]
	label slowPath:
	    set dupe [my ListDupe $interp $index "copy"]
	    my condBr [my nonnull $dupe] $okIndex $notList
	label okIndex:
	    set listRep [my load [my cast(ptr) \
		    [my gep $dupe 0 Tcl_Obj.internalRep 0] \
		    TclList*] "listRep"]
	    set result [my Call tcl.list.index \
		    $list [my dereference $listRep 0 TclList.elemCount] \
		    [my gep $listRep 0 TclList.elements] $ecvar]
	    my dropReference $dupe
	    my ret $result
	}

	##### Function tcl.list.range #####
	#
	# Type signature: list:STRING * from:STRING * to:STRING -> STRING?
	#
	# Core of quadcode implementation ('listRangeImm')
	#
	# Wrapper around Tcl_NewListObj that exposes it to the general
	# instruction issuing code.

	set f [$m local "tcl.list.range" STRING?<-STRING,STRING,STRING,int*]
	params list from to ecvar
	build {
	    noalias $ecvar
	    nonnull $list $from $to $ecvar
	    set interp [$api tclInterp]
	    set objcVar [my alloc int]
	    set objvVar [my alloc STRING*]
	    set result [$api Tcl_ListObjLength $interp $list $objcVar]
	    my condBr [my eq $result $0] $getFrom $error
	label getFrom:
	    set objc [my load $objcVar "objc"]
	    set endIndex [my sub $objc $1]
	    my condBr [my GetIndex $interp $from $endIndex from] $getTo $error
	label getTo:
	    my condBr [my GetIndex $interp $to $endIndex to] $clamp $error
	label clamp:
	    set from [my select [my lt $from ${-1}] \
		    [my add $from [my add $1 $objc]] \
		    [my min $objc $from] \
		    "from"]
	    set from [my max ${-1} $from "from"]
	    set to [my select [my lt $to ${-1}] \
		    [my add $to [my add $1 $objc]] \
		    [my min $objc $to] \
		    "to"]
	    set to [my max ${-1} $to "to"]
	    my condBr [my and [my le $from $to] \
		    [my and [my lt $from $objc] [my ge $to $0]]] \
		$sublist $empty
	label sublist:
	    $api Tcl_ListObjGetElements {} $list $objcVar $objvVar
	    set objv [my load $objvVar "objv"]
	    set from [my max $0 $from "from"]
	    set to [my min [my sub $objc $1] $to "to"]
	    my condBr [my and [my eq $from $0] [my and \
		    [my neq $to [my sub $objc $1]] \
		    [my not [my shared $list]]]] \
		$sublistCheck $sublistNew
	label sublistCheck "sublist.inPlace.check"
	    # WARNING: BEWARE! This is looking inside the implementation of
	    # the list type.
	    set listPtr [my load [my cast(ptr) \
		    [my gep $list 0 Tcl_Obj.internalRep 0] \
		    TclList*] "listPtr"]
	    my condBr [my eq [my dereference $listPtr 0 TclList.refCount] $1] \
		$sublistInplace $sublistNew
	label sublistInplace "sublist.inPlace"
	    set onePast [my add $to $1 "onePast"]
	    set loopIndex [my uniqueUndef int "index"]
	    my br $sublistInplaceFreeTest
	label sublistInplaceFreeTest "sublist.inPlace.loop.test"
	    set sources [list $sublistInplace $sublistInplaceFree]
	    set index [my phi [list $onePast $loopIndex] $sources "index"]
	    my condBr [my lt $index $objc] \
		$sublistInplaceFree $sublistInplaceDone
	label sublistInplaceFree "sublist.inPlace.loop.body"
	    ReplaceAllUsesWith $loopIndex [my add $index $1 "index"]
	    set obj [my load [my getelementptr $objv [list $index]] "objPtr"]
	    my dropReference $obj
	    my br $sublistInplaceFreeTest
	label sublistInplaceDone "sublist.inPlace.done"
	    my storeInStruct $listPtr TclList.elemCount $onePast
	    my storeInStruct $listPtr TclList.canonicalFlag $1
	    $api TclInvalidateStringRep $list
	    my br $ok
	label sublistNew "sublist.new"
	    set r1 [$api Tcl_NewListObj [my add [my sub $to $from] $1] \
		    [my getelementptr $objv [list $from]]]
	    my br $ok
	label empty:
	    set r2 [$api Tcl_NewObj]
	    my br $ok
	label ok:
	    set sources [list $sublistInplaceDone $sublistNew $empty]
	    set result [my phi [list $list $r1 $r2] $sources "result"]
	    my addReference(STRING) $result
	    my ret [my ok $result]
	label error:
	    my store $1 $ecvar
	    my ret [my fail STRING]
	}

	##### Function tcl.list.range1 #####
	#
	# Type signature: list:STRING * from:INT * to:INT -> STRING?
	#
	# Core of quadcode implementation ('listRangeImm')
	#
	# Wrapper around Tcl_NewListObj that exposes it to the general
	# instruction issuing code.

	set f [$m local "tcl.list.range1" STRING?<-STRING,INT,INT,int*]
	params list from to ecvar
	build {
	    noalias $ecvar
	    nonnull $list $ecvar
	    set interp [$api tclInterp]
	    set from [my getInt32 $from "from"]
	    set to [my getInt32 $to "to"]
	    set objc [my alloc int "objc"]
	    set objv [my alloc STRING* "objv"]
	    set result [$api Tcl_ListObjGetElements $interp $list $objc $objv]
	    my condBr [my eq $result $0] $clamp $error
	label clamp:
	    set objc [my load $objc]
	    set objv [my load $objv]
	    set from [my select [my lt $from ${-1}] \
		    [my add $from [my add $1 $objc]] \
		    [my min $objc $from] \
		    "from"]
	    set from [my max ${-1} $from "from"]
	    set to [my select [my lt $to ${-1}] \
		    [my add $to [my add $1 $objc]] \
		    [my min $objc $to] \
		    "to"]
	    set to [my max ${-1} $to "to"]
	    my condBr [my and [my le $from $to] \
		    [my and [my lt $from $objc] [my ge $to $0]]] \
		$sublist $empty
	label sublist:
	    set from [my max $0 $from "from"]
	    set to [my min [my sub $objc $1] $to "to"]
	    my condBr [my and [my eq $from $0] [my and \
		    [my neq $to [my sub $objc $1]] \
		    [my not [my shared $list]]]] \
		$sublistCheck $sublistNew
	label sublistCheck "sublist.inPlace.check"
	    # WARNING: BEWARE! This is looking inside the implementation of
	    # the list type.
	    set listPtr [my load [my cast(ptr) \
		    [my gep $list 0 Tcl_Obj.internalRep 0] \
		    TclList*] "listPtr"]
	    my condBr [my eq [my dereference $listPtr 0 TclList.refCount] $1] \
		$sublistInplace $sublistNew
	label sublistInplace "sublist.inPlace"
	    set onePast [my add $to $1 "onePast"]
	    set loopIndex [my uniqueUndef int "index"]
	    my br $sublistInplaceFreeTest
	label sublistInplaceFreeTest "sublist.inPlace.free.test"
	    set sources [list $sublistInplace $sublistInplaceFree]
	    set index [my phi [list $onePast $loopIndex] $sources "index"]
	    my condBr [my lt $index $objc] \
		$sublistInplaceFree $sublistInplaceDone
	label sublistInplaceFree "sublist.inPlace.free"
	    ReplaceAllUsesWith $loopIndex [my add $index $1 "index"]
	    set obj [my load [my getelementptr $objv [list $index]] "objPtr"]
	    my dropReference $obj
	    my br $sublistInplaceFreeTest
	label sublistInplaceDone "sublist.inPlace.done"
	    my storeInStruct $listPtr TclList.elemCount $onePast
	    my storeInStruct $listPtr TclList.canonicalFlag $1
	    $api TclInvalidateStringRep $list
	    my br $ok
	label sublistNew "sublist.new"
	    set r1 [$api Tcl_NewListObj [my add [my sub $to $from] $1] \
		    [my getelementptr $objv [list $from]]]
	    my br $ok
	label empty:
	    set r2 [$api Tcl_NewObj]
	    my br $ok
	label ok:
	    set sources [list $sublistInplaceDone $sublistNew $empty]
	    set result [my phi [list $list $r1 $r2] $sources "result"]
	    my addReference(STRING) $result
	    my ret [my ok $result]
	label error:
	    my store $1 $ecvar
	    my ret [my fail STRING]
	}

	##### Function tcl.list.set #####
	#
	# Type signature: list:STRING * idxc:int * idxv:STRING* * elem:STRING
	#			* ecvar:int* -> STRING?
	#
	# Core of quadcode implementation ('lset')
	#
	# Approximately equivalent to TclLsetFlat

	set f [$m local "tcl.list.set" STRING?<-STRING,int,STRING*,STRING,int*]
	params list idxc idxv elem ecvar
	build {
	    noalias $idxv $ecvar
	    nonnull $list $idxv $elem $ecvar
	    set interp [$api tclInterp]
	    my condBr [my eq $idxc $0] $doNothing $sharedCheck
	label doNothing:
	    my addReference(STRING) $list
	    my ret [my ok $list]
	label sharedCheck:
	    my condBr [my shared $list] $duplicate $prepareToLoop
	label duplicate:
	    set dupe [$api Tcl_DuplicateObj $list]
	    my br $prepareToLoop
	label prepareToLoop:
	    set sources [list $sharedCheck $duplicate]
	    set retValue [my phi [list $list $dupe] $sources "retValue"]
	    set subList [my alloc STRING]
	    set chain [my alloc STRING]
	    set elemc [my alloc int]
	    set elemv [my alloc STRING*]
	    set idxArray [my alloc STRING*]
	    set idxCount [my alloc int]
	    my store $retValue $subList
	    my store [my null STRING] $chain
	    my store $idxv $idxArray
	    my store $idxc $idxCount
	    my br $loop1
	label loop1:
	    my condBr [my neq [$api Tcl_ListObjGetElements $interp \
		    [my load $subList] $elemc $elemv] $0] $loopFail $loop2
	label loop2:
	    set elemCount [my load $elemc "elemCount"]
	    set elemPtrs [my load $elemv "elemPtrs"]
	    set indexArray [my load $idxArray "indexArray"]
	    my condBr [my GetIndex $interp [my load $indexArray] \
		    [my load $elemc] index] \
		$loop3 $loopFail
	label loop3:
	    my store [my gep $indexArray 1] $idxArray
	    my condBr [my or [my lt $index $0] [my gt $index $elemCount]] \
		$loopRangeFail $loop4
	label loop4:
	    set idxc [my sub [my load $idxCount] $1]
	    my store $idxc $idxCount
	    my condBr [my gt $idxc $0] $loop5 $loopEnd
	label loop5:
	    set parent [my load $subList]
	    my condBr [my eq $index $elemCount] $newElem $existingElem
	label newElem:
	    set newSublist [$api Tcl_NewObj]
	    my br $loop6
	label existingElem:
	    set existingSublist [my load [my getelementptr $elemPtrs [list $index]]]
	    my condBr [my shared $existingSublist] $dupeElem $loop6
	label dupeElem:
	    set dupeSublist [$api Tcl_DuplicateObj $existingSublist]
	    my br $loop6
	label loop6:
	    set sublist [my phi \
		[list $newSublist $existingSublist $dupeSublist] \
		[list $newElem $existingElem $dupeElem] "sublist"]
	    my store $sublist $subList
	    my condBr [my eq $index $elemCount] $appendSublist $setSublist
	label appendSublist:
	    $api Tcl_ListObjAppendElement {} $parent $sublist
	    my br $loop7
	label setSublist:
	    $api TclListObjSetElement {} $parent $index $sublist
	    my br $loop7
	label loop7:
	    my condBr [my shared $sublist] $mustDuplicate $loop8
	label mustDuplicate:
	    set dupeSublist [$api Tcl_DuplicateObj $sublist]
	    $api TclListObjSetElement {} $parent $index $dupeSublist
	    my br $loop8
	label loop8:
	    my store [my load $chain] \
		[my cast(ptr) [my gep $parent 0 Tcl_Obj.internalRep 1] STRING]
	    my store $parent $chain
	    my br $loop1
	label loopRangeFail:
	    $api Tcl_SetObjResult $interp \
		[$api obj.constant "list index out of range"]
	    $api Tcl_SetObjErrorCode $interp \
		[$api obj.constant {TCL OPERATION LSET BADINDEX}]
	    my br $loopEnd
	label loopFail:
	    set obj [my load $chain]
	    my condBr [my nonnull $obj] $loopFailDrop $loopFailDone
	label loopFailDrop:
	    set ptr2 [my cast(ptr) [my gep $obj 0 Tcl_Obj.internalRep 1] STRING]
	    my store [my load $ptr2] $chain
	    my store [my null STRING] $ptr2
	    my br $loopFail
	label loopFailDone:
	    my condBr [my neq $retValue $list] \
		$loopFailDropOverall $loopFailExit
	label loopFailDropOverall:
	    my dropReference $retValue
	    my br $loopFailExit
	label loopFailExit:
	    my store $1 $ecvar
	    my ret [my fail STRING]
	label loopEnd:
	    set sublist [my load $subList]
	    set obj [my load $chain]
	    my condBr [my nonnull $obj] $loopEndDrop $terminalSet
	label loopEndDrop:
	    set ptr2 \
		[my cast(ptr) [my gep $obj 0 Tcl_Obj.internalRep 1] STRING]
	    my store [my load $ptr2] $chain
	    my store [my null STRING] $ptr2
	    $api TclInvalidateStringRep $obj
	    my br $loopEnd
	label terminalSet:
	    $api Tcl_ListObjLength {} $sublist $elemc
	    my condBr [my eq $index [my load $elemc]] $termSetAdd $termSetSet
	label termSetAdd:
	    $api Tcl_ListObjAppendElement {} $sublist $elem
	    my br $exit
	label termSetSet:
	    $api TclListObjSetElement {} $sublist $index $elem
	    my br $exit
	label exit:
	    $api TclInvalidateStringRep $sublist
	    my addReference(STRING) $retValue
	    my condBr [my shared $elem] $exit2 $exit3
	label exit3 "exit"
	    my addReference(STRING) $elem
	    my br $exit2
	label exit2 "exit"
	    my ret [my ok $retValue]
	}

	##### Function tcl.list.set1 #####
	#
	# Type signature: list:STRING * index:INT * elem:STRING * ecvar:int*
	#			-> STRING?
	#
	# Core of quadcode implementation ('lset')
	#
	# Wrapper around TclListObjSetElement that exposes it to the general
	# instruction issuing code.

	set f [$m local "tcl.list.set1" STRING?<-STRING,INT,STRING,int*]
	params list idx elem ecvar
	build {
	    noalias $ecvar
	    nonnull $list $elem $ecvar
	    set idx [my getInt32 $idx "index"]
	    set interp [$api tclInterp]
	    set duped [my Dedup list]
	    set objc [my alloc int "objc"]
	    set objv [my alloc STRING* "objv"]
	    set code [$api Tcl_ListObjGetElements $interp $list $objc $objv]
	    my condBr [my eq $code $1] $out $rangeCheck
	label rangeCheck "range.check"
	    set objc [my load $objc]
	    my condBr [my or [my lt $idx $0] [my gt $idx $objc]] \
		$outRange $checkOperation
	label checkOperation "operation.check"
	    set rc [my refCount $list]
	    my condBr [my eq $idx $objc] $append $set
	label append:
	    $api Tcl_ListObjAppendElement {} $list $elem
	    my br $done
	label set:
	    set call [$api TclListObjSetElement {} $list $idx $elem]
	    my br $done
	label done:
	    my assume [my eq $rc [my refCount $list]]
	    $api TclInvalidateStringRep $list
	    my addReference(STRING) $list
	    my condBr [my shared $elem] $exit2 $exit3
	label exit3 "exit"
	    my addReference(STRING) $elem
	    my br $exit2
	label exit2 "exit"
	    my ret [my ok $list]
	label outRange "failure.outOfRange"
	    $api Tcl_SetObjResult $interp \
		[$api obj.constant "list index out of range"]
	    $api Tcl_SetObjErrorCode $interp \
		[$api obj.constant {TCL OPERATION LSET BADINDEX}]
	    my br $out
	label out "failure.exit"
	    my Call obj.cleanup $duped
	    my store $1 $ecvar
	    my ret [my fail STRING]
	}

	##### Function tcl.list.setList #####
	#
	# Type signature: list:STRING * idxArg:STRING * elem:STRING
	#			* ecvar:int* -> STRING?
	#
	# Core of quadcode implementation ('lset')
	#
	# Approximately equivalent to TclLsetList

	set f [$m local "tcl.list.setList" STRING?<-STRING,STRING,STRING,int*]
	params list idxArg elem ecvar
	build {
	    noalias $ecvar
	    nonnull $list $idxArg $elem $ecvar
	    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"
	    set ary [my alloc STRING]
	    my store $idxArg $ary
	    my ret [my Call tcl.list.set $list $1 $ary $elem $ecvar]
	label doCopy "copy"
	    set argc [my alloc int]
	    set argv [my alloc STRING*]
	    set code [$api Tcl_ListObjGetElements {} $idxArg $argc $argv]
	    my condBr [my eq $code $0] $doCopy2 $doFlat
	label doCopy2 "delegate"
	    set copy [$api Tcl_NewListObj [my load $argc] [my load $argv]]
	    $api Tcl_ListObjGetElements {} $copy $argc $argv
	    set code [my Call tcl.list.set \
		$list [my load $argc] [my load $argv] $elem $ecvar]
	    my dropReference $copy
	    my ret $code
	}

	##### Function tcl.list.in #####
	#
	# Type signature: value:STRING * list:STRING * ecVar:int* -> ZEROONE?
	#
	# Core of quadcode implementation ('listIn')
	#
	# Determines if the value is present in the list, using simple string
	# comparison.

	set f [$m local "tcl.list.in" ZEROONE?<-STRING,STRING,int*]
	params value list ecVar
	build {
	    noalias $ecVar
	    nonnull $value $list $ecVar
	    set interp [$api tclInterp]
	    lassign [my GetString $value "string"] len1 bytes1
	    set lenVar [my alloc int]
	    set objvVar [my alloc STRING*]
	    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"]
	    set iLoop [my uniqueUndef int "i"]
	    my condBr [my gt $objc $0] $loop $done
	label loop:
	    set i [my phi [list $0 $iLoop] [list $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:
	    ReplaceAllUsesWith $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 [list [Const false bool] [Const false bool] [Const true bool]] \
		    [list $realCheck $loopNext $loopCompare] "flag"]
	    my ret [my ok $flag]
	}

	##### Function tcl.list.unshare #####
	#
	# Type signature: list:STRING -> STRING
	#
	# Core of quadcode implementation ('unshareList')
	#
	# Approximately equivalent to TclListObjCopy

	set f [$m local "tcl.list.unshare" STRING<-STRING]
	params list
	build {
	    nonnull $list
	    my condBr [my shared $list] $unshare $done
	label unshare:
	    set copy [my ListDupe {} $list "copy"]
	    my br $done
	label done:
	    set copy [my phi [list $list $copy] [list $entry $unshare] "copy"]
	    my addReference(STRING) $copy
	    my ret $copy
	}

	##### Function tcl.list.foreach.start #####
	#
	# Type signature: len:int * varListLength:int* * listArray:STRING*
	#			* ecvar:int* -> FOREACH?
	#
	# Core of quadcode implementation ('foreachStart')
	#
	# Applies runtime checks to determine the number of iterations to make
	# (at most) and work out whether the lists are really lists.

	set f [$m local "tcl.list.foreach.start" FOREACH?<-int,int*,STRING*,int*]
	params len varListLength listArray ecVar
	build {
	    noalias $varListLength $listArray $ecVar
	    nonnull $varListLength $listArray $ecVar
	    set interp [$api tclInterp]
	    set objcVar [my alloc int]
	    set maxLoop [my uniqueUndef int "max"]
	    set iLoop [my uniqueUndef int "i"]
	    my br $loopStart
	label loopStart:
	    set sources [list $entry $loopMax]
	    set max [my phi [list $0 $maxLoop] $sources "max"]
	    set i [my phi [list $0 $iLoop] $sources "i"]
	    my condBr [my lt $i $len] $loopBody $ok
	label loopBody:
	    set numVars [my load [my getelementptr $varListLength [list $i]] "numVars"]
	    set listPtr [my load [my getelementptr $listArray [list $i]] "listPtr"]
	    set code [$api Tcl_ListObjLength $interp $listPtr $objcVar]
	    my condBr [my eq $code $0] $loopMax $fail
	label loopMax:
	    set objc [my load $objcVar "objc"]
	    set iterTmp [my div [my add $objc [my sub $numVars $1]] $numVars]
	    ReplaceAllUsesWith $maxLoop [my max $iterTmp $max "max"]
	    ReplaceAllUsesWith $iLoop [my add $i $1 "i"]
	    my br $loopStart
	label ok:
	    set pair [my undef FOREACH]
	    set pair [my insert $pair $0 FOREACH.val]
	    set pair [my insert $pair $max FOREACH.max]
	    my ret [my ok $pair]
	label fail:
	    my store $1 $ecVar
	    my ret [my fail FOREACH]
	}

	##### Function tcl.list.foreach.getStep #####
	#
	# Type signature: pair:FOREACH -> INT
	#
	# Core of quadcode implementation ('foreachIter')
	#
	# Part of how lists are iterated over. This is broken up into several
	# pieces because of the number of different things assigned to. This
	# part gets the iteration count.

	set f [$m local "tcl.list.foreach.getStep" INT<-FOREACH readnone]
	params pair
	build {
	    my ret [my packInt32 [my extract $pair FOREACH.val]]
	}

	##### Function tcl.list.foreach.mayStep #####
	#
	# Type signature: pair:FOREACH -> ZEROONE
	#
	# Core of quadcode implementation ('foreachMayStep')
	#
	# Part of how lists are iterated over. This is broken up into several
	# pieces because of the number of different things assigned to. This
	# part gets whether the end of the iterations has been reached.

	set f [$m local "tcl.list.foreach.mayStep" ZEROONE<-FOREACH readnone]
	params pair
	build {
	    set val [my extract $pair FOREACH.val]
	    set max [my extract $pair FOREACH.max]
	    my ret [my lt $val $max]
	}

	##### Function tcl.list.foreach.nextStep #####
	#
	# Type signature: pair:FOREACH -> FOREACH
	#
	# Core of quadcode implementation ('foreachAdvance')
	#
	# Part of how lists are iterated over. This is broken up into several
	# pieces because of the number of different things assigned to. This
	# part computes the next iteration step.

	set f [$m local "tcl.list.foreach.nextStep" FOREACH<-FOREACH readnone]
	params pair
	build {
	    set val [my extract $pair FOREACH.val]
	    my ret [my insert $pair [my add $val $1] FOREACH.val]
	}
    }

    # Builder:DictionaryFunctions --
    #
    #	Generate the functions that implement the dict-handling operators.
    #	Only called from StringFunctions method.
    #
    # Parameters:
    #	api -	The handle of the Tcl API object (currently an instance of the
    #		Thunk class).
    #
    # Results:
    #	None.

    method DictionaryFunctions {api} {
	upvar 1 0 0 1 1

	##### Function tcl.dict.exists1 #####
	#
	# Type signature: dict:STRING * key:STRING -> ZEROONE
	#
	# Tests if a key is in a dictionary.

	set f [$m local "tcl.dict.exists1" ZEROONE<-STRING,STRING]
	params dict key
	build {
	    nonnull $dict $key
	    set resvar [my alloc STRING "valueVar"]
	    my store [my null STRING] $resvar
	    set result [$api Tcl_DictObjGet {} $dict $key $resvar]
	    my ret [my and [my eq $result $0] \
		    [my nonnull [my load $resvar "value"]] \
		    "exists"]
	}

	##### Function tcl.dict.exists #####
	#
	# Type signature: dict:STRING * pathlen:int * pathobjs:STRING*
	#			* ecvar:int32* -> ZEROONE
	#
	# Gets a value by key from a dictionary.  Can fail if the "dict" is
	# not a valid dictionary.

	set f [$m local "tcl.dict.exists" ZEROONE<-STRING,int,STRING*]
	params dict keyc keyv
	build {
	    noalias $dict $keyv
	    nonnull $dict $keyv
	    my condBr [my eq $keyc $0] $verify $exists
	label verify:
	    set dummy [my alloc int "dummy"]
	    set code [$api Tcl_DictObjSize {} $dict $dummy]
	    my ret [my eq $code $0]
	label exists:
	    set n [my sub $keyc $1]
	    set dict [$api TclTraceDictPath {} $dict $n $keyv $0]
	    SetValueName $dict "dictObj"
	    my condBr [my nonnull $dict] $lookup $notOK
	label lookup:
	    set resvar [my alloc STRING "valueVar"]
	    my store [my null STRING] $resvar
	    set key [my load [my getelementptr $keyv [list $n]] "key"]
	    set result [$api Tcl_DictObjGet {} $dict $key $resvar]
	    my ret [my and [my eq $result $0] \
		    [my nonnull [my load $resvar "value"]] \
		    "exists"]
	label notOK:
	    my ret [Const false bool]
	}

	##### Function tcl.dict.size #####
	#
	# Type signature: dict:STRING * ecvar:int32* -> INT?
	#
	# Gets the size of a dictionary. Can fail if the "dict" is not a valid
	# dictionary.

	set f [$m local "tcl.dict.size" INT?<-STRING,int*]
	params dict ecvar
	build {
	    noalias $ecvar
	    nonnull $dict $ecvar
	    set interp [$api tclInterp]
	    set size [my alloc int "size"]
	    set code [$api Tcl_DictObjSize $interp $dict $size]
	    my condBr [my eq $code $0] $ok $fail
	label ok:
	    my ret [my cast(INT?) [my load $size]]
	label fail:
	    my store $1 $ecvar
	    my ret [my fail INT]
	}

	##### Function tcl.dict.get1 #####
	#
	# Type signature: dict:STRING * key:STRING * ecvar:int32* -> STRING?
	#
	# Gets a value by key from a dictionary.  Can fail if the "dict" is
	# not a valid dictionary.

	set f [$m local "tcl.dict.get1" STRING?<-STRING,STRING,int*]
	params dict key ecvar
	build {
	    noalias $ecvar
	    nonnull $dict $key $ecvar
	    set interp [$api tclInterp]
	    set resvar [my alloc STRING "valueVar"]
	    set result [$api Tcl_DictObjGet $interp $dict $key $resvar]
	    my condBr [my eq $result $0] $OK $notOK
	label OK:
	    set value [my load $resvar "value"]
	    my condBr [my nonnull $value] $return $fail
	label return:
	    my addReference(STRING) $value
	    my ret [my ok $value]
	label fail:
	    set keyval [$api Tcl_GetString $key]
	    $api Tcl_SetObjResult $interp \
		[$api Tcl_ObjPrintf [my constString \
			"key \"%s\" not known in dictionary"] \
		    $keyval]
	    $api Tcl_SetErrorCode $interp \
		[my constString TCL] [my constString LOOKUP] \
		[my constString DICT] $keyval [my null char*]
	    my br $notOK
	label notOK:
	    my store $1 $ecvar
	    my ret [my fail STRING]
	}

	##### Function tcl.dict.get #####
	#
	# Type signature: dict:STRING * pathlen:int * pathobjs:STRING*
	#			* ecvar:int32* -> STRING?
	#
	# Gets a value by key from a dictionary.  Can fail if the "dict" is
	# not a valid dictionary.

	set f [$m local "tcl.dict.get" STRING?<-STRING,int,STRING*,int*]
	params dict keyc keyv ecvar
	build {
	    noalias $dict $keyv $ecvar
	    nonnull $dict $keyv $ecvar
	    set interp [$api tclInterp]
	    my condBr [my eq $keyc $0] $verify $get
	label verify:
	    set dummy [my alloc int "dummy"]
	    set code [$api Tcl_DictObjSize $interp $dict $dummy]
	    my condBr [my eq $code $0] $return $notOK
	label get:
	    set n [my sub $keyc $1]
	    set dict2 [$api TclTraceDictPath $interp $dict $n $keyv $0]
	    SetValueName $dict2 "dictObj"
	    my condBr [my nonnull $dict2] $lookup $notOK
	label lookup:
	    set resvar [my alloc STRING "valueVar"]
	    set key [my load [my getelementptr $keyv [list $n]] "key"]
	    set result [$api Tcl_DictObjGet $interp $dict2 $key $resvar]
	    my condBr [my eq $result $0] $OK $fail
	label OK:
	    set value [my load $resvar "value"]
	    my condBr [my nonnull $value] $return $fail
	label return:
	    set value [my phi [list $dict $value] [list $verify $OK] "value"]
	    my addReference(STRING) $value
	    my ret [my ok $value]
	label fail:
	    set keyval [$api Tcl_GetString $key]
	    $api Tcl_SetObjResult $interp \
		[$api Tcl_ObjPrintf [my constString \
			"key \"%s\" not known in dictionary"] \
		    $keyval]
	    $api Tcl_SetErrorCode $interp \
		[my constString TCL] [my constString LOOKUP] \
		[my constString DICT] $keyval [my null char*]
	    my br $notOK
	label notOK:
	    my store $1 $ecvar
	    my ret [my fail STRING]
	}

	##### Function tcl.dict.set1 #####
	#
	# Type signature: dict:STRING * key:STRING * value:STRING
	#			* ecvar:int32* -> STRING?
	#
	# Sets a key in a dictionary to map to a value.  Can fail if the
	# "dict" is not a valid dictionary.

	set f [$m local "tcl.dict.set1" STRING?<-STRING,STRING,STRING,int*]
	params dict key value ecvar
	build {
	    noalias $ecvar
	    nonnull $dict $key $value $ecvar
	    set interp [$api tclInterp]
	    set dd [my Dedup dict]
	    set result [$api Tcl_DictObjPut $interp $dict $key $value]
	    my condBr [my eq $result $0] $OK $notOK
	label OK:
	    my addReference(STRING) $dict
	    my condBr [my shared $value] $exit2 $exit3
	label exit3 "exit"
	    my addReference(STRING) $value
	    my br $exit2
	label exit2 "exit"
	    my ret [my ok $dict]
	label notOK:
	    my Call obj.cleanup $dd
	    my store $1 $ecvar
	    my ret [my fail STRING]
	}

	##### Function tcl.dict.set #####
	#
	# Type signature: dict:STRING * pathlen:int * pathobjs:STRING*
	#			* value:STRING * ecvar:int32* -> STRING?
	#
	# Sets a key (or rather a key path) in a dictionary to map to a value.
	# Can fail if the "dict" is not a valid dictionary.

	set f [$m local "tcl.dict.set" STRING?<-STRING,int,STRING*,STRING,int*]
	params dict pathlen pathobjs value ecvar
	build {
	    noalias $pathobjs $ecvar
	    nonnull $dict $pathobjs $value $ecvar
	    set interp [$api tclInterp]
	    set dd [my Dedup dict]
	    set result [$api Tcl_DictObjPutKeyList $interp $dict $pathlen $pathobjs $value]
	    my condBr [my eq $result $0] $OK $notOK
	label OK:
	    my addReference(STRING) $dict
	    my condBr [my shared $value] $exit2 $exit3
	label exit3 "exit"
	    my addReference(STRING) $value
	    my br $exit2
	label exit2 "exit"
	    my ret [my ok $dict]
	label notOK:
	    my Call obj.cleanup $dd
	    my store $1 $ecvar
	    my ret [my fail STRING]
	}

	##### Function tcl.dict.unset1 #####
	#
	# Type signature: dict:STRING * key:STRING * ecvar:int32* -> STRING?
	#
	# Removes a key from a dictionary.  Can fail if the "dict" is not a
	# valid dictionary.

	set f [$m local "tcl.dict.unset1" STRING?<-STRING,STRING,int*]
	params dict key ecvar
	build {
	    noalias $ecvar
	    nonnull $dict $key $ecvar
	    set interp [$api tclInterp]
	    set dd [my Dedup dict]
	    set result [$api Tcl_DictObjRemove $interp $dict $key]
	    my condBr [my eq $result $0] $OK $notOK
	label OK:
	    my addReference(STRING) $dict
	    my ret [my ok $dict]
	label notOK:
	    my Call obj.cleanup $dd
	    my store $1 $ecvar
	    my ret [my fail STRING]
	}

	##### Function tcl.dict.unset #####
	#
	# Type signature: dict:STRING * pathlen:int * pathobjs:STRING*
	#			* ecvar:int32* -> STRING?
	#
	# Removes a key (or rather a key path) from a dictionary. Can fail if
	# the "dict" is not a valid dictionary.

	set f [$m local "tcl.dict.unset" STRING?<-STRING,int,STRING*,int*]
	params dict pathlen pathobjs ecvar
	build {
	    noalias $dict $pathobjs $ecvar
	    nonnull $dict $pathobjs $ecvar
	    set interp [$api tclInterp]
	    set dd [my Dedup dict]
	    set result [$api Tcl_DictObjRemoveKeyList $interp $dict $pathlen $pathobjs]
	    my condBr [my eq $result $0] $OK $notOK
	label OK:
	    my ret [my ok $dict]
	label notOK:
	    my Call obj.cleanup $dd
	    my store $1 $ecvar
	    my ret [my fail STRING]
	}

	##### Function tcl.dict.addIterReference #####
	#
	# Type signature: iter:DICTITER -> void
	#
	# Increments the reference count inside a dictionary iteration state.

	set f [$m local "tcl.dict.addIterReference" void<-DICTITER]
	params iter
	build {
	    nonnull $iter
	    set ref [my gep $iter 0 DICTFOR.ref]
	    set rc [my load $ref]
	    my store [my add $rc $1] $ref
	    my ret
	}

	##### Function tcl.dict.addIterFailReference #####
	#
	# Type signature: value:DICTITER? -> void
	#
	# Increments the reference count inside a dictionary iteration
	# state, allowing for failure

	set f [$m local "tcl.dict.addIterFailReference" void<-DICTITER?]
	params value
	build {
	    my condBr [my maybe $value] $nothing $release
	label nothing:
	    my ret
	label release:
	    my Call tcl.dict.addIterReference [my unmaybe $value]
	    my ret
	}

	##### Function tcl.dict.iterStart #####
	#
	# Type signature: dict:STRING * ecvar:int* -> DICTITER?
	#
	# Starts iterating over a dictionary. The current state of the
	# iteration (assuming we don't get an error) is stored inside the
	# returned iteration state value.

	set f [$m local "tcl.dict.iterStart" DICTITER?<-STRING,int*]
	params dict ecvar
	build {
	    noalias $ecvar
	    nonnull $dict $ecvar
	    set interp [$api tclInterp]
	    set iter [$api cknew DICTFOR]
	    set key [my gep $iter 0 DICTFOR.key]
	    SetValueName $key "keyPtr"
	    set value [my gep $iter 0 DICTFOR.value]
	    SetValueName $value "valuePtr"
	    set done [my alloc int "done"]
	    set search [my gep $iter 0 DICTFOR.search]
	    set code [$api Tcl_DictObjFirst $interp $dict \
			$search $key $value $done]
	    my condBr [my eq $code $0] $ok $failed
	label ok:
	    my storeInStruct $iter DICTFOR.dict $dict
	    my storeInStruct $iter DICTFOR.ref $0
	    my storeInStruct $iter DICTFOR.done [my neq [my load $done] $0]
	    my addReference(STRING) $dict
	    my Call tcl.dict.addIterReference $iter
	    my ret [my ok $iter]
	label failed:
	    $api ckfree $iter
	    my store $1 $ecvar
	    my ret [my fail DICTITER]
	}

	##### Function tcl.dict.iterNext #####
	#
	# Type signature: iter:DICTITER -> DICTITER
	#
	# Continues iterating over a dictionary. The current state of the
	# iteration (assuming we don't get an error) is stored inside the
	# returned iteration state value.

	set f [$m local "tcl.dict.iterNext" DICTITER<-DICTITER]
	params iter
	build {
	    nonnull $iter
	    my condBr [my dereference $iter 0 DICTFOR.done] $finished $nextStep
	label nextStep:
	    set key [my gep $iter 0 DICTFOR.key]
	    SetValueName $key "keyPtr"
	    set value [my gep $iter 0 DICTFOR.value]
	    SetValueName $value "valuePtr"
	    set done [my alloc int "done"]
	    set search [my gep $iter 0 DICTFOR.search]
	    $api Tcl_DictObjNext $search $key $value $done
	    my storeInStruct $iter DICTFOR.done [my neq [my load $done] $0]
	    my br $finished
	label finished:
	    my Call tcl.dict.addIterReference $iter
	    my ret $iter
	}

	##### Function tcl.dict.dropIterReference #####
	#
	# Type signature: iter:DICTITER -> void
	#
	# Decrements the reference count inside a dictionary iteration state,
	# freeing it if the reference count drops to zero.

	set f [$m local "tcl.dict.dropIterReference" void<-DICTITER]
	params iter
	build {
	    nonnull $iter
	    set ref [my gep $iter 0 DICTFOR.ref]
	    set rc [my load $ref]
	    my store [my sub $rc $1] $ref
	    my condBr [my gt $rc $1] $done $free
	label free:
	    set search [my gep $iter 0 DICTFOR.search]
	    $api Tcl_DictObjDone $search
	    my dropReference [my dereference $iter 0 DICTFOR.dict]
	    $api ckfree $iter
	    my ret
	label done:
	    my ret
	}

	##### Function tcl.dict.dropIterFailReference #####
	#
	# Type signature: iter:DICTITER? -> void
	#
	# Decrements the reference count inside a Maybe dictionary iteration
	# state, freeing it if the reference count drops to zero.

	set f [$m local "tcl.dict.dropIterFailReference" void<-DICTITER?]
	params iter
	build {
	    my condBr [my maybe $iter] $nothing $release
	label nothing:
	    my ret
	label release:
	    my Call tcl.dict.dropIterReference [my unmaybe $iter]
	    my ret
	}

	##### Function tcl.dict.iterKey #####
	#
	# Type signature: iter:DICTITER -> STRING
	#
	# Gets the key for this iteration of the dictionary. If there is no
	# key, we get the empty string. Increments it's result refCount.

	set f [$m local "tcl.dict.iterKey" STRING<-DICTITER]
	params iter
	build {
	    nonnull $iter
	    my condBr [my dereference $iter 0 DICTFOR.done] $alloc $real
	label alloc:
	    set new [$api Tcl_NewObj]
	    my br $save
	label real:
	    set obj [my dereference $iter 0 DICTFOR.key]
	    my br $save
	label save:
	    set obj [my phi [list $obj $new] [list $real $alloc] "obj"]
	    my addReference(STRING) $obj
	    my ret $obj
	}

	##### Function tcl.dict.iterValue #####
	#
	# Type signature: iter:DICTITER -> STRING
	#
	# Gets the value for this iteration of the dictionary. If there is no
	# value, we get the empty string. Increments it's result refCount.

	set f [$m local "tcl.dict.iterValue" STRING<-DICTITER]
	params iter
	build {
	    nonnull $iter
	    my condBr [my dereference $iter 0 DICTFOR.done] $alloc $real
	label alloc:
	    set new [$api Tcl_NewObj]
	    my br $save
	label real:
	    set obj [my dereference $iter 0 DICTFOR.value]
	    my br $save
	label save:
	    set obj [my phi [list $obj $new] [list $real $alloc] "obj"]
	    my addReference(STRING) $obj
	    my ret $obj
	}

	##### Function tcl.dict.iterDone #####
	#
	# Type signature: iter:DICTITER -> ZEROONE
	#
	# Gets whether this iteration of the dictionary has finished.

	set f [$m local "tcl.dict.iterDone" ZEROONE<-DICTITER]
	params iter
	build {
	    nonnull $iter
	    my ret [my dereference $iter 0 DICTFOR.done]
	}

	##### Function tcl.dict.append #####
	#
	# Type signature: dict:STRING * key:STRING * value:STRING
	#			* ecvar:int32* -> STRING?
	#
	# Appends to value in a dictionary indicated by a key.  Can fail if the
	# "dict" is not a valid dictionary.

	set f [$m local "tcl.dict.append" STRING?<-STRING,STRING,STRING,int*]
	params dict key value ecvar
	build {
	    noalias $ecvar
	    nonnull $dict $key $value $ecvar
	    set interp [$api tclInterp]
	    set dd [my Dedup dict]
	    set valuePtr [my alloc STRING "valuePtr"]
	    set result [$api Tcl_DictObjGet $interp $dict $key $valuePtr]
	    my condBr [my eq $result $0] $OK $notOK
	label OK:
	    set dictVal [my load $valuePtr "value.in.dict"]
	    my condBr [my nonnull $dictVal] $append $set
	label set:
	    $api Tcl_DictObjPut {} $dict $key $value
	    my br $done
	label append:
	    my condBr [my shared $dictVal] $dupePut $directUpdate
	label directUpdate:
	    $api Tcl_AppendObjToObj $dictVal $value
	    $api TclInvalidateStringRep $dict
	    my br $done
	label dupePut:
	    set dictVal2 [$api Tcl_DuplicateObj $dictVal]
	    $api Tcl_AppendObjToObj $dictVal2 $value
	    set c [$api Tcl_DictObjPut {} $dict $key $dictVal2]
	    AddCallAttribute $c 3 nocapture
	    my br $done
	label done:
	    my addReference(STRING) $dict
	    my ret [my ok $dict]
	label notOK:
	    my Call obj.cleanup $dd
	    my store $1 $ecvar
	    my ret [my fail STRING]
	}

	##### Function tcl.dict.incr #####
	#
	# Type signature: dict:STRING * key:STRING * value:INT
	#			* ecvar:int32* -> STRING?
	#
	# Adds an integer to an integer in a dictionary indicated by a key.
	# Can fail if the "dict" is not a valid dictionary or the value
	# pointed to is not a valid integer.

	set f [$m local "tcl.dict.incr" STRING?<-STRING,STRING,INT,int*]
	params dict key value ecvar
	build {
	    noalias $ecvar
	    nonnull $dict $key $ecvar
	    set interp [$api tclInterp]
	    set dd [my Dedup dict]
	    set valuePtr [my alloc STRING "valuePtr"]
	    set result [$api Tcl_DictObjGet $interp $dict $key $valuePtr]
	    my condBr [my eq $result $0] $OK $notOK
	label OK:
	    set dictVal [my load $valuePtr "value.in.dict"]
	    my condBr [my nonnull $dictVal] $add $set
	label set:
	    set strVal [my stringify(INT) $value "value"]
	    my br $done
	label add:
	    # TODO: Revisit once we support bignums
	    set intVar [my alloc int64 "intPtr"]
	    set result [$api Tcl_GetWideIntFromObj $interp $dictVal $intVar]
	    my condBr [my eq $result $0] $doAdd $notOK
	label doAdd:
	    set int [my packInt64 [my load $intVar "int"] "int"]
	    set updatedValue [my add(INT,INT) $int $value "value"]
	    set addVal [my stringify(INT) $updatedValue "value"]
	    my br $done
	label done:
	    set resultValue [my phi [list $strVal $addVal] \
		    [list $set $doAdd] "value"]
	    # No failure mode at this point: we know we've got a dictionary.
	    set c [$api Tcl_DictObjPut {} $dict $key $resultValue]
	    my addReference(STRING) $dict
	    my ret [my ok $dict]
	label notOK:
	    my Call obj.cleanup $dd
	    my store $1 $ecvar
	    my ret [my fail STRING]
	}

	##### Function tcl.dict.lappend #####
	#
	# Type signature: dict:STRING * key:STRING * value:STRING
	#			* ecvar:int32* -> STRING?
	#
	# Appends to list in a dictionary indicated by a key.  Can fail if the
	# "dict" is not a valid dictionary or the value pointed to is not a
	# valid list.

	set f [$m local "tcl.dict.lappend" STRING?<-STRING,STRING,STRING,int*]
	params dict key value ecvar
	build {
	    noalias $ecvar
	    nonnull $dict $key $value $ecvar
	    set interp [$api tclInterp]
	    set dd [my Dedup dict]
	    set valuePtr [my alloc STRING "valuePtr"]
	    set result [$api Tcl_DictObjGet $interp $dict $key $valuePtr]
	    my condBr [my eq $result $0] $OK $notOK
	label OK:
	    set dictVal [my load $valuePtr "value.in.dict"]
	    my condBr [my nonnull $dictVal] $append $set
	label set:
	    my store $value $valuePtr
	    set newlist [$api Tcl_NewListObj $1 $valuePtr]
	    $api Tcl_DictObjPut {} $dict $key $newlist
	    my br $done
	label append:
	    my condBr [my shared $dictVal] $dupePut $directUpdate
	label directUpdate:
	    set result [$api Tcl_ListObjAppendElement $interp $dictVal $value]
	    my condBr [my eq $result $0] $dictUpdateOK $notOK
	label dictUpdateOK:
	    $api TclInvalidateStringRep $dict
	    my br $done
	label dupePut:
	    set dictVal [$api Tcl_DuplicateObj $dictVal]
	    set result [$api Tcl_ListObjAppendElement $interp $dictVal $value]
	    my condBr [my eq $result $0] $dupeUpdateOK $dupeNotOK
	label dupeUpdateOK:
	    set c [$api Tcl_DictObjPut {} $dict $key $dictVal]
	    AddCallAttribute $c 3 nocapture
	    my br $done
	label done:
	    my addReference(STRING) $dict
	    my ret [my ok $dict]
	label dupeNotOK:
	    my dropReference $dictVal
	    my br $notOK
	label notOK:
	    my Call obj.cleanup $dd
	    my store $1 $ecvar
	    my ret [my fail STRING]
	}
    }

    # Builder:StringComparisonFunctions --
    #
    #	Generate the functions that implement the string comparators. Only
    #	called from StringFunctions method.
    #
    # Parameters:
    #	api -	The handle of the Tcl API object (currently an instance of the
    #		Thunk class).
    #
    # Results:
    #	None.

    method StringComparisonFunctions {api} {
	upvar 1 sizeof sizeof 0 0 1 1

	##### Function tcl.streq #####
	#
	# Type signature: value1Ptr:STRING * value2Ptr:STRING -> ZEROONE
	#
	# Quadcode implementation ('streq')
	#
	# Returns whether the two string arguments are equal.

	set f [$m local "tcl.streq" ZEROONE<-STRING,STRING]
	params v1:value1Ptr v2:value2Ptr
	build {
	    nonnull $v1 $v2
	    my condBr [my eq $v1 $v2] $identical $nexttest
	label nexttest:
	    my condBr [my and [my isByteArray $v1] [my isByteArray $v2]] \
		$cmpBA $nexttest2
	label nexttest2:
	    my condBr [my and \
		    [my isUnicodeString $v1] \
		    [my isUnicodeString $v2]] \
		$cmpUni $cmpUtf
	label identical:
	    my ret [Const true bool]
	label different:
	    my ret [Const false bool]
	label cmpBA "byteArrays"
	    lassign [my GetBytes $v1 "value1"] len ba1
	    lassign [my GetBytes $v2 "value2"] len2 ba2
	    my condBr [my eq $len $len2] $cmpBA2 $different
	label cmpBA2 "compareByteArrays"
	    set diff [my memcmp $ba1 $ba2 $len]
	    my condBr [my eq $diff $0] $identical $different
	label cmpUni "unicodeStrings"
	    set len [$api Tcl_GetCharLength $v1]
	    my condBr [my eq $len [$api Tcl_GetCharLength $v2]] \
		$cmpUni2 $different
	label cmpUni2 "compareUnicodeStrings"
	    # TODO use bytes field if both have it
	    set u1 [$api Tcl_GetUnicode $v1]
	    set u2 [$api Tcl_GetUnicode $v2]
	    set len [my mult $len $sizeof(Tcl_UniChar)]
	    set diff [my memcmp $u1 $u2 $len]
	    my condBr [my eq $diff $0] $identical $different
	label cmpUtf "UTF8Strings"
	    lassign [my GetString $v1 "s1"] len s1
	    lassign [my GetString $v2 "s2"] len2 s2
	    my condBr [my eq $len $len2] $cmpUtf2 $different
	label cmpUtf2 "compareUTF8Strings"
	    set diff [my memcmp $s1 $s2 $len]
	    my condBr [my eq $diff $0] $identical $different
	}

	##### Function tcl.strcmp #####
	#
	# Type signature: value1Ptr:STRING * value2Ptr:STRING -> int
	#
	# Quadcode implementation ('strcmp')
	#
	# Returns the relationship between the two string arguments; -1 if
	# 'value1Ptr' precedes in standard ordering, 1 if 'value2Ptr'
	# precedes, and 0 if they are equal.

	set f [$m local "tcl.strcmp" int<-STRING,STRING]
	params v1:value1Ptr v2:value2Ptr
	build {
	    nonnull $v1 $v2
	    my condBr [my eq $v1 $v2] $identical $nexttest
	label nexttest:
	    my condBr [my isByteArray $v1] $testBA2 $nexttest2
	label testBA2:
	    my condBr [my isByteArray $v2] $cmpBA $nexttest2
	label nexttest2:
	    my condBr [my and \
		    [my isUnicodeString $v1] \
		    [my isUnicodeString $v2]] \
		$cmpUni $cmpUtf
	label identical:
	    my ret $0
	label cmpBA "byteArrays"
	    lassign [my GetBytes $v1 "value1"] len1 ba1
	    lassign [my GetBytes $v2 "value2"] len2 ba2
	    set diffBA [my sub $len1 $len2]
	    set matchBA [my memcmp $ba1 $ba2 [my min $len1 $len2]]
	    my br $result
	label cmpUni "unicode"
	    set len1 [$api Tcl_GetCharLength $v1]
	    set len2 [$api Tcl_GetCharLength $v2]
	    set diffUni [my sub $len1 $len2]
	    set matchUni [$api Tcl_UniCharNcmp [$api Tcl_GetUnicode $v1] \
		    [$api Tcl_GetUnicode $v2] [my min $len1 $len2]]
	    my br $result
	label cmpUtf "UTF8"
	    set s1 [$api Tcl_GetString $v1]
	    set s2 [$api Tcl_GetString $v2]
	    set len1 [$api Tcl_GetCharLength $v1]
	    set len2 [$api Tcl_GetCharLength $v2]
	    set diffUtf [my sub $len1 $len2]
	    set matchUtf [$api TclpUtfNcmp2 $s1 $s2 [my min $len1 $len2]]
	    my br $result
	label result:
	    set sources [list $cmpBA $cmpUni $cmpUtf]
	    set match [my phi [list $matchBA $matchUni $matchUtf] $sources]
	    set diff [my phi [list $diffBA $diffUni $diffUtf] $sources]
	    my ret [my select [my eq $match $0] $diff $match]
	}

	##### Function tcl.strmatch #####
	#
	# Type signature: nocase:INT * pattern:STRING * string:STRING
	#			-> ZEROONE
	#
	# Quadcode implementation ('strmatch')
	#
	# Returns whether the glob pattern in 'pattern' matches 'string'. If
	# 'nocase' is non-zero, performs the match case-insensitively.

	set f [$m local "tcl.strmatch" ZEROONE<-INT,STRING,STRING]
	params nocaseInt:nocase patternObj:pattern stringObj:string
	build {
	    nonnull $patternObj $stringObj
	    set nocase [my getInt32 $nocaseInt]
	    my condBr [my isUnicodeString $patternObj] $test2 $ordinary
	label test2:
	    my condBr [my isUnicodeString $stringObj] $unicode $ordinary
	    # TODO support TclByteArrayMatch (but that needs exposing first)
	label ordinary "ordinaryMatch"
	    set pattern [$api Tcl_GetString $patternObj]
	    set string [$api Tcl_GetString $stringObj]
	    set match [$api Tcl_StringCaseMatch $string $pattern $nocase]
	    my ret [my neq $match $0]
	label unicode "unicodeMatch"
	    lassign [my GetUnicode $patternObj "pattern"] patLen patStr
	    lassign [my GetUnicode $stringObj "string"] strLen strStr
	    set match [$api TclUniCharMatch $strStr $strLen $patStr $patLen \
		    $nocase]
	    my ret [my neq $match $0]
	}

	##### Function tcl.regexp #####
	#
	# Type signature: flags:INT * regexp:STRING * string:STRING
	#			* errVar:int* -> ZEROONE?
	#
	# Quadcode implementation ('regexp')
	#
	# Returns whether the regular expression in 'regexp' matches 'string'
	# as a WRAPPED BOOLEAN. The 'flags' control things like whether we are
	# matching case-insensitively. If the code fails (generally because of
	# a bad regular expression) then the result is a Nothing. The variable
	# pointed to by 'errVar' is set to the relevant Tcl result code.

	set f [$m local "tcl.regexp" ZEROONE?<-INT,STRING,STRING,int*]
	params flags patternObj:regexp stringObj:string errVar:errorCode
	build {
	    noalias $errVar
	    nonnull $patternObj $stringObj $errVar
	    set interp [$api tclInterp]
	    set RE [$api Tcl_GetRegExpFromObj $interp $patternObj \
		    [my getInt32 $flags]]
	    my condBr [my nonnull $RE] $exec $err
	label exec "re.exec"
	    set match [$api Tcl_RegExpExecObj $interp $RE $stringObj $0 $0 $0]
	    my condBr [my ge $match $0] $done $err
	label done "re.done"
	    my store $0 $errVar
	    my ret [my ok [my gt $match $0]]
	label err "re.error"
	    my store $1 $errVar
	    my ret [my fail ZEROONE]
	}

    }

    # Builder:@apiFunctions --
    #
    #	Generate the quadcode operator implementations that require access to
    #	the Tcl API to work.
    #
    # Parameters:
    #	api -	The handle of the Tcl API object (currently an instance of the
    #		Thunk class).
    #
    # Results:
    #	None.

    method @apiFunctions {module api} {
	##### Function tcl.print.string #####
	##### Closure Build:printf #####
	##### Closure Build:fprintf #####
	#
	#	Print a formatted string.
	#
	# Parameters:
	#	channel (fprintf only) -
	#		Either "stdout" or "stderr" to select which channel to
	#		print to.
	#	str -	The Tcl string holding the format string.
	#	args -	The arguments to use in the format. These must be all
	#		LLVM values of the correct type.
	# Results:
	#	The reference count, as a LLVM value.

	set f [$module local tcl.print.string void<-int,Tcl_Obj*]
	my closure printf {str args} {
	    my Call tcl.print.string [Const [expr 1<<2]] \
		    [$api Tcl_ObjPrintf [my constString $str] {*}$args]
	}
	my closure fprintf {channel str args} {
	    set id [dict get {stdout 2 stderr 3} $channel]
	    my Call tcl.print.string [Const [expr {1<<$id}]] \
		    [$api Tcl_ObjPrintf [my constString $str] {*}$args]
	}
	params chanID str
	build {
	    set chan [$api Tcl_GetStdChannel $chanID]
	    $api Tcl_WriteObj $chan $str
	    $api Tcl_DecrRefCount $str
	    my ret
	}

	my StringifyFunctions $api
	my ReferenceFunctions $api
	my StringFunctions $api

	# Builder:MathException --
	#
	#	Generate one of the standard math exceptions that are produced
	#	when doing an integer divide by zero or the result of a double
	#	operation would be a NaN.
	#
	# Parameters:
	#	ecvar -	The LLVM value reference to the int* where the Tcl
	#		error code is written.
	#	args -	Tcl strings for words to use in the exception code.
	#		The final word will be used as the Tcl error message.
	#
	# Results:
	#	None.

	my closure MathException {ecvar args} {
	    set interp [$api tclInterp]
	    set msg [$api obj.constant [lindex $args end]]
	    SetValueName $msg "exception.message"
	    set exn [$api obj.constant $args]
	    SetValueName $exn "exception.code"
	    $api Tcl_SetObjResult $interp $msg
	    $api Tcl_SetObjErrorCode $interp $exn
	    my store [Const 1] $ecvar
	    return
	}

	my ErroringMathFunctions
	set 0 [Const 0]
	set 1 [Const 1]

	##### Function tcl.getresult #####
	#
	# Type signature: void -> STRING
	#
	# Quadcode implementation ('result')
	#
	# Returns the current interpreter result.

	set f [$module local "tcl.getresult" STRING<-]
	build {
	    set result [$api Tcl_GetObjResult [$api tclInterp]]
	    SetValueName $result "resultObj"
	    my addReference(STRING) $result
	    my ret $result
	}

	##### Function tcl.getreturnopts #####
	#
	# Type signature: returnCode:INT -> STRING
	#
	# Quadcode implementation ('returnOptions')
	#
	# Returns the return options dictionary. Note that this requires the
	# current Tcl result code in order to work correctly.

	set f [$module local "tcl.getreturnopts" STRING<-INT]
	params value:returnCode
	build {
	    set code [my int.32 $value "code"]
	    set opts [$api Tcl_GetReturnOptions [$api tclInterp] $code]
	    SetValueName $opts "optionsObj"
	    my addReference(STRING) $opts
	    my ret $opts
	}

	##### Function tcl.initExceptionOptions #####
	#
	# Type signature: objPtr:STRING * dictPtr:STRING -> int
	#
	# Initialises the return options from what we know about an exception.

	set f [$module local "tcl.initExceptionOptions" int<-STRING,STRING]
	params result:objPtr opts:dictPtr
	build {
	    nonnull $result $opts
	    set interp [$api tclInterp]
	    set code [$api Tcl_SetReturnOptions $interp $opts]
	    my switch $code $other 0 $ok 1 $error
	label ok:
	    my ret $code
	label error:
	    # BEWARE! Must do this in this order, because an error in the
	    # option dictionary overrides the result (and can be verified by
	    # test).
	    $api Tcl_SetObjResult $interp $result
	    $api Tcl_SetReturnOptions $interp $opts
	    my ret $code
	label other:
	    $api Tcl_SetObjResult $interp $result
	    my ret $code
	}

	##### Function tcl.initExceptionSimple #####
	#
	# Type signature: message:STRING * errorcode:STRING -> void
	#
	# Construct a simple exception, with just error message and error code
	# list.

	set f [$module local "tcl.initExceptionSimple" void<-STRING,STRING]
	params message errorcode
	build {
	    nonnull $message $errorcode
	    set interp [$api tclInterp]
	    $api Tcl_SetObjResult $interp $message
	    set field [my gep $interp 0 Interp.returnOpts]
	    set ro [my load $field]
	    set newOpts [$api Tcl_NewObj]
	    set key [$api obj.constant "-errorcode"]
	    $api Tcl_DictObjPut {} $newOpts $key $errorcode
	    my store $newOpts $field
	    my addReference(STRING) $newOpts
	    my condBr [my nonnull $ro] $dropold $testForError
	label dropold "swap.dropOld"
	    my dropReference $ro
	    my br $testForError
	label testForError "test.for.error"
	    set field [my gep $interp 0 Interp.errorInfo]
	    set ei [my load $field]
	    my condBr [my nonnull $ei] $clearEI $setEC
	label clearEI "error.clearErrorInfo"
	    my dropReference $ei
	    my store [my null STRING] $field
	    my br $setEC
	label setEC "error.setErrorCode"
	    $api Tcl_SetObjErrorCode $interp $errorcode
	    set field [my gep $interp 0 Interp.flags]
	    my store [my or [my load $field] [Const 0x800]] $field
	    my ret
	}

	##### Function tcl.processReturn #####
	#
	# Type signature: result:STRING * code:int * level:int
	#			* returnOpts:STRING -> int
	#
	# Initialises the return options from what we know about an exception.
	# Analogous to TclProcessReturn, which isn't exposed.
	#
	# Note that returnOpts may be NULL; that's equivalent to an empty
	# options dictionary, but is special-cased so it is handled more
	# efficiently by the optimizer.

	set f [$module local "tcl.processReturn" int<-STRING,int,int,STRING]
	params result code level returnOpts
	build {
	    nonnull $result
	    set interp [$api tclInterp]
	    $api Tcl_SetObjResult $interp $result
	    set valuePtr [my alloc STRING "valuePtr"]
	    set field [my gep $interp 0 Interp.returnOpts]
	    set ro [my load $field]
	    my condBr [my neq $ro $returnOpts] $swap $testForError
	label swap:
	    my condBr [my nonnull $ro] $swapdropold $swapinnew
	label swapdropold "swap.dropOld"
	    my dropReference $ro
	    my condBr [my nonnull $returnOpts] $swapinnew $totallyNew
	label totallyNew "swap.totallyNew"
	    set newOpts [$api Tcl_NewObj]
	    my store $newOpts $field
	    my addReference(STRING) $newOpts
	    my br $testForError
	label swapinnew "swap.inNew"
	    my store $returnOpts $field
	    my addReference(STRING) $returnOpts
	    my br $testForError
	label testForError "test.for.error"
	    my condBr [my eq $code $1] $error $testForReturn
	label error:
	    set field [my gep $interp 0 Interp.errorInfo]
	    set ei [my load $field]
	    my condBr [my nonnull $ei] $clearEI $getEI
	label clearEI "error.clearErrorInfo"
	    my dropReference $ei
	    my store [my null STRING] $field
	    my br $getEI
	label getEI "error.getErrorInfo"
	    my store [my null STRING] $valuePtr
	    my condBr [my nonnull $returnOpts] $testEI $getES
	label testEI "error.testHaveErrorInfo"
	    $api Tcl_DictObjGet {} $returnOpts \
		[$api obj.constant "-errorinfo"] $valuePtr
	    set value [my load $valuePtr "errorInfo"]
	    my condBr [my nonnull $value] $installEI $getES
	label installEI "error.installErrorInfo"
	    set infoLen [my alloc int "infoLen"]
	    $api Tcl_GetStringFromObj $value $infoLen
	    my condBr [my neq [my load $infoLen] $0] $installEI2 $getES
	label installEI2 "error.setErrorInfo"
	    my store $value $field
	    my addReference(STRING) $value
	    set field [my gep $interp 0 Interp.flags]
	    my store [my or [my load $field] [Const 4]] $field
	    my br $getES
	label getES "error.getErrorStack"
	    my condBr [my nonnull $returnOpts] $testES $getEC
	label testES "error.testHaveErrorStack"
	    $api Tcl_DictObjGet {} $returnOpts \
		[$api obj.constant "-errorstack"] $valuePtr
	    set value [my load $valuePtr "errorStack"]
	    my condBr [my nonnull $value] $installES $getEC
	label installES "error.installErrorStack"
	    set field [my gep $interp 0 Interp.errorStack]
	    my condBr [my shared [my load $field]] $dedupES $getESElems
	label dedupES "error.deduplicateErrorStack"
	    set oldobj [my load $field]
	    set newobj [$api Tcl_DuplicateObj $oldobj]
	    my dropReference $oldobj
	    my addReference(STRING) $newobj
	    my store $newobj $field
	    my br $getESElems
	label getESElems "error.getErrorStackElements"
	    set objcPtr [my alloc int]
	    set objvPtr [my alloc STRING*]
	    my condBr [my neq $0 \
		[$api Tcl_ListObjGetElements $interp $value $objcPtr $objvPtr]]\
		$notList $setES
	label notList "error.getErrorStackElements.notList"
	    my ret $1
	label setES "error.setErrorStack"
	    my store $0 [my gep $interp 0 Interp.resetErrorStack]
	    set lenPtr [my alloc int]
	    set es [my load $field]
	    $api Tcl_ListObjLength $interp $es $lenPtr
	    $api Tcl_ListObjReplace $interp \
		$es $0 [my load $lenPtr "len"] \
		[my load $objcPtr "objc"] [my load $objvPtr "objv"]
	    my br $getEC
	label getEC "error.getErrorCode"
	    my condBr [my nonnull $returnOpts] $testEC $installNone
	label testEC "error.testHaveErrorCode"
	    $api Tcl_DictObjGet {} $returnOpts \
		[$api obj.constant "-errorcode"] $valuePtr
	    set value [my load $valuePtr "errorCode"]
	    my condBr [my nonnull $value] $installEC $installNone
	label installEC "error.installErrorCode"
	    $api Tcl_SetObjErrorCode $interp $value
	    my br $getEL
	label installNone "error.installNONE"
	    $api Tcl_SetErrorCode $interp [my constString NONE] [my null char*]
	    my br $getEL
	label getEL "error.getErrorLine"
	    my condBr [my nonnull $returnOpts] $testEL $testForReturn
	label testEL "error.testHaveErrorInfo"
	    $api Tcl_DictObjGet {} $returnOpts \
		[$api obj.constant "-errorline"] $valuePtr
	    set value [my load $valuePtr "errorLine"]
	    my condBr [my nonnull $value] $installEL $testForReturn
	label installEL "error.installErrorLine"
	    $api Tcl_GetIntFromObj {} $value \
		[my gep $interp 0 Interp.errorLine]
	    my br $testForReturn
	label testForReturn "test.for.return"
	    my condBr [my neq $level $0] $processReturn $retestForError
	label processReturn "return.process"
	    my storeInStruct $interp Interp.returnLevel $level
	    my storeInStruct $interp Interp.returnCode $code
	    my ret [Const 2];	# TCL_RETURN
	label retestForError "test.for.error"
	    my condBr [my eq $code $1] $addFlag $done
	label addFlag "error.addFlag"
	    set field [my gep $interp 0 Interp.flags]
	    my store [my or [my load $field] [Const 0x800]] $field
	    my br $done
	label done:
	    my ret $code
	}

	##### Function tcl.procedure.return #####
	#
	# Type signature: code:INT * procName:STRING -> int32
	#
	# Handles the transforms on a result when a procedure returns. See
	# InterpProcNR2 in tclProc.c for what is going on; this is the part
	# commencing at the 'process' label.

	set f [$m local "tcl.procedure.return" int32<-INT,STRING]
	params code procName
	build {
	    set interp [$api tclInterp]
	    set code [my getInt32 $code]
	    my condBr [my eq $code [Const 2]] $handleReturn $test2
	label test2:
	    my condBr [my eq $code [Const 3]] $handleBreak $test3
	label test3:
	    my condBr [my eq $code [Const 4]] $handleContinue $test4
	label test4:
	    my condBr [my eq $code [Const 1]] $handleError $done
	label handleError "handle.error"
	    set limitVar [my alloc int]
	    set name [$api Tcl_GetStringFromObj $procName $limitVar]
	    SetValueName $name "name"
	    set limit [Const 60]
	    set nameLen [my load $limitVar "name.len"]
	    set overflow [my gt $nameLen $limit]
	    $api Tcl_AppendObjToErrorInfo $interp [$api Tcl_ObjPrintf \
		    [my constString "\n    (procedure \"%.*s%s\" line %d)"] \
		    [my select $overflow $limit $nameLen] $name \
		    [my select $overflow [my constString "..."] \
			    [my constString ""]] \
		    [my dereference $interp 0 Interp.errorLine]]
	    my br $done
	label handleReturn "handle.return"
	    my ret [$api TclUpdateReturnInfo $interp]
	label handleBreak "handle.leaked.break"
	    $api Tcl_SetObjResult $interp [$api Tcl_ObjPrintf \
		    [my constString "invoked \"%s\" outside of a loop"] \
		    [my constString "break"]]
	    $api Tcl_SetObjErrorCode $interp \
		[$api obj.constant {TCL RESULT UNEXPECTED}]
	    my ret [Const 1]
	label handleContinue "handle.leaked.continue"
	    $api Tcl_SetObjResult $interp [$api Tcl_ObjPrintf \
		    [my constString "invoked \"%s\" outside of a loop"] \
		    [my constString "continue"]]
	    $api Tcl_SetObjErrorCode $interp \
		[$api obj.constant {TCL RESULT UNEXPECTED}]
	    my ret [Const 1]
	label done:
	    my ret $code
	}

	##### Function tcl.logCommandInfo #####
	#
	# Type signature: code:int * length:int * command:char*
	#			* ellipsis:char* -> void
	#
	# Builds the current entry in the errorInfo trace if the code is
	# TCL_ERROR. Note that most of the arguments to this function are
	# expected to be values that our caller will compute at compile time.

	set f [$m local "tcl.logCommandInfo" void<-int,int,char*,char*]
	params code length command ellipsis
	build {
	    nonnull $command $ellipsis
	    set ERR_ALREADY_LOGGED [Const 4]

	    set interp [$api tclInterp]
	    set flagVar [my gep $interp 0 Interp.flags]
	    set flags [my load $flagVar "flags"]
	    my condBr [my eq $code [Const 1]] $checkForLog $done
	label checkForLog "check.for.log.error"
	    my condBr [my eq [my and $flags $ERR_ALREADY_LOGGED] [Const 0]] \
		$logError $done
	label logError "log.error"
	    set initText [my select [my nonnull \
		    [my dereference $interp 0 Interp.errorInfo]] \
		    [my constString "invoked from within"] \
		    [my constString "while executing"]]
	    $api Tcl_AppendObjToErrorInfo $interp [
		$api Tcl_ObjPrintf [my constString "\n    %s\n\"%.*s%s\""] \
		    $initText $length $command $ellipsis]
	    # TODO: update the errorStack as well...
	    # $api Tcl_LogCommandInfo $interp {} {} [Const 0]
	    my br $done
	label done:
	    my store [my and $flags [my not $ERR_ALREADY_LOGGED]] $flagVar
	    my ret
	}

	##### Function tcl.setErrorLine #####
	#
	# Type signature: test:bool * code:int * line:int * length:int
	#			* command:char* * ellipsis:char* -> void
	#
	# Sets the current errorLine if the test is true and builds the
	# current entry in the errorInfo trace if necessary. Note that most of
	# the arguments to this function are expected to be values that our
	# caller will compute at compile time.

	set f [$m local "tcl.setErrorLine" void<-bool,int,int,int,char*,char*]
	params test code line length command ellipsis
	build {
	    nonnull $command $ellipsis
	    my condBr $test $setLine $done
	label setLine "set.error.line"
	    set interp [$api tclInterp]
	    my store $line [my gep $interp 0 Interp.errorLine]
	    my Call tcl.logCommandInfo $code $length $command $ellipsis
	    my br $done
	label done:
	    my ret
	}

	##### Function tcl.booleanTest #####
	#
	# Type signature: objPtr:Tcl_Obj* -> ZEROONE
	#
	# Part of quadcode implementation ('isBoolean')
	#
	# Returns whether the string 'objPtr' is a boolean value.

	set f [$m local "tcl.booleanTest" ZEROONE<-Tcl_Obj*]
	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.

	set f [$module local "tcl.invoke.command" STRING?<-int,STRING*,int*]
	params objc objv ecvar
	build {
	    noalias $objv $ecvar
	    nonnull $objv $ecvar
	    set interp [$api tclInterp]
	    set code [$api Tcl_EvalObjv $interp $objc $objv $0]
	    my condBr [my eq $code $0] $ok $fail
	label ok:
	    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.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
	# pre-optimized LLVM level.

	set f [$module local "tcl.existsOrError" int1<-int1,STRING,STRING,int*]
	params exists message exception ecvar
	build {
	    noalias $message $ecvar
	    nonnull $message $exception $ecvar
	    my condBr $exists $doError $done
	label doError:
	    my initException $exception $message $ecvar
	    my br $done
	label done:
	    my ret $exists
	}

	##### Function tcl.not.string #####
	#
	# Type signature: value:STRING * ecvar:int* -> ZEROONE?
	#
	# Quadcode implementation ('not').
	#
	# Logical negation of 'value'.

	set f [$m local "tcl.not.string" ZEROONE?<-STRING,int*]
	params value ecvar
	build {
	    noalias $ecvar
	    nonnull $value $ecvar
	    set interp [$api tclInterp]
	    set bvar [my alloc int]
	    set code [$api Tcl_GetBooleanFromObj $interp $value $bvar]
	    my condBr [my eq $code [Const 0]] $ok $fail
	label fail:
	    my store [Const 1] $ecvar
	    my ret [my fail ZEROONE]
	label ok:
	    my ret [my ok [my neq [my load $bvar "bool"] [Const 1]]]
	}

	my @variableFunctions $api
	my @numericConverterFunctions $api

	##### Function: tcl.resolveCmd #####
	#
	# Type signature: cmdName:STRING -> STRING
	#
	# Quadcode implementation('resolveCmd')
	#
	# Returns either the resolved name of the command or an empty
	# string if the command cannot be resolved.
	
	set f [$m local "tcl.resolveCmd" STRING<-STRING]
	params cmdName
	build {
	    nonnull $cmdName
	    set interp [$api tclInterp]
	    set result [$api Tcl_NewObj]
	    set cmdPtr [$api Tcl_GetCommandFromObj $interp $cmdName]
	    my condBr [my nonnull $cmdPtr] $resolved $notResolved
	  label resolved:
	    $api Tcl_GetCommandFullName $interp $cmdPtr $result
	    my br $notResolved
	  label notResolved:
	    my addReference(STRING) $result
	    my ret $result
	}

	##### Function: tcl.originCmd #####
	#
	# Type signature: cmdName:STRING ecvar:int32* -> STRING
	#
	# Quadcode implementation('resolveCmd')
	#
	# Returns either the resolved name of the command or an empty
	# string if the command cannot be resolved.

	set f [$m local "tcl.originCmd" STRING?<-STRING,int*]
	params cmdName ecvar
	build {
	    nonnull $cmdName $ecvar
	    noalias $ecvar
	    set interp [$api tclInterp]
	    set result [$api Tcl_NewObj]
	    set cmdPtr [$api Tcl_GetCommandFromObj $interp $cmdName]
	    my condBr [my nonnull $cmdPtr] $resolved $notResolved
	  label resolved:
	    set origCmdPtr [$api TclGetOriginalCommand $cmdPtr]
	    my condBr [my nonnull $origCmdPtr] $aliased $notAliased
	  label aliased:
	    my br $done
	  label notAliased:
	    my br $done
	  label done:
	    set finalCmdPtr [my phi [list $origCmdPtr $cmdPtr] \
				 [list $aliased $notAliased]]
	    $api Tcl_GetCommandFullName $interp $finalCmdPtr $result
	    my addReference(STRING) $result
	    my ret [my ok $result]
	  label notResolved:
	    my dropReference(STRING) $result
	    $api Tcl_SetObjResult $interp \
		[$api Tcl_ObjPrintf \
		     [my constString "invalid command name \"%s\""] \
		     [$api Tcl_GetString $cmdName]]
	    $api Tcl_SetErrorCode $interp \
		[my constString TCL] [my constString LOOKUP] \
		[my constString COMMAND] [$api Tcl_GetString $cmdName] \
		[my null char*]
	    my store $1 $ecvar
	    my ret [my fail STRING]
	}

	my CallFrameFunctions $api
    }

    export @apiFunctions
}

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