tclquadcode

Check-in [90e908dae3]
Login

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

Overview
Comment:Further development of varargs. Note that the invocation sequence is much, much simpler than it used to be, so 'invoke.tcl' is no more.
Timelines: family | ancestors | descendants | both | notworking | kbk-refactor-callframe
Files: files | file ages | folders
SHA3-256:90e908dae33cf49f58b70135cb9f15bd06fe796da28ad5673688776c54b61969
User & Date: kbk 2019-01-14 03:46:19
Context
2019-01-16
02:30
More argument preparation code in 'varargs' check-in: 76b943ad4a user: kbk tags: notworking, kbk-refactor-callframe
2019-01-14
03:46
Further development of varargs. Note that the invocation sequence is much, much simpler than it used to be, so 'invoke.tcl' is no more. check-in: 90e908dae3 user: kbk tags: notworking, kbk-refactor-callframe
2019-01-13
15:43
Clean out dead 'exists.tcl' source check-in: f283d28ebd user: kbk tags: notworking, kbk-refactor-callframe
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Changes to quadcode/builder.tcl.

   133    133   #
   134    134   # Results:
   135    135   #	Returns the instructions.
   136    136   
   137    137   oo::define quadcode::builder method bb {} {
   138    138       return $bb
   139    139   }
          140  +
          141  +# quadcode::builder method log-last --
          142  +#
          143  +#	Logs the last instruction emitted to the standard output
          144  +#
          145  +# Results:
          146  +#	None.
          147  +
          148  +oo::define quadcode::builder method log-last {} {
          149  +    set pc [expr {[llength $bb] -1}]
          150  +    puts "    $b:$pc: [lindex $bb end]"
          151  +}
   140    152   
   141    153   # Local Variables:
   142    154   # mode: tcl
   143    155   # fill-column: 78
   144    156   # auto-fill-function: nil
   145    157   # buffer-file-coding-system: utf-8-unix
   146    158   # indent-tabs-mode: nil
   147    159   # End:

Deleted quadcode/invoke.tcl.

     1         -# invoke.tcl --
     2         -#
     3         -#	Utilities for manipulating invocation sequences in quadcode.
     4         -#
     5         -# Copyright (c) 2018 by Kevin B. Kenny.
     6         -#
     7         -# See the file "license.terms" for information on usage and redistribution
     8         -# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
     9         -#
    10         -#------------------------------------------------------------------------------
    11         -
    12         -# quadcode::invocationSequence --
    13         -#
    14         -#	Class that represents the data for invoking a procedure.
    15         -#
    16         -# A quadcode::invocationSequence represents the codeburst that invokes
    17         -# a procedure, from the 'moveToCallFrame' that synchronizes the call frame
    18         -# prior to the invocation, down to the 'jumpMaybe' and 'jump' that handle
    19         -# a possible error return from the procedure. Procedure inlining and
    20         -# 'invokeExpand' repacement are two operations that need to rewrite the
    21         -# entire sequence, rather than just the 'invoke' instruction itself.
    22         -# This class abstracts the data from the codeburst.
    23         -
    24         -oo::class create quadcode::invocationSequence {
    25         -
    26         -    # xfmr - quadcode::transformer object holding the bytecode
    27         -    # b - Basic block number of the 'invoke' instruction
    28         -    # pc - Program counter within the basic block
    29         -    # pc0 - Program counter of the start of the invocation sequence. $pc0 <= $pc
    30         -    # q - The 'invoke' instruction itself
    31         -    # cmd - The command being invoked
    32         -    # argl - The arglist from the 'invoke' instruction
    33         -    # cfin - The callframe that flows into the invocation sequence, or Nothing
    34         -    # cfin_invoke - The callframe that is input to the 'invoke' or
    35         -    #		   'invokeExpanded' instruction, or Nothing.
    36         -    # res_invoke - The result of 'invoke' or 'invokeExpanded'
    37         -    # cfout - The callframe that flows out of the invocation sequence, or
    38         -    #         {}
    39         -    # invars - Dictionary whose keys are literal variable names and whose
    40         -    #          values are the sources of variables that need to be copied
    41         -    #          to the callframe prior to invocation
    42         -    # retval - Return value from the invocation
    43         -    # outvars - Dictionary whose keys are literal variable names and
    44         -    #           whose values are the quadcode values that need to be
    45         -    #           assigned from the callframe after the invocation
    46         -    # errexit - Basic block number to jump to on error exit
    47         -    # normexit - Basic block number to jump to on normal exit
    48         -
    49         -    variable xfmr b pc q cmd res_invoke cfin_invoke argl \
    50         -	pc0 cfin invars retval cfout outvars errexit normexit
    51         -
    52         -    constructor {} {
    53         -	# Defer construction to an initialization method to avoid throwing
    54         -	# constructor errors.
    55         -    }
    56         -
    57         -}
    58         -
    59         -# quadcode::invocationSequence method analyze --
    60         -#
    61         -#	Decompose the codeburst that invokes a command from quadcode
    62         -#
    63         -# Parameters:
    64         -#	xfmr_ - quadcode::transformer object holding the quadcode
    65         -#	b_ - Basic block number in which the invoke instruction appears
    66         -#	pc_ - PC within the basic block at which the invoke instruction appears
    67         -#
    68         -# Results:
    69         -#	None
    70         -#
    71         -# Side effects:
    72         -#	Initializes variables according to the instruction.
    73         -
    74         -oo::define quadcode::invocationSequence method analyze {xfmr_ b_ pc_} {
    75         -
    76         -    set xfmr $xfmr_
    77         -    set b $b_
    78         -    set pc $pc_
    79         -
    80         -    set bb [$xfmr getBasicBlock $b]
    81         -    set q [lindex $bb $pc]
    82         -
    83         -    # Take apart the invocation
    84         -
    85         -    set argl [lassign $q op res_invoke cfin_invoke cmd]
    86         -    if {$op ni {"invoke" "invokeExpanded"}} {
    87         -	error "cannot analyze: not an invocation."
    88         -    }
    89         -
    90         -    # Find the input callframe and relevant input variables
    91         -    
    92         -    set pc0 $pc
    93         -    set cfin Nothing
    94         -    set invars {}
    95         -    if {$cfin_invoke ne "Nothing"} {
    96         -	set qb [lindex $bb [expr {$pc-1}]]
    97         -	if {[lindex $qb 0] eq "moveToCallFrame"} {
    98         -	    if {[lindex $qb 1] ne $cfin_invoke} {
    99         -		error "cannot analyze: moveToCallFrame mislinked"
   100         -	    }
   101         -	    set varl [lassign $qb - - cfin]
   102         -	    foreach {namelit source} $varl {
   103         -		if {[lindex $namelit 0] ne "literal"} {
   104         -		    error "cannot analyze: name of input var not literal"
   105         -		}
   106         -		dict set invars [lindex $namelit 1] $source
   107         -	    }
   108         -	    set pc0 [expr {$pc-1}]
   109         -	}
   110         -    }
   111         -
   112         -    # Find the result value
   113         -
   114         -    set retval $res_invoke
   115         -    if {[lindex $bb [incr pc] 0] eq "retrieveResult"} {
   116         -	set q2 [lindex $bb $pc]
   117         -	lassign $q2 - retval cf2
   118         -	if {$cf2 ne $res_invoke} {
   119         -	    error "cannot analyze: retrieveResult mislinked"
   120         -	}
   121         -    } else {
   122         -	incr pc -1
   123         -    }
   124         -
   125         -    # Find the output callframe
   126         -
   127         -    set cfout $res_invoke
   128         -    if {[lindex $bb [incr pc] 0] eq "extractCallFrame"} {
   129         -	set q2 [lindex $bb $pc]
   130         -	lassign $q2 - cfout cf2
   131         -	if {$cf2 ne $res_invoke} {
   132         -	    error "cannot analyze: extractCallFrame mislinked"
   133         -	}
   134         -    } else {
   135         -	incr pc -1
   136         -    }
   137         -
   138         -    # Find the output variables
   139         -
   140         -    set outvars {}
   141         -    while {[lindex $bb [incr pc] 0] eq "moveFromCallFrame"} {
   142         -	set q2 [lindex $bb $pc]
   143         -	lassign $q2 - varout cf2 litname
   144         -	if {$cf2 ne $cfout} {
   145         -	    error "cannot analyze: moveFromCallFrame mislinked"
   146         -	}
   147         -	lassign $litname kind val
   148         -	if {$kind ne "literal"} {
   149         -	    error "cannot analyze: moveFromCallFrame with non-literal variable"
   150         -	}
   151         -	dict set outvars $val $varout
   152         -    }
   153         -    incr pc -1
   154         -
   155         -    # Find the error exit
   156         -
   157         -    if {[lindex $bb [incr pc] 0] eq "jumpMaybe"} {
   158         -	set q2 [lindex $bb $pc]
   159         -	lassign $q2 - target cond
   160         -	if {$cond ne $retval} {
   161         -	    error "cannot analyze: jumpMaybe mislinked"
   162         -	}
   163         -	set errexit [lindex $target 1]
   164         -    } else {
   165         -	error "cannot analyze: invocation does not end basic block."
   166         -    }
   167         -
   168         -    # Find the normal exit
   169         -
   170         -    if {[lindex $bb [incr pc] 0] eq "jump"} {
   171         -	set normexit [lindex $bb $pc 1 1]
   172         -    } else {
   173         -	error "cannot analyze: basic block does not end with a jump"
   174         -    }
   175         -	
   176         -    return
   177         -}
   178         -
   179         -# quadcode::invocationSequence method arginfo --
   180         -#
   181         -#	Queries [info args] for the invoked command.
   182         -#
   183         -# Results:
   184         -#	Returns an ordered pair consisting of {1 result} if the args
   185         -#	are known, or {0 {}} otherwise. The value of 'result' in the
   186         -#	ordered pair is the result of [info args] for the given command.
   187         -
   188         -oo::define quadcode::invocationSequence method arginfo {} {
   189         -    lassign [my cmd] status cmdName
   190         -    if {!$status
   191         -	|| [catch {info args $cmdName} arginfo]} {
   192         -	return {0 {}}
   193         -    }
   194         -    return [list 1 $arginfo]
   195         -}
   196         -
   197         -# quadcode::invocationSequence method b --
   198         -#
   199         -#	Returns the basic block number of an invocation sequence
   200         -
   201         -oo::define quadcode::invocationSequence method b {} {
   202         -    return $b
   203         -}
   204         -
   205         -# quadcode::invocationSequence method cfin --
   206         -#
   207         -#	Returns the starting callframe for an invocation sequence
   208         -
   209         -oo::define quadcode::invocationSequence method cfin {} {
   210         -    return $cfin
   211         -}
   212         -
   213         -# quadcode::invocationSequence method cfin_invoke --
   214         -#
   215         -#	Returns the callframe from the 'invoke' instruction in an
   216         -#	invocation sequence
   217         -
   218         -oo::define quadcode::invocationSequence method cfin_invoke {} {
   219         -    return $cfin_invoke
   220         -}
   221         -
   222         -# quadcode::invocationSequence method cfout --
   223         -#
   224         -#	Returns the ending callframe for an invocation sequence
   225         -
   226         -oo::define quadcode::invocationSequence method cfout {} {
   227         -    return $cfout
   228         -}
   229         -
   230         -# quadcode::invocationSequence method cmd --
   231         -#
   232         -#	Queries the name of the invoked command.
   233         -#
   234         -# Results:
   235         -#
   236         -#	Returns an ordered pair that is {1 commandName} if the sequence
   237         -#	invokes a known command, and {0 {}} if the sequence does not
   238         -#	invoke a known command.
   239         -
   240         -oo::define quadcode::invocationSequence method cmd {} {
   241         -    if {[lindex $cmd 0] eq "literal"} {
   242         -	return [list 1 [lindex $cmd 1]]
   243         -    } else {
   244         -	return {0 {}}
   245         -    }
   246         -}
   247         -
   248         -# quadcode::invocation sequence method argl --
   249         -#
   250         -#	Returns the argument list of the invoked command.
   251         -
   252         -oo::define quadcode::invocationSequence method argl {} {
   253         -    return $argl
   254         -}
   255         -
   256         -# quadcode::invocationSequence method errexit --
   257         -#
   258         -#	Returns the error exit block number for an invocation sequence
   259         -
   260         -oo::define quadcode::invocationSequence method errexit {} {
   261         -    return $errexit
   262         -}
   263         -
   264         -# quadcode::invocationSequence method invars --
   265         -#
   266         -#	Returns the input variables of an invocation sequence
   267         -
   268         -oo::define quadcode::invocationSequence method invars {} {
   269         -    return $invars
   270         -}
   271         -
   272         -# quadcode::invocationSequence method normexit --
   273         -#
   274         -#	Returns the normal exit block number for an invocation sequence
   275         -
   276         -oo::define quadcode::invocationSequence method normexit {} {
   277         -    return $normexit
   278         -}
   279         -
   280         -# quadcode::invocationSequence method outvars --
   281         -#
   282         -#	Returns the output variables of an invocation sequence
   283         -
   284         -oo::define quadcode::invocationSequence method outvars {} {
   285         -    return $outvars
   286         -}
   287         -
   288         -# quadcode::invocationSequence method pc0 --
   289         -#
   290         -#	Returns the starting program counter for an invocation sequence
   291         -
   292         -oo::define quadcode::invocationSequence method pc0 {} {
   293         -    return $pc0
   294         -}
   295         -
   296         -# quadcode::invocationSequence method res_invoke --
   297         -#
   298         -#	Returns the result of the 'invoke' or 'invokeExpanded' in
   299         -#	an invocation sequence
   300         -
   301         -oo::define quadcode::invocationSequence method res_invoke {} {
   302         -    return $res_invoke
   303         -}
   304         -
   305         -# quadcode::invocationSequence method retval --
   306         -#
   307         -#	Returns the return value for an invocation sequence
   308         -
   309         -oo::define quadcode::invocationSequence method retval {} {
   310         -    return $retval
   311         -}
   312         -
   313         -

Changes to quadcode/transformer.tcl.

   779    779   source [file join $quadcode::libdir copyprop.tcl]
   780    780   source [file join $quadcode::libdir dbginfo.tcl]
   781    781   source [file join $quadcode::libdir deadcode.tcl]
   782    782   source [file join $quadcode::libdir duchain.tcl]
   783    783   source [file join $quadcode::libdir flatten.tcl]
   784    784   source [file join $quadcode::libdir fqcmd.tcl]
   785    785   source [file join $quadcode::libdir inline.tcl]
   786         -source [file join $quadcode::libdir invoke.tcl]
   787    786   source [file join $quadcode::libdir jumpthread.tcl]
   788    787   source [file join $quadcode::libdir liveranges.tcl]
   789    788   source [file join $quadcode::libdir loopinv.tcl]
   790    789   source [file join $quadcode::libdir narrow.tcl]
   791    790   source [file join $quadcode::libdir pre.tcl]
   792    791   source [file join $quadcode::libdir ssa.tcl]
   793    792   source [file join $quadcode::libdir translate.tcl]
   794    793   source [file join $quadcode::libdir typecheck.tcl]
   795    794   source [file join $quadcode::libdir upvar.tcl]
   796    795   source [file join $quadcode::libdir varargs.tcl]
   797    796   source [file join $quadcode::libdir widen.tcl]

Changes to quadcode/varargs.tcl.

    27     27   #
    28     28   # Preconditions:
    29     29   #       This pass presumes that the quadcode is partitioned into basic blocks,
    30     30   #       and that SSA conversion has been run (so a constant procedure name
    31     31   #       will have propagated into 'invoke' instructions. It also presumes
    32     32   #       that procedure names have been resolved into the fully qualified names.
    33     33   #
    34         -#       This pass introduces temporaries, but only locally to basic blocks,
    35         -#       so it does not require elaborate rewriting of SSA form. It must run
    36         -#       prior to parameter type checking (including the 'rewriteParamChecks'
    37         -#       peephole).
           34  +#       This pass must run prior to parameter type checking (including the
           35  +#       'rewriteParamChecks' peephole).
    38     36   #
    39     37   #       There is a hidden assumption in this method that default args are
    40     38   #       always of acceptable type - and so type checks need not be
    41     39   #       emitted for default parameters. (There is major rethinking needed
    42     40   #       if this ever might not be the case.)
    43     41   
    44     42   oo::define quadcode::transformer method varargs {} {
................................................................................
    99     97   #
   100     98   # Side effects:
   101     99   #	Rewrites the instruction and 'expand' instructions that it
   102    100   #       uses. Updates ud- and du-chains.
   103    101   
   104    102   oo::define quadcode::transformer method va_RewriteInvoke {b pc q} {
   105    103   
   106         -    # Analyze the invocation sequence.  This codeburst will run from the
   107         -    # 'moveToCallFrame' preceding the invocation out to the end of the
   108         -    # basic block.  We will be rewriting it.
   109         -    set call [::quadcode::invocationSequence new]
   110         -    $call analyze [self] $b $pc
   111         -
   112    104       # We can process only those sequences where the procedure name is known
   113    105       # a priori, the expected arguments are known, and the target procedure
   114    106       # is compiled.  BUG - We know the arguments to a great many Core commands
   115    107       # and need to work with them as well.
   116         -    lassign [$call arginfo] status arginfo
          108  +    lassign [my va_GetArgInfo $q] status arginfo
   117    109       if {!$status} return
   118    110       my debug-varargs {
   119    111           puts "[my full-name]: $b:$pc: $q"
   120    112           puts "    arginfo = $arginfo"
   121    113       }
   122    114   
   123    115       # We are going to be doing major surgery on the basic block.
   124    116       # Remove the 'invokeExpanded' and all following instructions
   125    117       # from the block. Unlink the block from its successors, and
   126    118       # remove ud- and du-chaining for the removed instructions.
   127         -    set bb [my va_UnlinkTail $b [$call pc0]]
          119  +    set bb [my va_UnlinkTail $b $pc]
   128    120       set B [quadcode::builder new [self] $b $bb]
   129    121   
   130    122       # Prepare parameters for the 'invoke' (or 'invokeExpanded') call, and
   131    123       # add the call to the instruction sequence under construction.
   132         -    my va_PrepareArgs $B $call
   133         -
          124  +    my va_PrepareArgs $B $b $pc $q $arginfo
          125  + 
   134    126       puts "NOT FINISHED."
   135    127       exit
   136    128       $B destroy
   137    129       $call destroy
   138    130       return
   139    131   }
          132  +
          133  +# quadcode::transformer method va_GetArgInfo --
          134  +#
          135  +#	Determines the target of an invocation and performs [info args] on
          136  +#	that target to get its argument list.
          137  +#
          138  +# Parameters:
          139  +#	q - Quadcode 'invoke' or 'invokeExpanded' instruction
          140  +#
          141  +# Results:
          142  +#	Returns [list 1 $arglist] if the callee is known and [info args]
          143  +#	succeeds. Returns [list 0 {}] for an unknown callee or one whose
          144  +#	expected args are unknown.
          145  +
          146  +oo::define quadcode::transformer method va_GetArgInfo {q} {
          147  +    set cmd [lindex $q 3]
          148  +    if {[lindex $cmd 0] ne "literal"
          149  +        || [catch {info args [lindex $cmd 1]} arginfo]} {
          150  +        return {0 {}}
          151  +    } else {
          152  +        return [list 1 $arginfo]
          153  +    }
          154  +}
   140    155   
   141    156   # quadcode::transformer method va_PrepareArgs --
   142    157   #
   143    158   #	Emits code to prepare the arguments for an 'invoke' or
   144    159   #	'invokeExpanded' command, up to the point where the actual
   145    160   #	'invoke' is issued.
   146    161   #
   147    162   # Parameters:
   148    163   #	B - quadcode::builder where the new invocation sequence is being built.
   149         -#	call - Object describing the invocation sequence.
          164  +#	b - Basic block where the original 'invoke' instruction resided
          165  +#	pc - Program counter within the basic block
          166  +#	q - 'invoke' or 'invokeExpanded' instruction.
          167  +#	arginfo - Arguments expected by the invoked command
   150    168   #
   151    169   # Results:
   152    170   #	None.
          171  +#
          172  +# The command name being invoked, and the expected arguments, ar always known
          173  +# at this point.
   153    174   
   154         -oo::define quadcode::transformer method va_PrepareArgs {B call} {
          175  +oo::define quadcode::transformer method va_PrepareArgs {B b pc q arginfo} {
   155    176       
          177  +    set argl [lassign $q opcode result cfin cmd]
          178  +
   156    179       # Create the first part of the 'invoke' instruction.
   157    180       
   158         -    lassign [$call cmd] status callee
   159         -    if {!$status} {
   160         -        error "can't find callee -- can't happen"
   161         -    }
   162         -    set newq [list invoke \
   163         -                  [$call res_invoke] [$call cfin_invoke] \
   164         -                  [list literal $callee]]
          181  +    set iresult [my newVarInstance $result]
          182  +    set newq [list invoke $result $cfin $cmd]
   165    183   
   166    184       # Find out how many plain parameters (that is, not 'args') the
   167    185       # called command has.
   168         -    lassign [$call arginfo] status arginfo
   169         -    if {!$status} {
   170         -        error "can't find arginfo - can't happen"
   171         -    }
   172    186       set nPlainParams [llength $arginfo]
   173    187       set haveargs 0
   174    188       if {[lindex $arginfo end] eq "args"} {
   175    189           set haveargs 1
   176    190           incr nPlainParams -1
   177    191       }
   178    192   
   179    193       # Any leading plain arguments that do not have {*} can simply be retained
   180    194       # in the parameter list of [invoke].
   181    195       # $pos will be the position in the parameter list of the first
   182    196       # parameter that needs special handling. 
   183         -    set argl [$call argl]
          197  +    set argl [lrange $q 4 end]
   184    198       set pos 0
   185    199       while {$pos < $nPlainParams} {
   186    200           if {[my va_NonExpandedArgument newq $arginfo $pos $argl]} break
   187    201           incr pos
   188    202       }
   189    203   
   190    204       my debug-varargs {
   191         -        puts "varargs: [$call b]:[$call pc0]: matched $pos out of $nPlainParams\
          205  +        puts "varargs: $b:$pc: matched $pos out of $nPlainParams\
   192    206                 leading non-expanded arg(s)."
   193    207       }
   194    208   
   195    209       # Generate code to make the rest of the args into a list
   196         -    my va_MakeArgList $B $argl $pos
          210  +    lassign [my va_MakeArgList $B $argl $pos $cfin] mightThrow listLoc
   197    211   
   198         -    puts "NOT DONE - varargs matched non-expanded args."
          212  +    # We are going to need the length of the list, so
          213  +    # extract that now. (If it turns out somehow that we
          214  +    # don't use it, 'deadvars' will get rid of this, anyway.)
          215  +    set lenLoc1 [my newVarInstance {temp @arglen}]
          216  +    set lenLoc [my newVarInstance {temp @arglen}]
          217  +    $B emit [list listLength $lenLoc1 $listLoc]
          218  +    
          219  +    my debug-varargs {
          220  +        $B log-last
          221  +    }
          222  +    $B emit [list extractMaybe $lenLoc $lenLoc1]
          223  +    my debug-varargs {
          224  +        $B log-last
          225  +    }
          226  +
          227  +
          228  +    # Count the mandatory args
          229  +    set firstMandatory $pos
          230  +    while {$pos < $nPlainParams} {
          231  +        my debug-varargs {
          232  +            puts "varargs: does arg $pos: \"[lindex $arginfo $pos]\"\
          233  +                  have a default?"
          234  +        }
          235  +        if {[info default $callee [lindex $arginfo $pos] defaultVal]} {
          236  +            my debug-varargs {
          237  +                puts "         yes: \"defaultVal\""
          238  +            }
          239  +            break
          240  +        }
          241  +        incr pos
          242  +    }
          243  +    my debug-varargs {
          244  +        puts "varargs: first optional arg is at position $pos"
          245  +    }
          246  +    set firstOptional $pos
          247  +
          248  +
          249  +    puts "NOT DONE - varargs built the arglist in $listLoc"
   199    250       exit 1
   200    251   
   201    252   }
   202    253   
   203    254   
   204    255   if 0 {
   205    256   
   206         -    set tempIndex -1
   207         -    set listLoc [my va_MakeArgList bb tempIndex pos $b $q]
   208         -
   209         -    # We are going to need the length of the list, so
   210         -    # extract that now. (If it turns out somehow that we
   211         -    # don't use it, 'deadvars' will get rid of this, anyway.)
   212         -    set lenLoc1 [my newVarInstance [list temp [incr tempIndex]]]
   213         -    set lenLoc [my newVarInstance [list temp $tempIndex]]
   214         -    my va_EmitAndTrack $b bb [list listLength $lenLoc1 $listLoc]
   215         -    my va_EmitAndTrack $b bb [list extractMaybe $lenLoc $lenLoc1]
   216         -
   217         -    # Count the mandatory args
   218         -
   219         -    set firstMandatory $pos
   220         -    while {$pos < $nPlainParams} {
   221         -        if {[info default $callee [lindex $arginfo $pos] defaultVal]} {
   222         -            break
   223         -        }
   224         -        incr pos
   225         -    }
   226         -    set firstOptional $pos
   227         -
   228    257       set compTemp [list temp [incr $tempIndex]]
   229    258   
   230    259       set nMandatory 0
   231    260       if {$firstOptional > $firstMandatory} {
   232    261   
   233    262           # Make code to check length of arg list, starting a
   234    263           # new basic block
................................................................................
   403    432   #
   404    433   # Side effects:
   405    434   #	Variable defs and uses in the invocation sequence are removed
   406    435   #	from ud- and du-chains. The basic block is unlinked from its
   407    436   #	successors. 
   408    437   
   409    438   oo::define quadcode::transformer method va_UnlinkTail {b pc} {
          439  +
   410    440       set bb [lindex $bbcontent $b]
          441  +    my debug-varargs {
          442  +        puts "varargs: Split basic block $b:"
          443  +        puts "   $b:$pc: [lindex $bb $pc]"
          444  +    }
          445  +
   411    446       set tail [lrange $bb $pc end]
   412    447       set bb [lreplace $bb[set bb {}] $pc end]
   413    448       foreach q $tail {
   414    449           if {[lindex $q 1 0] in {"temp" "var"}} {
   415    450               dict unset udchain [lindex $q 1]
   416    451           }
   417    452           foreach arg [lrange $q 2 end] {
................................................................................
   438    473   #	pos - Position of the argument (0 = first) in the argument list
   439    474   #	argl - Argument list of the 'invoke' or 'invokeExpanded' instruction
   440    475   #
   441    476   # Results:
   442    477   #	Returns 0 if the parameter was transferred, 1 if we are at the
   443    478   #	end of the possible static transfers.
   444    479   
   445         -oo::define quadcode::transformer method va_NonExpandedArgument {newqVar
   446         -                                                                    arginfo
   447         -                                                                    pos argl} {
          480  +oo::define quadcode::transformer method va_NonExpandedArgument {newqVar arginfo
          481  +                                                                pos argl} {
   448    482   
   449    483       upvar 1 $newqVar newq
   450    484       
   451    485       set param [lindex $arginfo $pos]
   452    486       set arg [lindex $argl $pos]
          487  +    my debug-varargs {
          488  +        puts "varargs: transfer actual arg [list $arg] into formal arg\
          489  +              \"$param\""
          490  +    }
   453    491       switch -exact -- [lindex $arg 0] {
   454    492           "literal" {
   455    493           }
   456    494           "temp" - "var" {
   457    495               lassign [my findDef $arg] defb defpc defstmt
   458    496               if {[lindex $defstmt 0] eq "expand"} {
   459    497                   return 1
................................................................................
   472    510   #	Takes the non-fixed-position arguments of 'invokeExpanded'
   473    511   #	and emits code to make them into a list.
   474    512   #
   475    513   # Parameters:
   476    514   #	B - quadcode::builder that is rewriting the invocation sequence.
   477    515   #	argl - Argument list being analyzed
   478    516   #	pos - Position in the argument list
          517  +#	cfin - Callframe input to the 'invoke' instruction.
   479    518   #
   480    519   # Results:
   481    520   #
   482         -#	Returns the name of a variable, temporary or literal that holds the
          521  +#	Returns a two-element list. The first element is 1 if it is possible
          522  +#	that the argument list is a non-list, and 0 otherwise.  The second
          523  +#	element is the name of a variable, temporary or literal that holds the
   483    524   #	expanded list.
   484    525   
   485         -oo::define quadcode::transformer method va_MakeArgList {B argl pos} {
          526  +oo::define quadcode::transformer method va_MakeArgList {B argl pos cfin} {
          527  +
          528  +    my debug-varargs {
          529  +        puts "varargs: make arg list for [list $argl] from position $pos"
          530  +    }
   486    531   
   487    532       # Handle the first arg. 'listloc' will be the variable holding the
   488    533       # expanded arglist. 'mightThrow' will be 1 if 'listloc'
   489    534       # might be a non-list and 0 otherwise.
   490    535       if {$pos >= [llength $argl]} {
          536  +        my debug-varargs {
          537  +            puts "varargs: there are no args to list"
          538  +        }
   491    539           set listLoc "literal {}"
          540  +        set mightThrow 0
   492    541       } else {
   493    542           set arg [lindex $argl $pos]
          543  +        my debug-varargs {
          544  +            puts "varargs: transfer first arg [list $arg]"
          545  +        }
   494    546           switch -exact -- [lindex $arg 0] {
   495    547               "literal" {
   496    548                   set listloc [$B maketemp arglist]
   497    549                   $B emit [list list $listloc $arg]
          550  +                my debug-varargs {
          551  +                    $B log-last
          552  +                }
          553  +                $B emit [list extractMaybe $listLoc $intLoc]
          554  +                my debug-varargs {
          555  +                    $B log-last
          556  +                }
   498    557                   set mightThrow 0
   499    558               }
   500    559               "temp" - "var" {
   501    560                   lassign [my findDef $arg] defb defpc defstmt
   502    561                   if {[lindex $defstmt 0] eq "expand"} {
          562  +                    my debug-varargs {
          563  +                        puts "  (which is expanded!)"
          564  +                    }
   503    565                       set listLoc [lindex $defstmt 2]
   504    566                       set mightThrow 1
   505    567                   } else {
          568  +                    set intLoc [$B maketemp arglist]
   506    569                       set listLoc [$B maketemp arglist]
   507         -                    $B emit [list list $listLoc $arg]
          570  +                    my debug-varargs {
          571  +                        puts "  (which is not expanded)"
          572  +                    }
          573  +                    $B emit [list list $intLoc $arg]
          574  +                    my debug-varargs {
          575  +                        $B log-last
          576  +                    }
          577  +                    $B emit [list extractMaybe $listLoc $intLoc]
          578  +                    my debug-varargs {
          579  +                        $B log-last
          580  +                    }
   508    581                       set mightThrow 0
   509    582                   }
   510    583               }
   511    584           }
   512    585       }
   513         -    puts "did first arg, arglist is $listLoc, and b so far is\n[join [$B bb] \n]"
   514         -    puts "lhsMightThrow = $lhsMightThrow"
   515         -
   516         -    if {$lhsMightThrow} {
   517         -
   518         -    exit 1
          586  +    my debug-varargs {
          587  +        puts "varargs: transferred first arg into [list $listLoc]."
          588  +        puts "         mightThrow = $mightThrow"
          589  +    }
   519    590   
   520    591       # listLoc now holds the location of the list under
   521    592       # construction. Concatenate the remaining params onto it.
   522    593   
   523         -        foreach arg [lrange $argl [expr {1 + $pos}] end] {
          594  +    foreach arg [lrange $argl [expr {1 + $pos}] end] {
   524    595   
   525         -            # Do we need to expand this arg?
   526         -            switch -exact -- [lindex $arg 0] {
   527         -                "literal" {
          596  +        my debug-varargs {
          597  +            puts "varargs: transfer arg $arg"
          598  +        }
          599  +
          600  +        # Do we need to expand this arg?
          601  +        switch -exact -- [lindex $arg 0] {
          602  +            "literal" {
          603  +                set op "listAppend"
          604  +            }
          605  +            "temp" - "var" {
          606  +                lassign [my findDef $arg] defb defpc defstmt
          607  +                if {[lindex $defstmt 0] eq "expand"} {
          608  +                    set op "listConcat"
          609  +                    set mightThrow 1
          610  +                } else {
   528    611                       set op "listAppend"
   529    612                   }
   530         -                "temp" - "var" {
   531         -                    lassign [my findDef $arg] defb defpc defstmt
   532         -                    if {[lindex $defstmt 0] eq "expand"} {
   533         -                        set op "listConcat"
   534         -                    } else {
   535         -                        set op "listAppend"
   536         -                    }
   537         -                }
   538    613               }
   539         -
   540         -            # Make variable to hold Maybe result from the concatenation,
   541         -            # and emit the concatenation.
   542         -            set nloc [$B maketemp arglist]
   543         -            $B emit [list $op $nloc $listLoc $arg]
   544         -
   545         -            if {$lhsMightThrow || $op == "listConcat"} {
   546         -                my makeErrorBlock $B
   547         -                set intb [$B makeblock]
   548         -                set nextb [$B makeblock]
   549         -                $B emit [list jumpMaybe [list bb $intb] $nloc]
   550         -                set lhsMightThrow 0
   551         -                $B emit [list jump [list bb $nextb]]
   552         -                $B buildin $intb
   553         -                set error [$B maketemp nloc]
   554         -                $B emit [list extractFail $error $nloc]
   555         -                $B emit [list jump [list bb $errorb]]
   556         -                $B phi $errorb error $error
   557         -                $B emit [list jump [list bb $errorb]]
   558         -                $B buildin $nextb
   559         -
   560         -                # KBK is here - need to get my context back!!!
   561         -            }
   562         -
   563         -            # extract the result from the Maybe
   564         -            set listLoc [$B maketemp arglist]
   565         -            $B emit [list extractMaybe $listLoc $nloc]
          614  +        }
          615  +        
          616  +        # Make variable to hold Maybe result from the concatenation,
          617  +        # and emit the concatenation.
          618  +        set nloc [$B maketemp arglist]
          619  +        $B emit [list $op $nloc $listLoc $arg]
          620  +        my debug-varargs {
          621  +            $B log-last
          622  +        }
          623  +
          624  +        # If the concatenation might have failed, emit the error check
          625  +        if {$mightThrow} {
          626  +            my va_MakeErrorCheck $B $cfin $nloc
          627  +            set mightThrow 0
          628  +        }
          629  +
          630  +        # On normal exit from list construction, extract the result from the
          631  +        # 'maybe' returned by listAppend or listConcat
          632  +        set listLoc [$B maketemp arglist]
          633  +        $B emit [list extractMaybe $listLoc $nloc]
          634  +        my debug-varargs {
          635  +            $B log-last
   566    636           }
          637  +    }
   567    638   
   568         -        return $listLoc
          639  +    set retval [list $mightThrow $listLoc]
          640  +    return $retval
          641  +
   569    642   }
          643  +
          644  +# quadcode::transformer method va_MakeErrorCheck --
          645  +#
          646  +#	Emits code to jump to an error block if a given value is FAIL.
          647  +#
          648  +# Parameters:
          649  +#	B - Builder that is emitting code
          650  +#	cf - Callframe that is active at the time of the check
          651  +#	val - Value that might be FAIL
          652  +#
          653  +# Results:
          654  +#	None.
          655  +#
          656  +# Side effects:
          657  +#	Emits the necessary jumpMaybe, and adds callframe and FAIL value
          658  +#	to the phi operations at the head of the error block.
          659  +
          660  +oo::define quadcode::transformer method va_makeErrorCheck {B cf val} {
          661  +
          662  +    # Emit any required error checking when building the variable
          663  +    # argument list.
          664  +    my va_MakeErrorBlock $B
          665  +    set intb [$B makeblock]
          666  +    set nextb [$B makeblock]
          667  +
          668  +    # Close out the current block with jumpMaybe to an intermediate
          669  +    # block and jump to the normal return
          670  +    $B emit [list jumpMaybe [list bb $intb] $val]
          671  +    my debug-varargs {
          672  +        $B log-last
          673  +    }
          674  +    $B emit [list jump [list bb $nextb]]
          675  +    my debug-varargs {
          676  +        $B log-last
          677  +    }
          678  +
          679  +    # Make an intermediate block that jumps to the error block
          680  +    $B buildin $intb
          681  +    
          682  +    my debug-varargs {
          683  +        $B log-last
          684  +    }
          685  +    $B emit [list jump [list bb $errorb]]
          686  +    my debug-varargs {
          687  +        $B log-last
          688  +    }
          689  +
          690  +    # Add phis for the error result ant the callframe to the error block
          691  +    set errorInPhi [$B get-or-make-temp error]
          692  +    set callframeInPhi [$B get-or-make-temp error-callframe]
          693  +    $B phi $errorb $errorInPhi $val
          694  +    $B phi $errorb $callframeInPhi $cf
          695  +
          696  +    # Now continue building in the normal exit
          697  +    $B buildin $nextb
   570    698   }
   571         -
   572    699   
   573    700   # quadcode::transformer method va_CheckEnough --
   574    701   #
   575    702   #	Emits code to check for too few args passed to invokeExpanded
   576    703   #
   577    704   # Parameters:
   578    705   #	b - Basic block number under construction