# Parameters:
    #	to - Successor of the new block
    #
    # Results:
    #	Returns the new block's block number

    method makeEmptyBB {{to -1}} {

	# Create the block, with a jump if needed.
	set newb [llength $bbcontent]
	if {$to >= 0} {
	    lappend bbcontent [list [list jump [list bb $to]]]
	} else {
	    lappend bbcontent {}
	}
	lappend bbpred {}

	# Link $to to the new block
	if {$to >= 0} {
	    my bblink $newb $to
	}

	return $newb
    }

    # replaceBB --
    #
    #	Replaces the content of a basic block
    #
    # Parameters:
    #	b - Block number to replace
    #	bb - New content
    #
    # Results:
    #	None.

    method replaceBB {b bb} {
	lset bbcontent $b $bb
    }

    # gettBB --
    #
    #	Retrieves the content of a basic block
    #
    # Parameters:
    #	b - Block number to retrieve
    #
    # Results:
    #	Returns the basic block content

    method getBB {b} {
	return [lindex $bbcontent $b]
    }

    # bbcopy --
    #
    #	Makes a copy of a basic block
    #
    # Parameters:
    #	b - Block number to copy

oo::class create quadcode::builder {

    variable xfmr;		# quadcode::transformer object containing
    ;				# the quadcode of interest.

    variable b;			# Basic block number under construction



    variable bbindex;		# Dictionary whose keys are the names of
    ;				# basic blocks and whose values are the
    ;				# basic block numbers.

    variable varindex;		# Dictionary whose keys are named variables
    ;				# and whose values are the SSA names of the
    ;				# variables.

oo::define quadcode::builder constructor {xfmr_ b_ bb_} {
    set xfmr $xfmr_
    set b $b_
    set bb $bb_
    set bbindex {}
    set varindex {}
    $xfmr replaceBB $b $bb
}

# quadcode::builder method curblock --
#
#	Returns the number of the current basic block.
#
# Results:
#	Basic block number

oo::define quadcode::builder method curblock {} {
    return $b
}

# quadcode::builder method makeblock --
#
#	Makes a new basic block.
#
# Parameters:
#	name - Name to give to the block
#
# Results:
#	Returns the basic block number
#
# Side effects:
#	Creates the block. Stores the block index in 'bbindex' if name is
#	supplied

oo::define quadcode::builder method makeblock {{name {}}} {

    # Create the block
    set newb [$xfmr makeEmptyBB]

    # Index the block
    if {$name ne {}} {
        dict set bbindex $name $newb
    }

    return $newb
}

# quadcode::builder method getblock --
#
#	Finds a basic block created by 'makeblock'
#
# Parameters:
#	name - Name of the block
#
# Results:
#	Returns the basic block number, or -1 if there is no such block

oo::define quadcode::builder method getblock {name} {
    if {![dict exists $bbindex $name]} {
        return -1
    } else {
        return [dict get $bbindex $name]
    }
}

# quadcode::builder method buildin --
#
#	Switch to a different basic block for building
#
# Parameters:
#	newb - Basic block to start building in.
#
# Results:
#	None.

oo::define quadcode::builder method buildin {newb} {

    # Set to build in the new basic block
    set b $newb

    return

}

# quadcode::builder method maketemp --
#
#	Makes a temporary variable.
#
# Parameters:

    # Split the instruction
    lassign $q opcode res argl

    # Handle the result
    switch -exact -- [lindex $res 0] {
        "bb" {

	    # Instruction is a jump, link the basic block to the jump target
            $xfmr bblink $b [lindex $res 1]
        }
        "temp" - "var" {

	    # Instrtuction is an assignment, update the ud-chain.
            $xfmr addDef $res $b
        }
    }

    # Handle the arguments
    foreach arg [lrange $q 2 end] {
        switch -exact -- [lindex $arg 0] {
            "temp" - "var" {

		# Argument is an SSA value, update the du-chain.
		$xfmr addUse $arg $b
            }
        }
    }

    # Add the instruction to the block
    set bb [$xfmr getBB $b]
    $xfmr replaceBB $b {}
    lappend bb $q
    $xfmr replaceBB $b $bb

    return
}

# quadcode::builder method updatephi --
#
#	Adds a given basic block and value as the source of a phi
#	operation in another block.
#
# Parameters:
#	to - Basic block being jumped to
#	var - Variable output from the phi
#	val - Data source for that variable.
#
# Results:
#	None.
#
# Side effects:
#	Adds to the phi the given value, indicated as coming from
#	the builder's current block.

oo::define quadcode::builder method updatephi {to var val} {

    # Get the target basic block
    set targetbb [$xfmr getBB $to]
    $xfmr replaceBB $to {}

    # Find the phi
    set pc -1
    foreach q $targetbb {
        incr pc
        if {[lindex $q 0] ne "phi"} {
            break
        }
        if {[lindex $q 1] eq $var} {
            set targetpc $pc
            break
        }
    }

    # Bail out if we can't find it
    if {![info exists targetpc]} {
        error "Cannot find variable $var in a phi in block $to"
    }

    # Update the phi
    set q [lindex $targetbb $targetpc]
    lset targetbb $targetpc {}
    lappend q [list bb $b] $val
    lset targetbb $targetpc $q
    $xfmr addUse $val $to

    # Put the target basic block back
    $xfmr replaceBB $to $targetbb
}

if 0 { # Rethink, if anything uses this...
# quadcode::builder method bb --
#
#	Returns the content of the basic block under construction.
#
# Results:
#	Returns the instructions.

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

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

			}
			my addUse $opd $b
		    }
		}
	    }
	}
    }

    # addDef --
    #
    #	Updates ud-chain to define a variable
    #
    # Parameters:
    #	var - Variable whose definition is being added.
    #	b - Basic block containing the added use.
    #
    # Results:
    #	None.

    method addDef {var b} {
	dict set udchain $var $b
	return
    }

    # addUse --
    #
    #   Updates du-chains to add a use to a variable
    #
    # Parameters:
    #	var - Variable whose use is being added. It is harmless to call
    #	      this procedure for things other than variables, but has no

		# and consists of the quadcode statement 'dquad'.
		if {[catch {

		    # Finding the definition will throw an error at a phi.
		    # The error can be ignored, because phi is not 'arrayExists'
		    # 'exists' or 'instanceOf'.
		    my findDef [lindex $q 2]
		} result]} {
		    my debug-narrow {
			puts "cannot find data source of [lindex $q 2]"
			continue
		    }
		}
		lassign $result dbb dpc dquad
		my debug-narrow {
		    puts "data source is $dbb:$dpc: $dquad"
		}
		set dop [lindex $dquad 0 0]

		switch -exact -- $dop {

		    arrayExists {
			set dvar [lindex $dquad 2]
			if {[lindex $dvar 0] ni {var temp}} continue

	set newb {}
	set newpc -1
	set pc -1
	set singleExit 1
	foreach q $bb {
	    incr pc
	    if {[lindex $q 0 0] eq "phi"} {
		foreach {from val} [lrange $q 2 end] {
		    my removeUse $val $from
		}
		continue
	    }
	    if {[lindex $q 0 0] eq "jump"} {
		break
	    }
	    if {[lindex $q 1 0] eq "bb"} {
		set singleExit 0

		    break
		}
		set src [dict get $argl $bkey]
		if {$src eq "Nothing"} {
		    set q3 [list unset $dest]
		} else {
		    set q3 [list copy $dest $src]
		    my addUse $src $b
		}
		my debug-deconstructSSA {
		    puts "    [incr newpc]: $q3"
		}
		lappend newb $q3
	    }
	}

	    ud_du_chain
	    copyprop
	} {
	    my debug-transform {
		puts "Run: $pass"
	    }
	    lappend timings $pass [lindex [time [list my $pass]] 0]




	}
	my debug-timings {
	    foreach {pass usec} $timings {
		puts "$pass: $usec microseconds"
	    }
	}
	my debug-transform {

    }

    my debug-varargs {
        puts "After variadic call replacement:"
        my dump-bb
    }

    my debug-audit {
        my audit-phis varargs
        my audit-duchain varargs
    }

}

# quadcode::transformer method va_RewriteInvoke --
#
#       Rewrites 'invoke' and 'invokeExpanded' instructions to accommodate
#       compiled procs that accept variable numbers of arguments without going
#       through a call thunk or losing data type information.

    my debug-varargs {
        puts "varargs: result retrieval: $q1"
    }
    if {[lindex $q1 0] ne "retrieveResult" || [lindex $q1 2] ne [lindex $q 1]} {
        error "mislinked invoke: should be followed with 'retrieveResult'"
    }
    set result [lindex $q1 1]
    $B emit [list retrieveResult [$B maketemp "result"] [lindex $newq 1]]
    my debug-varargs {
        $B log-last
    }

    # Check that the extractCallFrame is linked correctly, and bring in
    # the 'extractCallFrame'
    set q2 [lindex $bb 1]
    my debug-varargs {
        puts "varargs: callframe extraction: $q2"
    }
    if {[lindex $q2 0] ne "extractCallFrame"
        || [lindex $q2 2] ne [lindex $q 1]} {
        error "mislinked invole: should be followed with 'extractCallFrame'"
    }
    set cf [lindex $q2 1]
    $B emit [list extractCallFrame [$B maketemp "callframe"] [lindex $newq 1]]
    my debug-varargs {
        $B log-last
    }

    set cfin [lindex $q 1]
    my va_ConvergeErrorPath $B $result $cf $cfin [lreplace $bb[set bb ""] 0 1]

    # don't use it, 'deadvars' will get rid of this, anyway.)
    set lenLoc1 [my newVarInstance {temp @arglen}]
    set lenLoc [$B maketemp arglen]
    $B emit [list listLength $lenLoc1 [$B gettemp arglist]]
    my debug-varargs {
        $B log-last
    }
    if {$mightThrow} {
        my va_MakeErrorCheck $B $lenLoc1
        set mightThrow 0
    }
    $B emit [list extractMaybe $lenLoc $lenLoc1]
    my debug-varargs {
        $B log-last
    }


    # Count the mandatory args

    set bb [lindex $bbcontent $b]
    lset bbcontent $b {}
    my debug-varargs {
        puts "varargs: Split basic block $b:"
        puts "   $b:$pc: [lindex $bb $pc]"
    }

    set tail [lrange $bb $pc end]
    set bb [lreplace $bb[set bb {}] $pc end]
    lset bbcontent $b $bb
    foreach q $tail {
        if {[lindex $q 1 0] in {"temp" "var"}} {
            dict unset udchain [lindex $q 1]
        }
        foreach arg [lrange $q 2 end] {
            if {[lindex $arg 0] in {"temp" "var"}} {
                my removeUse $arg $b
            }
        }
    }
    foreach b2 [my bbsucc $b] {
        my removePred $b2 $b
    }

    return [lreplace $tail[set tail {}] 0 0]
}

# quadcode::transformer method va_NonExpandedArgument --
#
#	Transfer a leading non-expanded argument into a quad
#	under construction when rewriting 'invokeExpanded'
#

        switch -exact -- [lindex $arg 0] {
            "literal" {
                set listloc [$B maketemp arglist]
                $B emit [list list $listloc $arg]
                my debug-varargs {
                    $B log-last
                }




                set mightThrow 0
            }
            "temp" - "var" {
                lassign [my findDef $arg] defb defpc defstmt
                if {[lindex $defstmt 0] eq "expand"} {
                    my debug-varargs {
                        puts "  (which is expanded!)"
                    }
                    set listLoc [$B maketemp arglist]
                    $B emit [list copy $listLoc [lindex $defstmt 2]]
                    my debug-varargs {
                        $B log-last
                    }
                    set mightThrow 1
                } else {
                    set intLoc [$B maketemp arglist]
                    set listLoc [$B maketemp arglist]
                    my debug-varargs {
                        puts "  (which is not expanded)"
                    }
                    $B emit [list list $listLoc $arg]




                    my debug-varargs {
                        $B log-last
                    }
                    set mightThrow 0
                }
            }
        }

# Results:
#	None.
#
# Side effects:
#	Emits the necessary jumpMaybe, and adds FAIL value
#	to the phi operation at the head of the error block.

oo::define quadcode::transformer method va_MakeErrorCheck {B val} {



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

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

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




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

    # Add phis for the error result ant the callframe to the error block
    set errorInPhi [$B gettemp error]
    $B updatephi $errorb $errorInPhi $val

    # Now continue building in the normal exit
    $B buildin $nextb
}

# quadcode::transformer method va_MakeErrorBlock --
#
#	Makes the block to which all the error paths in an invocation
#	sequence jump.
#
# Parameters:
#	B - Builder that is emitting code
#
# Results:
#	Returns the number of the block.
#
# Side effects:
#	Creates the block, and adds a vacuous 'phi' operation to it that
#	will hold the FAIL value from the error. The block and the result
#	of the 'phi' are both named 'error' in the builder.

oo::define quadcode::transformer method va_MakeErrorBlock {B} {

    my debug-varargs {
        puts "varargs: Create a block for error exits."
    }
    set currentb [$B curblock]
    set errorb [$B makeblock error]

    $B buildin $errorb
    set errortemp [$B maketemp error]
    $B emit [list phi $errortemp]
    my debug-varargs {
        $B log-last
    }

    $B buildin $currentb
    return
}

# quadcode::transformer method va_UnpackMandatory --
#
#	Unpacks the mandatory args to a proc from the list created
#	by argument expansion
#
# Parameters;

#
# Side effects:
#	Emits all the remaining code.

oo::define quadcode::transformer method va_ConvergeErrorPath {B result
                                                              cf cfin bb} {

    # Find where errors were routed
    set errorb [$B getblock "error"]
    set normresult [$B gettemp "result"]
    set normcf [$B gettemp "callframe"]
    if {$errorb < 0} {

        # Nothing could throw, so just emit copies of the callframe and
        # the command's result. The copies will get cleaned up later

        $B emit [list copy $cf $normcf]
        my debug-varargs {
            $B log-last
        }
        $B emit [list copy $result $normresult]
        my debug-varargs {
            $B log-last
        }
    } else {

        # There is an error path that has to join here. Emit a jump to the
        # join point.
        set normb [$B curblock]
        set finalb [$B makeblock]
        $B emit [list jump [list bb $finalb]]
        my debug-varargs {
            $B log-last
        }

        # Move to the error block, and emit a jump to the join point
        set errResult [$B gettemp "error"]
        set errFail [$B gettemp "error"]
        $B buildin $errorb
        $B emit [list extractFail $errFail $errResult]
        my debug-varargs {
            $B log-last
        }
        $B emit [list jump [list bb $finalb]]
        my debug-varargs {
            $B log-last
        }

        # Move to the finalization block, and emit phis for the callframe
        # and the result

        $B buildin $finalb
        $B emit [list phi $cf \
                     [list bb $errorb] $cfin [list bb $normb] $normcf]
        my debug-varargs {
            $B log-last
        }
        $B emit [list phi $result \
                     [list bb $errorb] $errFail [list bb $normb] $normresult]
        my debug-varargs {
            $B log-last
        }
    }

    # Put back the instructions that followed the 'invoke'
    foreach q $bb {
        $B emit $q
        my debug-varargs {
            $B log-last