set quads {};	        # List of instructions under construction
    set quadindex {};		# Dictionary mapping bytecode PC to
    ;				# quadcode PC in the initial translation
    set fixup {};		# Dictionary whose keys are jump targets
    ;				# and the values are lists of quad program
    ;				# counters that jump to them, used to fix up
    ;				# forward jumps.
    set cf [list temp @callframe]
    ;				# Callframe is used in many places, so
    ;				# allow it to be abbreviated

    my debug-translate {
	puts "Translate bytecode: $originProc"
    }

    # Construct a header that sets parameters and provides a fake point
    # to which live-on-entry variables can be attached.
    set vlist {}
    foreach v [dict get $bytecode variables] {
	if {!("temp" in [lindex $v 0])} {
	    lappend vlist [lindex $v 1]
	}
    }
    my quads entry $cf [list literal $vlist]
    my quads @debug-context {} [list literal [list proc $originProc]]
    if {[dict exists $bytecode sourcefile]} {
	my quads @debug-file {} [list literal [dict get $bytecode sourcefile]]
    }
    if {[dict exists $bytecode initiallinenumber]} {
	my quads @debug-line {} \
	    [list literal [list [dict get $bytecode initiallinenumber] 0]]

	if {{arg} in [lindex $v 0]} {
	    my quads param [list var [lindex $v 1]] [list arg $idx]
	}
	incr idx
    }

    # Make sure that the args are in the callframe.
    set q [list moveToCallFrame $cf $cf]
    foreach v [dict get $bytecode variables] {
	if {{arg} in [lindex $v 0]} {
	    lappend q [list literal [lindex $v 1]] [list var [lindex $v 1]]
	}
    }
    if {[llength $q] > 3} {
	my quads {*}$q

		set chars [list temp [incr depth -1]]
		set v [list temp [incr depth -1]]
		my quads strtrim $v $v $chars [list literal 1]
	    }

	    done {		# End of bytecode
		set v [list temp [incr depth -1]]
		my quads return {} $cf $v
	    }
	    returnStk {
		# NOTE! Opposite order to 'returnImm'
		set v [list temp [incr depth -1]]
		set opt [list temp [incr depth -1]]
		set resultVar [list temp $depth]
		my error-quads $pc initException $resultVar $v $opt

		my quads copy $res $inval
	    }
	    incrStkImm {
		set var [list temp [incr depth -1]]
		set delta [list literal [lindex $insn 1]]
		# TODO: This assumes we're dealing with qualified names!
		set val {temp opd2}
		my error-quads $pc directGet $val $cf $var
		my generate-arith-domain-check $pc incr $val $delta
		my quads purify {temp opd0} $val
		my quads purify {temp opd1} $delta
		my quads add $val {temp opd0} {temp opd1}
		my callframe-error-quads $pc directSet $var $var $val
	    }
	    incrStk {
		set delta [list temp [incr depth -1]]
		set var [list temp [incr depth -1]]
		# TODO: This assumes we're dealing with qualified names!
		set val {temp opd2}
		my error-quads $pc directGet $val $cf $var
		my generate-arith-domain-check $pc incr $val $delta
		my quads purify {temp opd0} $val
		my quads purify {temp opd1} $delta
		my quads add $val {temp opd0} {temp opd1}
		my callframe-error-quads $pc directSet $var $var $val
	    }
	    incrArrayStkImm {
		set elem [list temp [incr depth -1]]
		set var [list temp [incr depth -1]]
		set delta [list literal [lindex $insn 1]]
		# TODO: This assumes we're dealing with qualified names!
		set val {temp opd2}
		my error-quads $pc directArrayGet $val $cf $var $elem
		my generate-arith-domain-check $pc incr $val $delta
		my quads purify {temp opd0} $val
		my quads purify {temp opd1} $delta
		my quads add $val {temp opd0} {temp opd1}
		my callframe-error-quads $pc directArraySet $var $var $elem $val
	    }
	    incrArrayStk {
		set delta [list temp [incr depth -1]]
		set elem [list temp [incr depth -1]]
		set var [list temp [incr depth -1]]
		# TODO: This assumes we're dealing with qualified names!
		set val {temp opd2}
		my error-quads $pc directArrayGet $val $cf $var $elem
		my generate-arith-domain-check $pc incr $val $delta
		my quads purify {temp opd0} $val
		my quads purify {temp opd1} $delta
		my quads add $val {temp opd0} {temp opd1}
		my callframe-error-quads\
		    $pc directArraySet $var $var $elem $val
	    }
	    appendStk {
		set value [list temp [incr depth -1]]
		set var [list temp [incr depth -1]]
		# TODO: This assumes we're dealing with qualified names!
		my error-quads $pc directAppend $var $var $value
	    }
	    appendArrayStk {
		set value [list temp [incr depth -1]]
		set elem [list temp [incr depth -1]]
		set var [list temp [incr depth -1]]
		# TODO: This assumes we're dealing with qualified names!
		my callframe-error-quads \
		    $pc directArrayAppend $var $var $elem $value
	    }
	    lappendStk {
		set value [list temp [incr depth -1]]
		set var [list temp [incr depth -1]]
		# TODO: This assumes we're dealing with qualified names!
		# TODO: Typecheck: need list in $var
		my callframe-error-quads \
		    $pc directLappend $var $var $value
	    }
	    lappendListStk {
		set listvalue [list temp [incr depth -1]]
		set var [list temp [incr depth -1]]
		# TODO: This assumes we're dealing with qualified names!
		# TODO: Typecheck: need lists in $var and $listvalue
		my callframe-error-quads \
		    $pc directLappendList $var $var $listvalue
	    }
	    lappendArrayStk {
		set value [list temp [incr depth -1]]
		set elem [list temp [incr depth -1]]
		set var [list temp [incr depth -1]]
		# TODO: This assumes we're dealing with qualified names!
		# TODO: Typecheck: need list in $var
		my callframe-error-quads \
		    $pc directArrayLappend $var $var $elem $value
	    }
	    lappendListArrayStk {
		set listvalue [list temp [incr depth -1]]
		set elem [list temp [incr depth -1]]
		set var [list temp [incr depth -1]]
		# TODO: This assumes we're dealing with qualified names!
		# TODO: Typecheck: need lists in $var and $listvalue
		my callframe-error-quads $pc \
		    directArrayLappendList $var $var $elem $listvalue
	    }
	    existStk {
		set var [list temp [incr depth -1]]
		# TODO: This assumes we're dealing with qualified names!
		my quads directExists $var $cf $var
	    }
	    existArrayStk {
		set elem [list temp [incr depth -1]]
		set var [list temp [incr depth -1]]
		# TODO: This assumes we're dealing with qualified names!
		my quads directArrayExists $var $cf $var $elem
	    }
	    loadStk {
		set var [list temp [incr depth -1]]
		# TODO: This assumes we're dealing with qualified names!
		my error-quads $pc directGet $var $cf $var
	    }
	    loadArrayStk {
		set elem [list temp [incr depth -1]]
		set var [list temp [incr depth -1]]
		# TODO: This assumes we're dealing with qualified names!
		my error-quads $pc directArrayGet $var $cf $var $elem
	    }
	    storeStk {
		set value [list temp [incr depth -1]]
		set var [list temp [incr depth -1]]
		# TODO: This assumes we're dealing with qualified names!
		my callframe-error-quads $pc directSet $var $var $value
	    }
	    storeArrayStk {
		set value [list temp [incr depth -1]]
		set elem [list temp [incr depth -1]]
		set var [list temp [incr depth -1]]
		# TODO: This assumes we're dealing with qualified names!
		my callframe-error-quads $pc \
		    directArraySet $var $var $elem $value
	    }
	    unsetStk {
		set flags [list literal [lindex $insn 1]]
		set var [list temp [incr depth -1]]
		# TODO: This assumes we're dealing with qualified names!
		my callframe-error-quads $pc \
		    directUnset {temp opd0} $var $flags
	    }
	    unsetArrayStk {
		set flags [list literal [lindex $insn 1]]
		set elem [list temp [incr depth -1]]
		set var [list temp [incr depth -1]]
		# TODO: This assumes we're dealing with qualified names!
		my callframe-error-quads $pc \
		    directArrayUnset {temp opd0} $var $elem $flags
	    }
	    dictGet {
		set idxNum [lindex $insn 1]
		set q {}
		for {set i 0} {$i < $idxNum} {incr i} {
		    # NOTE: Reversed
		    lappend q [list temp [incr depth -1]]

		#	  the invoked procedure raises an error
		set qd [list [list temp [expr {$depth + $acount}]]]
		for {set i $rcount} {$i < $acount} {incr i} {
		    lappend qd [list temp [expr {$depth + $i}]]
		}
		my generate-function-param-check $pc $qd
		# generate the call itself
		my quads invoke $cf $cf {*}$qd
		my quads retrieveResult {temp @exception} $cf
		my quads extractCallFrame $cf $cf
		my generate-jump [my exception-target $pc catch] maybe \
		    {temp @exception}
		my quads extractMaybe $result {temp @exception}
	    }
	    invokeStk1 - invokeStk4 {
		set acount [lindex $insn 1]
		set depth [expr {$depth - $acount}]
		set result [list temp $depth]
		set qd {}
		for {set i 0} {$i < $acount} {incr i} {
		    lappend qd [list temp [expr {$depth + $i}]]
		}
		my generate-function-param-check $pc $qd
		# generate the call itself
		my quads invoke $cf $cf {*}$qd
		my quads retrieveResult {temp @exception} $cf
		my quads extractCallFrame $cf $cf
		my generate-jump [my exception-target $pc catch] maybe \
		    {temp @exception} 
		my quads extractMaybe $result {temp @exception}
	    }
	    jump1 - jump4 {
		switch -exact -- [lindex $insn 1 0] {
		    pc {

		    my generate-jump $to_pc true $test
		}
	    }
	    existScalar {
		set result [list temp $depth]
		set var [my index-to-var [lindex $insn 1]]
		my quads moveFromCallFrame \
		    $var $cf [list literal [lindex $var 1]]
		my quads exists $result $var
	    }
	    existArray {
		set tmp [list temp $depth]
		set idx [list temp [incr depth -1]]
		set ary [my index-to-var [lindex $insn 1]]
		set result $idx
		my quads moveFromCallFrame \
		    $var $cf [list literal [lindex $var 1]]
		my quads initArrayIfNotExists $tmp $ary
		my quads arrayElementExists $result $tmp $idx
	    }

	    loadScalar1 -
	    loadScalar4 {	# Load a variable
		set result [list temp $depth]

		set res [list temp $depth]
		# TODO: Typecheck: need lists in $list1 and $list2
		my error-quads $pc listConcat $res $list1 $list2
	    }
	    arrayExistsImm {
		set ary [my index-to-var [lindex $insn 1]]
		my quads moveFromCallFrame \
		    $ary $cf [list literal [lindex $ary 1]]
		set res [list temp $depth]
		my quads arrayExists $res $ary
	    }
	    arrayMakeImm {
		set ary [my index-to-var [lindex $insn 1]]
		my generate-array-check $pc $ary {} {TCL WRITE ARRAY} \
		    "can't array set \"%s\": variable isn't array"
		my quads initArrayIfNotExists $ary $ary
		my update-in-callframe [list literal [lindex $var 1]] $var
	    }
	    arrayExistsStk {
		set ary [list temp [incr depth -1]]
		set res [list temp $depth]
		my error-quads $pc directIsArray $res $cf $ary
	    }
	    arrayMakeStk {
		set ary [list temp [incr depth -1]]
		set res [list temp $depth]
		my callframe-error-quads $pc directMakeArray $res $ary
	    }
	    variable {
		set var [my index-to-var [lindex $insn 1]]
		set name [list temp [incr depth -1]]
		my quads [lindex $insn 0] $cf $cf \
		    [list literal [lindex $var 1]] $name
		my quads retrieveResult {temp @exception} $cf
		my quads extractCallFrame $cf $cf
		my generate-jump [my exception-target $pc catch] \
		    maybe {temp @exception}
	    }
	    nsupvar - upvar {
		set var [my index-to-var [lindex $insn 1]]
		set name [list temp [incr depth -1]]
		set context [list temp [incr depth -1]]
		my quads [lindex $insn 0] $cf $cf \
		    [list literal [lindex $var 1]] $context $name
		my quads retrieveResult {temp @exception} $cf
		my quads extractCallFrame $cf $cf
		my generate-jump [my exception-target $pc catch] \
		    maybe {temp @exception}
	    }
	    currentNamespace {
		my quads copy [list temp $depth] \
		    [list literal [dict get $bytecode namespace]]
	    }
	    infoLevelArgs {
		set value [list temp [incr depth -1]]
		set r [list temp $depth]
		my generate-arith-domain-check $pc [lindex $insn 0] $value
		my quads purify {temp opd0} $value
		my error-quads $pc frameArgs $r {temp opd0} $cf
	    }
	    infoLevelNumber {
		set r [list temp $depth]
		my quads frameDepth $r $cf
	    }
	    expandStart {
		# do nothing
	    }
	    expandStkTop {
		set r [list temp [incr depth -1]]
		my error-quads $pc verifyList $r $r
		my quads expand $r $r
	    }
	    invokeExpanded {
		lassign [dict get $bytecode stackState $state] headWas depthWas
		set result [list temp $depthWas]
		set qd {}
		for {set i $depthWas} {$i < $depth} {incr i} {
		    lappend qd [list temp $i]
		}
		my quads \
		    invokeExpanded $cf $cf {*}$qd
		my quads retrieveResult {temp @exception} $cf
		my quads extractCallFrame $cf $cf
		my generate-jump [my exception-target $pc catch] maybe \
		    {temp @exception}
		my quads extractMaybe $result {temp @exception}
	    }
	    default {
		# TODO - Many more instructions
		lappend errors $sourcefile $currentline $currentscript \

	    lset quads $q 1 [list pc [llength $quads]]
	}
	# let the flow analysis figure out whether this is confluent!
	# lappend quads confluence
	my quads returnCode [set code [list temp 0]] {temp @exception}
	my quads procLeave $code $code \
	    [list literal [namespace tail $originProc]]
	my quads return {} $cf $code
	dict unset fixup -1
    }
    if {[dict size $fixup] > 0} {
	error "Failed to fix jumps at [join [dict keys $fixup] ,]"
    }
    if {[llength $errors] > 1} {
	set result {}

# Results:
#	None.

oo::define quadcode::transformer method error-quads {pc opcode result args} {
    my quads $opcode {temp @exception} {*}$args
    set target [my exception-target $pc catch]
    my generate-jump $target maybe {temp @exception}

    my quads extractMaybe $result {temp @exception}
    return
}

# callframe-error-quads --
#
#	Generate the given quadcode, and the sequence that intercepts
#	its errors and unpacks its (callframe, maybe result} tuple.
#
# Parameters:
#	pc - Program counter from the original bytecode
#	opcode - Opcode being emitted
#	result - Result of the operation, which must be CALLFRAME FAIL SOMETHING
#	args - Inputs to the operation.
#
# Results:
#	None

oo::define quadcode::transformer method callframe-error-quads {pc opcode result
							       args} {

    my quads $opcode {temp @tuple} {temp @callframe} {temp @callframe} $args
    my quads extractCallFrame {temp @callframe} {temp @tuple}
    my quads retrieveResult {temp @exception} {temp @tuple}
    set target [my exception-target $pc catch]
    my generate-jump $target maybe {temp @exception}
    my quads extractMaybe $result {temp @exception}
    
}

# interp alias {} tcl::mathfunc::istype {} ::dataType::isa

# Local Variables:
# mode: tcl
# fill-column: 78
# auto-fill-function: nil
# End:

	    set did 0
	    switch -exact -- [lindex $q 0] {

		"directArrayExists" -
		"directArrayGet" -
		"directExists" -
		"directGet" -
		"directIsArray" {
		    dict set result readsGlobal {}
		    dict unset result pure
		}

		"directAppend" -
		"directArrayAppend" -
		"directArrayLappend" -
		"directArrayLappendList" -
		"directArraySet" -
		"directArrayUnset" -
		"directLappend" -
		"directLappendList" -
		"directUnset" {
		    dict set result readsGlobal {}
		    dict set result writesGlobal {}
		    dict unset result pure
		    dict unset result killable
		}

		"directMakeArray" -
		"directSet" {
		    dict set result writesGlobal {}
		    dict unset result pure
		    dict unset result killable
		}

		"moveFromCallFrame" {

{{purifyParam N} TGT SRC FUNC}
   Sets TGT to SRC, with any IMPURE indication removed, if FUNC is a built-in
   math function requiring a pure value as argument #N.
   Otherwise, simply sets TGT to SRC. This operation is
   replaced with 'purify' or removed during optimization. It is there to
   purify the operands of built-in mathfuncs.

# Direct variable manipulation instructions

directExists VAL CF VAR
    Tests whether variable VAR exists (in callframe CF, if the value is
    not fully qualified). Returns ZEROONE.
directGet VAL CF VAR
    Gets the value of VAR from callframe CF and puts the result in VAL.
    Result is of type {FAIL NEXIST STRING}.
directSet TUPLE CF VAR VAL
    Sets variable VAR in callframe CF (or in a namespace) to the value VAL.
    Returns the result of the set, or an error if the value cannot be set.
    TUPLE is of type {CALLFRAME FAIL T} where T is the type of VAL.
directAppend TUPLE CF VAR VAL
    Appends value VAL to variable VAR in callframe CF (or in a namespace).
    Returns the result of the set, or an error if the value cannot be set.
    TUPLE is of type {CALLFRAME FAIL STRING}.
directLappend TUPLE CF VAR VAL
    Appends value VAL to variable VAR in callframe CF (or in a namespace).
    Returns the result of the set, or an error if the value cannot be set.
    TUPLE is of type {CALLFRAME FAIL STRING}.
directLappendList TUPLE CF VAR LISTVAL
    Appends the list of values LISTVAL to variable VAR in callframe CF
    (or in a namespace). Returns the result of the append, or an error if
    the value could not be apppended. TUPLE is of type {CALLFRAME FAIL STRING}
directIsArray VAL CF ARY
    Tests [array exists ARY] (in callframe CF, if ARY is not fully qualified).
    Returns a Boolean indicating the existence, or an error in the event of
    an error in traces. (Note that traces are not implemented in quadcode yet!)
    Result is of type {FAIL ZEROONE}.
directMakeArray TUPLE CF ARY
    Creates an array ARY (in callframe CF if ARY is not fully qualified).
    Returns an ignored result or throws an error. Return type is {ZEROONE FAIL}.
directArrayExists VAL CF ARY ELT
    Tests whether element ELT of array ARY exists (in callframe CF, if the
    value is not fully qualified). Returns ZEROONE.
directArrayGet VAL CF ARY ELT
    Gets the value of element ELT of array ARY in callframe CF and puts
    the result in VAL. Result is of type {FAIL NEXIST STRING}.
directArraySet TUPLE CF ARY ELT VAL
    Sets element ELT of array ARY in callframe CF (or in a namespace) to the
    value VAL. Returns the result of the set, or an error if the value cannot
    be set. TUPLE is of type {CALLFRAME FAIL T} where T is the type of VAL.
directArrayAppend TUPLE CF ARY ELT VAL
    Appends value VAL to element ELT of array ARY (in callframe CF if ARY
    is not fully qualified).
    Returns the result of the set, or an error if the value cannot be set.
    TUPLE is of type {CALLFRAME FAIL STRING}.
directArrayLappend TUPLE CF ARY ELT VAL
    Appends value VAL to element ELT of array ARY (in callframe CF, if
    ARY is not fully qualified).  Returns the result of the operation,
    or an error if the value cannot be set.  TUPLE is of type
    {CALLFRAME FAIL STRING}.
directArrayLappendList TUPLE CF ARY ELT LISTVAL
    Appends the list of values LISTVAL to element ELT of array ARY
    (in callframe CF, if ARY is not fully qualified).
    Returns the result of the append, or an error if
    the value could not be apppended. TUPLE is of type {CALLFRAME FAIL STRING}

For these operations, the data types that must be implemented are INT32,
INT, ENTIER, DOUBLE; the same four data types unioned with EMPTY; and the
complements of these eight types, so there are sixteen variants in all.