Check-in [4f7b3a4d01]
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to tclconference@googlegroups.com
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Bug fixes to make all the 'expandtest' cases work
Timelines: family | ancestors | descendants | both | notworking | kbk-refactor-callframe
Files: files | file ages | folders
SHA3-256:4f7b3a4d01211450fd3d4b4e993cd17c4b358f60ac483f1eac8bdc05fbd6a3d8
User & Date: kbk 2019-01-22 02:35:48
Context
2019-01-22
02:36
Run dead code elimination before copy propagation because copyprop explodes otherwise. check-in: 9e16d3b8d6 user: kbk tags: notworking, kbk-refactor-callframe
02:35
Bug fixes to make all the 'expandtest' cases work check-in: 4f7b3a4d01 user: kbk tags: notworking, kbk-refactor-callframe
2019-01-21
22:33
Enough partial implementation for expandtest::test1-test3 check-in: 89030dcc42 user: kbk tags: notworking, kbk-refactor-callframe
Changes

Changes to quadcode/varargs.tcl.

   292    292   
   293    293       # Any leading plain arguments that do not have {*} can simply be retained
   294    294       # in the parameter list of [invoke].
   295    295       # $pos will be the position in the parameter list of the first
   296    296       # parameter that needs special handling. 
   297    297       set argl [lrange $q 4 end]
   298    298       set pos 0
          299  +    my debug-varargs {
          300  +        puts "varargs: pos = $pos (of $nPlainParams)"
          301  +        puts "         argl = $argl"
          302  +    }
   299    303       while {$pos < $nPlainParams} {
   300    304           if {[my va_NonExpandedArgument newq $arginfo $pos $argl]} break
   301    305           incr pos
   302    306       }
   303    307   
   304    308       my debug-varargs {
   305    309           puts "varargs: $b:$pc: matched $pos out of $nPlainParams\
................................................................................
   372    376           
   373    377               info default $callee [lindex $arginfo $i] defaultVal
   374    378   
   375    379               my debug-varargs {
   376    380                   puts "Emit length check and extraction for optional param \
   377    381                         $i: [lindex $arginfo $i] (default=$defaultVal)"
   378    382               }
   379         -            lassign [my va_UnpackOptional $B $newq $j] \
   380         -                newq fromBlock argLoc
          383  +            lassign [my va_UnpackOptional $B $j] fromBlock argLoc
   381    384               lappend optInfo [list $fromBlock $defaultVal $argLoc]
   382    385               incr i
   383    386               incr j
   384    387           }
   385    388   
   386         -        error "NOT FINISHED - Close out the optional params."
   387         -
   388    389           # Close out the last basic block, switch to the 'finish' block
   389    390           # and emit 'phi' instructions to get the correct parameter set
   390         -        my va_FinishOptional b bb newq $finishB $optInfo
          391  +        set newq [my va_FinishOptional $B $newq $optInfo]
   391    392   
   392    393       }
   393    394   
   394    395       # If the procedure has 'args', then fill it in with the remainder of the
   395    396       # arg list.
   396    397       if {$haveargs} {
   397    398           my va_DoArgs $B newq $j
   398    399       } else {
   399         -        error  "NOT DONE - varargs needs to check for excess args"
   400         -        my va_CheckTooMany b bb $lenLoc $compTemp $j $notokb
          400  +        my va_CheckTooMany $B $callee $j
   401    401       }
   402    402   
   403    403       return $newq
   404    404   }
   405    405   
   406    406   # quadcode::transformer method va_NonExpandedArgument --
   407    407   #
................................................................................
   420    420   #	end of the possible static transfers.
   421    421   
   422    422   oo::define quadcode::transformer method va_NonExpandedArgument {newqVar arginfo
   423    423                                                                   pos argl} {
   424    424   
   425    425       upvar 1 $newqVar newq
   426    426       
          427  +    # If the list is exhausted, return.
          428  +    if {$pos >= [llength $argl]} {
          429  +        return 1
          430  +    }
          431  +
          432  +    # Extract the parameter and its name
   427    433       set param [lindex $arginfo $pos]
   428    434       set arg [lindex $argl $pos]
   429    435       my debug-varargs {
   430    436           puts "varargs: transfer actual arg [list $arg] into formal arg\
   431    437                 \"$param\""
   432    438       }
          439  +
          440  +    # Quit at the first {*} expansion or on a parameter that is not understood
   433    441       switch -exact -- [lindex $arg 0] {
   434    442           "literal" {
   435    443           }
   436    444           "temp" - "var" {
   437    445               lassign [my findDef $arg] defb defpc defstmt
   438    446               if {[lindex $defstmt 0] eq "expand"} {
   439    447                   return 1
   440    448               }
   441    449           }
   442    450           default {
   443    451               return 1
   444    452           }
   445    453       }
          454  +
          455  +    # Put the parameter on the new 'invoke' instruction
   446    456       lappend newq $arg
   447    457       return 0
   448    458   }
   449    459   
   450    460   # quadcode::transformer method va_MakeArgList --
   451    461   #
   452    462   #	Takes the non-fixed-position arguments of 'invokeExpanded'
................................................................................
   464    474   #	and 0 otherwise.
   465    475   
   466    476   oo::define quadcode::transformer method va_MakeArgList {B argl pos cfin} {
   467    477   
   468    478       my debug-varargs {
   469    479           puts "varargs: make arg list for [list $argl] from position $pos"
   470    480       }
          481  +
          482  +    set listLoc [$B maketemp arglist]
   471    483   
   472    484       # Handle the first arg. 'listloc' will be the variable holding the
   473    485       # expanded arglist. 'mightThrow' will be 1 if 'listloc'
   474    486       # might be a non-list and 0 otherwise.
   475    487       if {$pos >= [llength $argl]} {
   476    488           my debug-varargs {
   477    489               puts "varargs: there are no args to list"
   478    490           }
   479         -        set listLoc "literal {}"
          491  +        $B emit [list copy $listLoc {literal {}}]
          492  +        my debug-varargs {
          493  +            $B log-last
          494  +        }
   480    495           set mightThrow 0
   481    496       } else {
   482    497           set arg [lindex $argl $pos]
   483    498           my debug-varargs {
   484    499               puts "varargs: transfer first arg [list $arg]"
   485    500           }
   486    501           switch -exact -- [lindex $arg 0] {
   487    502               "literal" {
   488         -                set listloc [$B maketemp arglist]
   489         -                $B emit [list list $listloc $arg]
          503  +                $B emit [list list $listLoc $arg]
   490    504                   my debug-varargs {
   491    505                       $B log-last
   492    506                   }
   493    507                   set mightThrow 0
   494    508               }
   495    509               "temp" - "var" {
   496    510                   lassign [my findDef $arg] defb defpc defstmt
   497    511                   if {[lindex $defstmt 0] eq "expand"} {
   498    512                       my debug-varargs {
   499    513                           puts "  (which is expanded!)"
   500    514                       }
   501         -                    set listLoc [$B maketemp arglist]
   502    515                       $B emit [list copy $listLoc [lindex $defstmt 2]]
   503    516                       my debug-varargs {
   504    517                           $B log-last
   505    518                       }
   506    519                       set mightThrow 1
   507    520                   } else {
   508         -                    set intLoc [$B maketemp arglist]
   509         -                    set listLoc [$B maketemp arglist]
   510    521                       my debug-varargs {
   511    522                           puts "  (which is not expanded)"
   512    523                       }
   513    524                       $B emit [list list $listLoc $arg]
   514    525                       my debug-varargs {
   515    526                           $B log-last
   516    527                       }
................................................................................
   568    579           set listLoc [$B maketemp arglist]
   569    580           $B emit [list extractMaybe $listLoc $nloc]
   570    581           my debug-varargs {
   571    582               $B log-last
   572    583           }
   573    584       }
   574    585   
          586  +    my debug-varargs {
          587  +        puts "varargs: arg list assembled in [$B gettemp arglist]"
          588  +        puts "         mightThrow = $mightThrow"
          589  +    }
   575    590       return $mightThrow
   576    591   
   577    592   }
   578    593   
   579    594   # quadcode::transformer method va_UnpackMandatory --
   580    595   #
   581    596   #	Unpacks the mandatory args to a proc from the list created
................................................................................
   626    641   
   627    642   # quadcode::transformer method va_UnpackOptional --
   628    643   #
   629    644   #	Emits code to unpack one optional parameter in an invokeExpanded
   630    645   #
   631    646   # Parameters:
   632    647   #	B - Builder that is emitting the invocation sequence
   633         -#	newq - 'invoke' instruction under construction
   634    648   #	j - Position of the parameter being unpacked
   635    649   #
   636    650   # Results:
   637         -#	Returns a two-element list giving the block number that jumps
   638         -#	to the finish if the parameter is not supplied and the
   639         -#	location of a temporary holding the unpacked value if it is.
          651  +#
          652  +#	Returns a two-element list: the block number that will jump to the
          653  +#	finish if there are too few arguments to match all optional
          654  +#	parameters, and the location of the argument if one was successfully
          655  +#	unpacked
   640    656   #
   641    657   # Side effects:
   642    658   #	Emits code to unpack one value, or jump to the finish block if
   643    659   #	there is nothing to unpack.
   644    660   
   645         -oo::define quadcode::transformer method va_UnpackOptional {tempIdxVar bVar
   646         -                                                               bbVar finishB
   647         -                                                               compTemp listLoc
   648         -                                                               lenLoc j} {
   649         -    upvar 1 $tempIdxVar tempIndex $bVar b $bbVar bb
   650         -
   651         -    set pos [list literal $j]
   652         -    set compLoc [my newVarInstance $compTemp]
   653         -    set argTemp [list temp [incr tempIndex]]
   654         -    set argLoc1 [my newVarInstance $argTemp]
   655         -    set argLoc2 [my newVarInstance $argTemp]
   656         -
   657         -    # Emit the list length comparison
   658         -    my va_EmitAndTrack $b bb [list ge $compLoc $pos $lenLoc]
   659         -
   660         -    # Emit the jump to the finish block We need to make an intermediate block
   661         -    # because otherwise the flowgraph edge would be critical
   662         -    set intb [llength $bbcontent]
   663         -    lappend bbcontent {}
   664         -    lappend bbpred {}
   665         -    my va_EmitAndTrack $b bb [list jumpTrue [list bb $intb] $compLoc]
   666         -
   667         -    # Create the next block and jump to it
   668         -    set newb [llength $bbcontent]
   669         -    lappend bbcontent {}
   670         -    lappend bbpred {}
   671         -    my va_EmitAndTrack $b bb [list jump [list bb $newb]]
   672         -    lset bbcontent $b $bb
   673         -
   674         -    # Make the intermediate block
   675         -    set b $intb
   676         -    set bb {}
   677         -    my va_EmitAndTrack $b bb [list jump [list bb $finishB]]
   678         -    lset bbcontent $b $bb
   679         -
   680         -    # Advance to the new block
   681         -
   682         -    set b $newb
   683         -    set bb {}
   684         -
   685         -    # Emit the 'listIndex' to unpack the arg
   686         -    my va_EmitAndTrack $b bb [list listIndex $argLoc1 $listLoc $pos]
   687         -
   688         -    # Emit the 'extractMaybe' on the 'listIndex' result
   689         -    my va_EmitAndTrack $b bb [list extractMaybe $argLoc2 $argLoc1]
   690         -
          661  +oo::define quadcode::transformer method va_UnpackOptional {B j} {
          662  +
          663  +    set compLoc [$B maketemp arg${j}found]
          664  +    
          665  +    $B emit [list ge $compLoc [list literal $j] [$B gettemp arglen]]
          666  +    my debug-varargs {
          667  +        $B log-last
          668  +    }
          669  +    set intb [$B makeblock]
          670  +    set nextb [$B makeblock]
          671  +    $B emit [list jumpTrue [list bb $intb] $compLoc]
          672  +    my debug-varargs {
          673  +        $B log-last
          674  +    }
          675  +    $B emit [list jump [list bb $nextb]]
          676  +    my debug-varargs {
          677  +        $B log-last
          678  +    }
          679  +
          680  +    $B buildin $nextb
          681  +    
          682  +    set intLoc [$B maketemp arg$j]
          683  +    set argLoc [$B maketemp arg$j]
          684  +    
          685  +    $B emit [list listIndex $intLoc [$B gettemp arglist] [list literal $j]]
          686  +    my debug-varargs {
          687  +        $B log-last
          688  +    }
          689  +    $B emit [list extractMaybe $argLoc $intLoc]
          690  +    my debug-varargs {
          691  +        $B log-last
          692  +    }
          693  +    
   691    694       # Return the place where we stored the arg
   692         -    return [list $intb $argLoc2]
          695  +    return [list $intb $argLoc]
   693    696   
   694    697   }
   695    698   
   696    699   # quadcode::transformer method va_FinishOptional --
   697    700   #
   698    701   #	Finish transmitting the args that have default values when
   699    702   #	compiling {*}
   700    703   #
   701    704   # Parameters:
   702         -#	bVar - Variable in caller holding the current basic block number
   703         -#	bbVar - Variable in caller's scope holding basic block content
   704         -#	newqVar - Variable in caller's scope holding the 'invoke'
   705         -#		  quadcode under construction
   706         -#	finishB - Basic block number reserved for the 'finish' block
          705  +#	B - Builder that is emitting the quadcode invocation sequence
          706  +#	newq - 'invoke' instruction under construction
   707    707   #	optInfo - List of triples: fromBlock defaultValue tempLoc
   708    708   #	          giving the phi inputs for the block under construction
   709    709   #
   710    710   # Results:
   711    711   #	None.
   712    712   #
   713    713   # Side effects:
   714    714   #	Closes out the current basic block, opens the finish block,
   715    715   #	and emits phi instructions into the finish block. Adds the
   716    716   #	outputs of the phi instructions to the 'invoke' instruction
   717    717   #	under construction.
   718    718   
   719         -oo::define quadcode::transformer method va_FinishOptional {bVar bbVar
   720         -                                                               newqVar finishB
   721         -                                                               optInfo} {
          719  +oo::define quadcode::transformer method va_FinishOptional {B newq optInfo} {
   722    720   
   723         -    error "va_FinishOptional: not refactored or tested yet"
   724         -    upvar 1 $bVar b $bbVar bb $newqVar newq
          721  +    # Finish the current block and make the join point
          722  +    set finishB [$B makeblock]
   725    723   
   726         -    # Finish the current block and start building into 'finishB'
   727         -
   728         -    my va_EmitAndTrack $b bb [list jump [list bb $finishB]]
   729         -    lset bbcontent $b $bb
   730         -    set bb {}
   731         -    set fromb $b
   732         -    set b $finishB
          724  +    $B emit [list jump [list bb $finishB]]
          725  +    set fromb [$B curblock]
          726  +    $B buildin $finishB
   733    727   
   734    728       # Emit the phi instructions
   735    729   
   736    730       set n 0
   737    731       foreach tuple $optInfo {
   738         -        lassign $tuple - defaultVal tempLoc
          732  +        lassign $tuple fblk defaultVal tempLoc
          733  +        $B buildin $fblk
          734  +        $B emit [list jump [list bb $finishB]]
          735  +        my debug-varargs {
          736  +            $B log-last
          737  +        }
          738  +        $B buildin $finishB
   739    739           set defaultLit [list literal $defaultVal]
   740    740           set newTemp [my newVarInstance $tempLoc]
   741    741           incr n
   742    742           set q [list phi $newTemp]
   743    743           set k -1
   744    744           foreach tuple2 $optInfo {
   745    745               lassign $tuple2 fromBlock
................................................................................
   748    748               if {$k >= $n} {
   749    749                   lappend q $tempLoc
   750    750               } else {
   751    751                   lappend q $defaultLit
   752    752               }
   753    753           }
   754    754           lappend q [list bb $fromb] $tempLoc
   755         -        my va_EmitAndTrack $b bb $q
          755  +        $B emit $q
          756  +        my debug-varargs {
          757  +            $B log-last
          758  +        }
   756    759           lappend newq $newTemp
   757    760       }
          761  +
          762  +    return $newq
   758    763   }
   759    764   
   760    765   # quadcode::transformer method va_DoArgs --
   761    766   #
   762    767   #	Emits code to extract the parameter sequence needed to fill '$args'
   763    768   #	from the parameter list.
   764    769   #
................................................................................
   818    823   #	the error block if needed
   819    824   #
   820    825   # The assumption is made that the 'arglen' temporary in $B has the
   821    826   # length of the 
   822    827   
   823    828   oo::define quadcode::transformer method va_CheckEnough {B callee minLength} {
   824    829   
          830  +    set currentb [$B curblock]
   825    831       set compLoc [my newVarInstance {temp @toofew}]
   826    832       set lenLoc [$B gettemp arglen]
   827    833   
   828    834       # compare args provided to args needed
   829    835       $B emit [list gt $compLoc [list literal $minLength] $lenLoc]
   830    836       my debug-varargs {
   831    837           $B log-last
   832    838       }
          839  +    my va_JumpTrueToWrongArgs $B $callee $compLoc
   833    840   
   834         -    # jump to a 'wrong # args' error if wrong
   835         -    set errb [my va_MakeWrongArgs $B $callee]
   836         -    $B emit [list jumpTrue [list bb $errb] $compLoc]
   837         -    my debug-varargs {
   838         -        $B log-last
   839         -    }
   840         -
   841         -    # jump to okb if right
   842         -    set okb [$B makeblock]
   843         -    $B emit [list jump [list bb $okb]]
   844         -    my debug-varargs {
   845         -        $B log-last
   846         -    }
   847         -
   848         -    # return to the 'no failure' branch
   849         -    $B buildin $okb
   850         -
          841  +    return
   851    842   }
   852    843   
   853    844   # quadcode::transformer method va_CheckTooMany --
   854    845   #
   855    846   #	Emits a codeburst to check whether an 'invokeExpanded' has
   856    847   #	too many args
   857    848   #
   858    849   # Parameters:
   859         -#	bVar - Variable holding the basic block number
   860         -#	bbVar - Variable holding the content of the current basic block
   861         -#	lenLoc - LLVM location holding the argument list length
   862         -#	compTemp - Name of a temporary to use as a comparison result
   863         -#	i - Index of the next unclaimed argument
   864         -#	errorB - Basic block number to jump to if there are too many args
          850  +#	B - Builder that is emitting the quadcode sequence
          851  +#	callee - Name of the called procedure
          852  +#	maxLength - Maximum length of the arg list
          853  +#
          854  +# Results:
          855  +#	None.
          856  +#
          857  +# Side effects:
          858  +#	Emits the check.
   865    859   #
   866    860   # Results:
   867    861   #	None
   868    862   #
   869    863   # Side effects:
   870    864   #	Emits code and closes the basic block
   871    865   
   872         -oo::define quadcode::transformer method va_CheckTooMany {bVar bbVar lenLoc
   873         -                                                             compTemp i
   874         -                                                             errorB} {
   875         -
   876         -    upvar 1 $bVar b $bbVar bb
   877         -
   878         -
   879         -    set compLoc [my newVarInstance $compTemp]
   880         -    my va_EmitAndTrack $b bb [list gt $compLoc $lenLoc [list literal $i]]
   881         -
   882         -    set intb [llength $bbcontent]
   883         -    lappend bbcontent {}
   884         -    lappend bbpred {}
   885         -    my va_EmitAndTrack $b bb [list jumpTrue [list bb $intb] $compLoc]
   886         -
   887         -    set newb [llength $bbcontent]
   888         -    lappend bbcontent {}
   889         -    lappend bbpred {}
   890         -    my va_EmitAndTrack $b bb [list jump [list bb $newb]]
   891         -    lset bbcontent $b $bb
   892         -
   893         -    set b $intb
   894         -    set bb {}
   895         -    my va_EmitAndTrack $b bb [list jump [list bb $errorB]]
   896         -    lset bbcontent $b $bb
   897         -
   898         -    set b $newb
   899         -    set bb {}
          866  +oo::define quadcode::transformer method va_CheckTooMany {B callee maxLength} {
          867  +
          868  +    set compLoc [my newVarInstance {temp @toomany}]
          869  +    set lenLoc [$B gettemp arglen]
          870  +    
          871  +    # Compare args provided against maximum
          872  +    $B emit [list gt $compLoc $lenLoc [list literal $maxLength]]
          873  +    my debug-varargs {
          874  +        $B log-last
          875  +    }
          876  +    my va_JumpTrueToWrongArgs $B $callee $compLoc
          877  +
          878  +    return
          879  +}
          880  +
          881  +# quadcode::transformer method va_JumpTrueToWrongArgs
          882  +#
          883  +#	Common logic for va_CheckEnough and va_CheckTooMany
          884  +#
          885  +# Parameters:
          886  +#	B - Builder that is emitting an invocation sequence.
          887  +#	callee - Name of the called command
          888  +#	compLoc - Quadcode location that contains a true value iff
          889  +#	          the wrong number of arguments is supplied.
          890  +#
          891  +# Results:
          892  +#	None.
          893  +#
          894  +# Side effects:
          895  +#	Emits a 'jumpTrue' instruction to code that reports the wrong
          896  +#	number of arguments, and a 'jump' to the following block, and
          897  +#	builds in the following block
          898  +
          899  +oo::define quadcode::transformer method va_JumpTrueToWrongArgs {B callee
          900  +                                                                compLoc} {
          901  +
          902  +    set intb [$B makeblock]
          903  +    set okb [$B makeblock]
          904  +    $B emit [list jumpTrue [list bb $intb] $compLoc]
          905  +    my debug-varargs {
          906  +        $B log-last
          907  +    }
          908  +    $B emit [list jump [list bb $okb]]
          909  +    my debug-varargs {
          910  +        $B log-last
          911  +    }
          912  +
          913  +    set errb [my va_MakeWrongArgs $B $callee]
          914  +    $B buildin $intb
          915  +    $B emit [list jump [list bb $errb]]
          916  +    my debug-varargs {
          917  +        $B log-last
          918  +    }
          919  +
          920  +    # return to the 'no failure' branch
          921  +    $B buildin $okb
   900    922   
   901    923   }
   902    924   
   903    925   # quadcode::transformer method va_MakeWrongArgs --
   904    926   #
   905    927   #	Generates code to throw the 'wrong # args' error when needed
   906    928   #
................................................................................
   955    977       my debug-varargs {
   956    978           $B log-last
   957    979       }
   958    980   
   959    981       set errorb [my va_MakeErrorBlock $B]
   960    982       $B emit [list jump [list bb $errorb]]
   961    983   
   962         -    # Add phis for the error result ant the callframe to the error block
          984  +    # Add phis for the error result and the callframe to the error block
   963    985       set errorInPhi [$B gettemp error]
   964    986       $B updatephi $errorb $errorInPhi $excloc
   965    987       
   966    988       $B buildin $currentb
   967    989       return $wrongb
   968    990       
   969    991   }
................................................................................
  1051   1073       set errortemp [$B maketemp error]
  1052   1074       $B emit [list phi $errortemp]
  1053   1075       my debug-varargs {
  1054   1076           $B log-last
  1055   1077       }
  1056   1078   
  1057   1079       $B buildin $currentb
  1058         -    return
         1080  +    return $errorb
  1059   1081   }
  1060   1082   
  1061   1083   # oo::transformer method va_ConvergeErrorPath --
  1062   1084   #
  1063   1085   #	Converges the code for the error and normal paths after an 'invoke'.
  1064   1086   #
  1065   1087   # Parameters:
................................................................................
  1119   1141           my debug-varargs {
  1120   1142               $B log-last
  1121   1143           }
  1122   1144   
  1123   1145           # Move to the finalization block, and emit phis for the callframe
  1124   1146           # and the result
  1125   1147   
  1126         -        puts "* cfin = $cfin"
  1127   1148           $B buildin $finalb
  1128   1149           $B emit [list phi $cf \
  1129   1150                        [list bb $errorb] $cfin [list bb $normb] $normcf]
  1130   1151           my debug-varargs {
  1131   1152               $B log-last
  1132   1153           }
  1133   1154           $B emit [list phi $result \