Index: quadcode/varargs.tcl ================================================================== --- quadcode/varargs.tcl +++ quadcode/varargs.tcl @@ -294,10 +294,14 @@ # in the parameter list of [invoke]. # $pos will be the position in the parameter list of the first # parameter that needs special handling. set argl [lrange $q 4 end] set pos 0 + my debug-varargs { + puts "varargs: pos = $pos (of $nPlainParams)" + puts " argl = $argl" + } while {$pos < $nPlainParams} { if {[my va_NonExpandedArgument newq $arginfo $pos $argl]} break incr pos } @@ -374,32 +378,28 @@ my debug-varargs { puts "Emit length check and extraction for optional param \ $i: [lindex $arginfo $i] (default=$defaultVal)" } - lassign [my va_UnpackOptional $B $newq $j] \ - newq fromBlock argLoc + lassign [my va_UnpackOptional $B $j] fromBlock argLoc lappend optInfo [list $fromBlock $defaultVal $argLoc] incr i incr j } - error "NOT FINISHED - Close out the optional params." - # Close out the last basic block, switch to the 'finish' block # and emit 'phi' instructions to get the correct parameter set - my va_FinishOptional b bb newq $finishB $optInfo + set newq [my va_FinishOptional $B $newq $optInfo] } # If the procedure has 'args', then fill it in with the remainder of the # arg list. if {$haveargs} { my va_DoArgs $B newq $j } else { - error "NOT DONE - varargs needs to check for excess args" - my va_CheckTooMany b bb $lenLoc $compTemp $j $notokb + my va_CheckTooMany $B $callee $j } return $newq } @@ -422,16 +422,24 @@ oo::define quadcode::transformer method va_NonExpandedArgument {newqVar arginfo pos argl} { upvar 1 $newqVar newq + # If the list is exhausted, return. + if {$pos >= [llength $argl]} { + return 1 + } + + # Extract the parameter and its name set param [lindex $arginfo $pos] set arg [lindex $argl $pos] my debug-varargs { puts "varargs: transfer actual arg [list $arg] into formal arg\ \"$param\"" } + + # Quit at the first {*} expansion or on a parameter that is not understood switch -exact -- [lindex $arg 0] { "literal" { } "temp" - "var" { lassign [my findDef $arg] defb defpc defstmt @@ -441,10 +449,12 @@ } default { return 1 } } + + # Put the parameter on the new 'invoke' instruction lappend newq $arg return 0 } # quadcode::transformer method va_MakeArgList -- @@ -466,29 +476,33 @@ oo::define quadcode::transformer method va_MakeArgList {B argl pos cfin} { my debug-varargs { puts "varargs: make arg list for [list $argl] from position $pos" } + + set listLoc [$B maketemp arglist] # Handle the first arg. 'listloc' will be the variable holding the # expanded arglist. 'mightThrow' will be 1 if 'listloc' # might be a non-list and 0 otherwise. if {$pos >= [llength $argl]} { my debug-varargs { puts "varargs: there are no args to list" } - set listLoc "literal {}" + $B emit [list copy $listLoc {literal {}}] + my debug-varargs { + $B log-last + } set mightThrow 0 } else { set arg [lindex $argl $pos] my debug-varargs { puts "varargs: transfer first arg [list $arg]" } switch -exact -- [lindex $arg 0] { "literal" { - set listloc [$B maketemp arglist] - $B emit [list list $listloc $arg] + $B emit [list list $listLoc $arg] my debug-varargs { $B log-last } set mightThrow 0 } @@ -496,19 +510,16 @@ 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 { @@ -570,10 +581,14 @@ my debug-varargs { $B log-last } } + my debug-varargs { + puts "varargs: arg list assembled in [$B gettemp arglist]" + puts " mightThrow = $mightThrow" + } return $mightThrow } # quadcode::transformer method va_UnpackMandatory -- @@ -628,84 +643,69 @@ # # Emits code to unpack one optional parameter in an invokeExpanded # # Parameters: # B - Builder that is emitting the invocation sequence -# newq - 'invoke' instruction under construction # j - Position of the parameter being unpacked # # Results: -# Returns a two-element list giving the block number that jumps -# to the finish if the parameter is not supplied and the -# location of a temporary holding the unpacked value if it is. +# +# Returns a two-element list: the block number that will jump to the +# finish if there are too few arguments to match all optional +# parameters, and the location of the argument if one was successfully +# unpacked # # Side effects: # Emits code to unpack one value, or jump to the finish block if # there is nothing to unpack. -oo::define quadcode::transformer method va_UnpackOptional {tempIdxVar bVar - bbVar finishB - compTemp listLoc - lenLoc j} { - upvar 1 $tempIdxVar tempIndex $bVar b $bbVar bb - - set pos [list literal $j] - set compLoc [my newVarInstance $compTemp] - set argTemp [list temp [incr tempIndex]] - set argLoc1 [my newVarInstance $argTemp] - set argLoc2 [my newVarInstance $argTemp] - - # Emit the list length comparison - my va_EmitAndTrack $b bb [list ge $compLoc $pos $lenLoc] - - # Emit the jump to the finish block We need to make an intermediate block - # because otherwise the flowgraph edge would be critical - set intb [llength $bbcontent] - lappend bbcontent {} - lappend bbpred {} - my va_EmitAndTrack $b bb [list jumpTrue [list bb $intb] $compLoc] - - # Create the next block and jump to it - set newb [llength $bbcontent] - lappend bbcontent {} - lappend bbpred {} - my va_EmitAndTrack $b bb [list jump [list bb $newb]] - lset bbcontent $b $bb - - # Make the intermediate block - set b $intb - set bb {} - my va_EmitAndTrack $b bb [list jump [list bb $finishB]] - lset bbcontent $b $bb - - # Advance to the new block - - set b $newb - set bb {} - - # Emit the 'listIndex' to unpack the arg - my va_EmitAndTrack $b bb [list listIndex $argLoc1 $listLoc $pos] - - # Emit the 'extractMaybe' on the 'listIndex' result - my va_EmitAndTrack $b bb [list extractMaybe $argLoc2 $argLoc1] - +oo::define quadcode::transformer method va_UnpackOptional {B j} { + + set compLoc [$B maketemp arg${j}found] + + $B emit [list ge $compLoc [list literal $j] [$B gettemp arglen]] + my debug-varargs { + $B log-last + } + set intb [$B makeblock] + set nextb [$B makeblock] + $B emit [list jumpTrue [list bb $intb] $compLoc] + my debug-varargs { + $B log-last + } + $B emit [list jump [list bb $nextb]] + my debug-varargs { + $B log-last + } + + $B buildin $nextb + + set intLoc [$B maketemp arg$j] + set argLoc [$B maketemp arg$j] + + $B emit [list listIndex $intLoc [$B gettemp arglist] [list literal $j]] + my debug-varargs { + $B log-last + } + $B emit [list extractMaybe $argLoc $intLoc] + my debug-varargs { + $B log-last + } + # Return the place where we stored the arg - return [list $intb $argLoc2] + return [list $intb $argLoc] } # quadcode::transformer method va_FinishOptional -- # # Finish transmitting the args that have default values when # compiling {*} # # Parameters: -# bVar - Variable in caller holding the current basic block number -# bbVar - Variable in caller's scope holding basic block content -# newqVar - Variable in caller's scope holding the 'invoke' -# quadcode under construction -# finishB - Basic block number reserved for the 'finish' block +# B - Builder that is emitting the quadcode invocation sequence +# newq - 'invoke' instruction under construction # optInfo - List of triples: fromBlock defaultValue tempLoc # giving the phi inputs for the block under construction # # Results: # None. @@ -714,30 +714,30 @@ # Closes out the current basic block, opens the finish block, # and emits phi instructions into the finish block. Adds the # outputs of the phi instructions to the 'invoke' instruction # under construction. -oo::define quadcode::transformer method va_FinishOptional {bVar bbVar - newqVar finishB - optInfo} { +oo::define quadcode::transformer method va_FinishOptional {B newq optInfo} { - error "va_FinishOptional: not refactored or tested yet" - upvar 1 $bVar b $bbVar bb $newqVar newq + # Finish the current block and make the join point + set finishB [$B makeblock] - # Finish the current block and start building into 'finishB' - - my va_EmitAndTrack $b bb [list jump [list bb $finishB]] - lset bbcontent $b $bb - set bb {} - set fromb $b - set b $finishB + $B emit [list jump [list bb $finishB]] + set fromb [$B curblock] + $B buildin $finishB # Emit the phi instructions set n 0 foreach tuple $optInfo { - lassign $tuple - defaultVal tempLoc + lassign $tuple fblk defaultVal tempLoc + $B buildin $fblk + $B emit [list jump [list bb $finishB]] + my debug-varargs { + $B log-last + } + $B buildin $finishB set defaultLit [list literal $defaultVal] set newTemp [my newVarInstance $tempLoc] incr n set q [list phi $newTemp] set k -1 @@ -750,13 +750,18 @@ } else { lappend q $defaultLit } } lappend q [list bb $fromb] $tempLoc - my va_EmitAndTrack $b bb $q + $B emit $q + my debug-varargs { + $B log-last + } lappend newq $newTemp } + + return $newq } # quadcode::transformer method va_DoArgs -- # # Emits code to extract the parameter sequence needed to fill '$args' @@ -820,85 +825,102 @@ # The assumption is made that the 'arglen' temporary in $B has the # length of the oo::define quadcode::transformer method va_CheckEnough {B callee minLength} { + set currentb [$B curblock] set compLoc [my newVarInstance {temp @toofew}] set lenLoc [$B gettemp arglen] # compare args provided to args needed $B emit [list gt $compLoc [list literal $minLength] $lenLoc] my debug-varargs { $B log-last } + my va_JumpTrueToWrongArgs $B $callee $compLoc - # jump to a 'wrong # args' error if wrong - set errb [my va_MakeWrongArgs $B $callee] - $B emit [list jumpTrue [list bb $errb] $compLoc] - my debug-varargs { - $B log-last - } - - # jump to okb if right - set okb [$B makeblock] - $B emit [list jump [list bb $okb]] - my debug-varargs { - $B log-last - } - - # return to the 'no failure' branch - $B buildin $okb - + return } # quadcode::transformer method va_CheckTooMany -- # # Emits a codeburst to check whether an 'invokeExpanded' has # too many args # # Parameters: -# bVar - Variable holding the basic block number -# bbVar - Variable holding the content of the current basic block -# lenLoc - LLVM location holding the argument list length -# compTemp - Name of a temporary to use as a comparison result -# i - Index of the next unclaimed argument -# errorB - Basic block number to jump to if there are too many args +# B - Builder that is emitting the quadcode sequence +# callee - Name of the called procedure +# maxLength - Maximum length of the arg list +# +# Results: +# None. +# +# Side effects: +# Emits the check. # # Results: # None # # Side effects: # Emits code and closes the basic block -oo::define quadcode::transformer method va_CheckTooMany {bVar bbVar lenLoc - compTemp i - errorB} { - - upvar 1 $bVar b $bbVar bb - - - set compLoc [my newVarInstance $compTemp] - my va_EmitAndTrack $b bb [list gt $compLoc $lenLoc [list literal $i]] - - set intb [llength $bbcontent] - lappend bbcontent {} - lappend bbpred {} - my va_EmitAndTrack $b bb [list jumpTrue [list bb $intb] $compLoc] - - set newb [llength $bbcontent] - lappend bbcontent {} - lappend bbpred {} - my va_EmitAndTrack $b bb [list jump [list bb $newb]] - lset bbcontent $b $bb - - set b $intb - set bb {} - my va_EmitAndTrack $b bb [list jump [list bb $errorB]] - lset bbcontent $b $bb - - set b $newb - set bb {} +oo::define quadcode::transformer method va_CheckTooMany {B callee maxLength} { + + set compLoc [my newVarInstance {temp @toomany}] + set lenLoc [$B gettemp arglen] + + # Compare args provided against maximum + $B emit [list gt $compLoc $lenLoc [list literal $maxLength]] + my debug-varargs { + $B log-last + } + my va_JumpTrueToWrongArgs $B $callee $compLoc + + return +} + +# quadcode::transformer method va_JumpTrueToWrongArgs +# +# Common logic for va_CheckEnough and va_CheckTooMany +# +# Parameters: +# B - Builder that is emitting an invocation sequence. +# callee - Name of the called command +# compLoc - Quadcode location that contains a true value iff +# the wrong number of arguments is supplied. +# +# Results: +# None. +# +# Side effects: +# Emits a 'jumpTrue' instruction to code that reports the wrong +# number of arguments, and a 'jump' to the following block, and +# builds in the following block + +oo::define quadcode::transformer method va_JumpTrueToWrongArgs {B callee + compLoc} { + + set intb [$B makeblock] + set okb [$B makeblock] + $B emit [list jumpTrue [list bb $intb] $compLoc] + my debug-varargs { + $B log-last + } + $B emit [list jump [list bb $okb]] + my debug-varargs { + $B log-last + } + + set errb [my va_MakeWrongArgs $B $callee] + $B buildin $intb + $B emit [list jump [list bb $errb]] + my debug-varargs { + $B log-last + } + + # return to the 'no failure' branch + $B buildin $okb } # quadcode::transformer method va_MakeWrongArgs -- # @@ -957,11 +979,11 @@ } set errorb [my va_MakeErrorBlock $B] $B emit [list jump [list bb $errorb]] - # Add phis for the error result ant the callframe to the error block + # Add phis for the error result and the callframe to the error block set errorInPhi [$B gettemp error] $B updatephi $errorb $errorInPhi $excloc $B buildin $currentb return $wrongb @@ -1053,11 +1075,11 @@ my debug-varargs { $B log-last } $B buildin $currentb - return + return $errorb } # oo::transformer method va_ConvergeErrorPath -- # # Converges the code for the error and normal paths after an 'invoke'. @@ -1121,11 +1143,10 @@ } # Move to the finalization block, and emit phis for the callframe # and the result - puts "* cfin = $cfin" $B buildin $finalb $B emit [list phi $cf \ [list bb $errorb] $cfin [list bb $normb] $normcf] my debug-varargs { $B log-last