Check-in [90e908dae3]
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: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

Changes to quadcode/builder.tcl.

133
134
135
136
137
138
139












140
141
142
143
144
145
146
147
#
# Results:
#	Returns the instructions.

oo::define quadcode::builder method bb {} {
    return $bb
}












 
# Local Variables:
# mode: tcl
# fill-column: 78
# auto-fill-function: nil
# buffer-file-coding-system: utf-8-unix
# indent-tabs-mode: nil
# End:







>
>
>
>
>
>
>
>
>
>
>
>








133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
#
# 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 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:

Deleted quadcode/invoke.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
# invoke.tcl --
#
#	Utilities for manipulating invocation sequences in quadcode.
#
# Copyright (c) 2018 by Kevin B. Kenny.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
#------------------------------------------------------------------------------

# quadcode::invocationSequence --
#
#	Class that represents the data for invoking a procedure.
#
# A quadcode::invocationSequence represents the codeburst that invokes
# a procedure, from the 'moveToCallFrame' that synchronizes the call frame
# prior to the invocation, down to the 'jumpMaybe' and 'jump' that handle
# a possible error return from the procedure. Procedure inlining and
# 'invokeExpand' repacement are two operations that need to rewrite the
# entire sequence, rather than just the 'invoke' instruction itself.
# This class abstracts the data from the codeburst.

oo::class create quadcode::invocationSequence {

    # xfmr - quadcode::transformer object holding the bytecode
    # b - Basic block number of the 'invoke' instruction
    # pc - Program counter within the basic block
    # pc0 - Program counter of the start of the invocation sequence. $pc0 <= $pc
    # q - The 'invoke' instruction itself
    # cmd - The command being invoked
    # argl - The arglist from the 'invoke' instruction
    # cfin - The callframe that flows into the invocation sequence, or Nothing
    # cfin_invoke - The callframe that is input to the 'invoke' or
    #		   'invokeExpanded' instruction, or Nothing.
    # res_invoke - The result of 'invoke' or 'invokeExpanded'
    # cfout - The callframe that flows out of the invocation sequence, or
    #         {}
    # invars - Dictionary whose keys are literal variable names and whose
    #          values are the sources of variables that need to be copied
    #          to the callframe prior to invocation
    # retval - Return value from the invocation
    # outvars - Dictionary whose keys are literal variable names and
    #           whose values are the quadcode values that need to be
    #           assigned from the callframe after the invocation
    # errexit - Basic block number to jump to on error exit
    # normexit - Basic block number to jump to on normal exit

    variable xfmr b pc q cmd res_invoke cfin_invoke argl \
	pc0 cfin invars retval cfout outvars errexit normexit

    constructor {} {
	# Defer construction to an initialization method to avoid throwing
	# constructor errors.
    }

}
 
# quadcode::invocationSequence method analyze --
#
#	Decompose the codeburst that invokes a command from quadcode
#
# Parameters:
#	xfmr_ - quadcode::transformer object holding the quadcode
#	b_ - Basic block number in which the invoke instruction appears
#	pc_ - PC within the basic block at which the invoke instruction appears
#
# Results:
#	None
#
# Side effects:
#	Initializes variables according to the instruction.

oo::define quadcode::invocationSequence method analyze {xfmr_ b_ pc_} {

    set xfmr $xfmr_
    set b $b_
    set pc $pc_

    set bb [$xfmr getBasicBlock $b]
    set q [lindex $bb $pc]

    # Take apart the invocation

    set argl [lassign $q op res_invoke cfin_invoke cmd]
    if {$op ni {"invoke" "invokeExpanded"}} {
	error "cannot analyze: not an invocation."
    }

    # Find the input callframe and relevant input variables
    
    set pc0 $pc
    set cfin Nothing
    set invars {}
    if {$cfin_invoke ne "Nothing"} {
	set qb [lindex $bb [expr {$pc-1}]]
	if {[lindex $qb 0] eq "moveToCallFrame"} {
	    if {[lindex $qb 1] ne $cfin_invoke} {
		error "cannot analyze: moveToCallFrame mislinked"
	    }
	    set varl [lassign $qb - - cfin]
	    foreach {namelit source} $varl {
		if {[lindex $namelit 0] ne "literal"} {
		    error "cannot analyze: name of input var not literal"
		}
		dict set invars [lindex $namelit 1] $source
	    }
	    set pc0 [expr {$pc-1}]
	}
    }

    # Find the result value

    set retval $res_invoke
    if {[lindex $bb [incr pc] 0] eq "retrieveResult"} {
	set q2 [lindex $bb $pc]
	lassign $q2 - retval cf2
	if {$cf2 ne $res_invoke} {
	    error "cannot analyze: retrieveResult mislinked"
	}
    } else {
	incr pc -1
    }

    # Find the output callframe

    set cfout $res_invoke
    if {[lindex $bb [incr pc] 0] eq "extractCallFrame"} {
	set q2 [lindex $bb $pc]
	lassign $q2 - cfout cf2
	if {$cf2 ne $res_invoke} {
	    error "cannot analyze: extractCallFrame mislinked"
	}
    } else {
	incr pc -1
    }

    # Find the output variables

    set outvars {}
    while {[lindex $bb [incr pc] 0] eq "moveFromCallFrame"} {
	set q2 [lindex $bb $pc]
	lassign $q2 - varout cf2 litname
	if {$cf2 ne $cfout} {
	    error "cannot analyze: moveFromCallFrame mislinked"
	}
	lassign $litname kind val
	if {$kind ne "literal"} {
	    error "cannot analyze: moveFromCallFrame with non-literal variable"
	}
	dict set outvars $val $varout
    }
    incr pc -1

    # Find the error exit

    if {[lindex $bb [incr pc] 0] eq "jumpMaybe"} {
	set q2 [lindex $bb $pc]
	lassign $q2 - target cond
	if {$cond ne $retval} {
	    error "cannot analyze: jumpMaybe mislinked"
	}
	set errexit [lindex $target 1]
    } else {
	error "cannot analyze: invocation does not end basic block."
    }

    # Find the normal exit

    if {[lindex $bb [incr pc] 0] eq "jump"} {
	set normexit [lindex $bb $pc 1 1]
    } else {
	error "cannot analyze: basic block does not end with a jump"
    }
	
    return
}
 
# quadcode::invocationSequence method arginfo --
#
#	Queries [info args] for the invoked command.
#
# Results:
#	Returns an ordered pair consisting of {1 result} if the args
#	are known, or {0 {}} otherwise. The value of 'result' in the
#	ordered pair is the result of [info args] for the given command.

oo::define quadcode::invocationSequence method arginfo {} {
    lassign [my cmd] status cmdName
    if {!$status
	|| [catch {info args $cmdName} arginfo]} {
	return {0 {}}
    }
    return [list 1 $arginfo]
}

# quadcode::invocationSequence method b --
#
#	Returns the basic block number of an invocation sequence

oo::define quadcode::invocationSequence method b {} {
    return $b
}

# quadcode::invocationSequence method cfin --
#
#	Returns the starting callframe for an invocation sequence

oo::define quadcode::invocationSequence method cfin {} {
    return $cfin
}

# quadcode::invocationSequence method cfin_invoke --
#
#	Returns the callframe from the 'invoke' instruction in an
#	invocation sequence

oo::define quadcode::invocationSequence method cfin_invoke {} {
    return $cfin_invoke
}

# quadcode::invocationSequence method cfout --
#
#	Returns the ending callframe for an invocation sequence

oo::define quadcode::invocationSequence method cfout {} {
    return $cfout
}

# quadcode::invocationSequence method cmd --
#
#	Queries the name of the invoked command.
#
# Results:
#
#	Returns an ordered pair that is {1 commandName} if the sequence
#	invokes a known command, and {0 {}} if the sequence does not
#	invoke a known command.

oo::define quadcode::invocationSequence method cmd {} {
    if {[lindex $cmd 0] eq "literal"} {
	return [list 1 [lindex $cmd 1]]
    } else {
	return {0 {}}
    }
}

# quadcode::invocation sequence method argl --
#
#	Returns the argument list of the invoked command.

oo::define quadcode::invocationSequence method argl {} {
    return $argl
}

# quadcode::invocationSequence method errexit --
#
#	Returns the error exit block number for an invocation sequence

oo::define quadcode::invocationSequence method errexit {} {
    return $errexit
}

# quadcode::invocationSequence method invars --
#
#	Returns the input variables of an invocation sequence

oo::define quadcode::invocationSequence method invars {} {
    return $invars
}

# quadcode::invocationSequence method normexit --
#
#	Returns the normal exit block number for an invocation sequence

oo::define quadcode::invocationSequence method normexit {} {
    return $normexit
}

# quadcode::invocationSequence method outvars --
#
#	Returns the output variables of an invocation sequence

oo::define quadcode::invocationSequence method outvars {} {
    return $outvars
}

# quadcode::invocationSequence method pc0 --
#
#	Returns the starting program counter for an invocation sequence

oo::define quadcode::invocationSequence method pc0 {} {
    return $pc0
}

# quadcode::invocationSequence method res_invoke --
#
#	Returns the result of the 'invoke' or 'invokeExpanded' in
#	an invocation sequence

oo::define quadcode::invocationSequence method res_invoke {} {
    return $res_invoke
}

# quadcode::invocationSequence method retval --
#
#	Returns the return value for an invocation sequence

oo::define quadcode::invocationSequence method retval {} {
    return $retval
}


<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<


















































































































































































































































































































































































































































































































































































































































Changes to quadcode/transformer.tcl.

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







<











779
780
781
782
783
784
785

786
787
788
789
790
791
792
793
794
795
796
source [file join $quadcode::libdir copyprop.tcl]
source [file join $quadcode::libdir dbginfo.tcl]
source [file join $quadcode::libdir deadcode.tcl]
source [file join $quadcode::libdir duchain.tcl]
source [file join $quadcode::libdir flatten.tcl]
source [file join $quadcode::libdir fqcmd.tcl]
source [file join $quadcode::libdir inline.tcl]

source [file join $quadcode::libdir jumpthread.tcl]
source [file join $quadcode::libdir liveranges.tcl]
source [file join $quadcode::libdir loopinv.tcl]
source [file join $quadcode::libdir narrow.tcl]
source [file join $quadcode::libdir pre.tcl]
source [file join $quadcode::libdir ssa.tcl]
source [file join $quadcode::libdir translate.tcl]
source [file join $quadcode::libdir typecheck.tcl]
source [file join $quadcode::libdir upvar.tcl]
source [file join $quadcode::libdir varargs.tcl]
source [file join $quadcode::libdir widen.tcl]

Changes to quadcode/varargs.tcl.

27
28
29
30
31
32
33
34
35
36
37

38
39
40
41
42
43
44
..
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139























140
141
142
143
144
145
146
147
148
149



150
151
152
153



154
155


156
157
158
159
160
161

162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214




215


216
217
218


219
220




221



222
223
224
225



226
227









228
229
230
231
232
233
234
...
403
404
405
406
407
408
409

410





411
412
413
414
415
416
417
...
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452




453
454
455
456
457
458
459
...
472
473
474
475
476
477
478

479
480
481


482
483
484
485




486
487
488
489
490



491

492
493



494
495
496
497







498
499
500
501
502



503
504
505

506



507







508
509
510
511
512
513
514

515
516
517
518
519
520
521
522
523
524




525
526
527
528
529
530
531
532
533

534
535
536
537
538
539
540
541
542
543


544
545









































546
547
548



549
550



551
552
553
554
555
556
557
558


559
560
561


562
563
564
565


566



567
568
569





570


571
572
573
574
575
576
577
578
#
# Preconditions:
#       This pass presumes that the quadcode is partitioned into basic blocks,
#       and that SSA conversion has been run (so a constant procedure name
#       will have propagated into 'invoke' instructions. It also presumes
#       that procedure names have been resolved into the fully qualified names.
#
#       This pass introduces temporaries, but only locally to basic blocks,
#       so it does not require elaborate rewriting of SSA form. It must run
#       prior to parameter type checking (including the 'rewriteParamChecks'
#       peephole).

#
#       There is a hidden assumption in this method that default args are
#       always of acceptable type - and so type checks need not be
#       emitted for default parameters. (There is major rethinking needed
#       if this ever might not be the case.)

oo::define quadcode::transformer method varargs {} {
................................................................................
#
# Side effects:
#	Rewrites the instruction and 'expand' instructions that it
#       uses. Updates ud- and du-chains.

oo::define quadcode::transformer method va_RewriteInvoke {b pc q} {

    # Analyze the invocation sequence.  This codeburst will run from the
    # 'moveToCallFrame' preceding the invocation out to the end of the
    # basic block.  We will be rewriting it.
    set call [::quadcode::invocationSequence new]
    $call analyze [self] $b $pc

    # We can process only those sequences where the procedure name is known
    # a priori, the expected arguments are known, and the target procedure
    # is compiled.  BUG - We know the arguments to a great many Core commands
    # and need to work with them as well.
    lassign [$call arginfo] status arginfo
    if {!$status} return
    my debug-varargs {
        puts "[my full-name]: $b:$pc: $q"
        puts "    arginfo = $arginfo"
    }

    # We are going to be doing major surgery on the basic block.
    # Remove the 'invokeExpanded' and all following instructions
    # from the block. Unlink the block from its successors, and
    # remove ud- and du-chaining for the removed instructions.
    set bb [my va_UnlinkTail $b [$call pc0]]
    set B [quadcode::builder new [self] $b $bb]

    # Prepare parameters for the 'invoke' (or 'invokeExpanded') call, and
    # add the call to the instruction sequence under construction.
    my va_PrepareArgs $B $call

    puts "NOT FINISHED."
    exit
    $B destroy
    $call destroy
    return
}























 
# quadcode::transformer method va_PrepareArgs --
#
#	Emits code to prepare the arguments for an 'invoke' or
#	'invokeExpanded' command, up to the point where the actual
#	'invoke' is issued.
#
# Parameters:
#	B - quadcode::builder where the new invocation sequence is being built.
#	call - Object describing the invocation sequence.



#
# Results:
#	None.




oo::define quadcode::transformer method va_PrepareArgs {B call} {
    


    # Create the first part of the 'invoke' instruction.
    
    lassign [$call cmd] status callee
    if {!$status} {
        error "can't find callee -- can't happen"
    }

    set newq [list invoke \
                  [$call res_invoke] [$call cfin_invoke] \
                  [list literal $callee]]

    # Find out how many plain parameters (that is, not 'args') the
    # called command has.
    lassign [$call arginfo] status arginfo
    if {!$status} {
        error "can't find arginfo - can't happen"
    }
    set nPlainParams [llength $arginfo]
    set haveargs 0
    if {[lindex $arginfo end] eq "args"} {
        set haveargs 1
        incr nPlainParams -1
    }

    # Any leading plain arguments that do not have {*} can simply be retained
    # 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 [$call argl]
    set pos 0
    while {$pos < $nPlainParams} {
        if {[my va_NonExpandedArgument newq $arginfo $pos $argl]} break
        incr pos
    }

    my debug-varargs {
        puts "varargs: [$call b]:[$call pc0]: matched $pos out of $nPlainParams\
              leading non-expanded arg(s)."
    }

    # Generate code to make the rest of the args into a list
    my va_MakeArgList $B $argl $pos

    puts "NOT DONE - varargs matched non-expanded args."
    exit 1

}


if 0 {

    set tempIndex -1
    set listLoc [my va_MakeArgList bb tempIndex pos $b $q]

    # We are going to need the length of the list, so
    # extract that now. (If it turns out somehow that we
    # don't use it, 'deadvars' will get rid of this, anyway.)
    set lenLoc1 [my newVarInstance [list temp [incr tempIndex]]]
    set lenLoc [my newVarInstance [list temp $tempIndex]]
    my va_EmitAndTrack $b bb [list listLength $lenLoc1 $listLoc]




    my va_EmitAndTrack $b bb [list extractMaybe $lenLoc $lenLoc1]



    # Count the mandatory args



    set firstMandatory $pos
    while {$pos < $nPlainParams} {




        if {[info default $callee [lindex $arginfo $pos] defaultVal]} {



            break
        }
        incr pos
    }



    set firstOptional $pos










    set compTemp [list temp [incr $tempIndex]]

    set nMandatory 0
    if {$firstOptional > $firstMandatory} {

        # Make code to check length of arg list, starting a
        # new basic block
................................................................................
#
# Side effects:
#	Variable defs and uses in the invocation sequence are removed
#	from ud- and du-chains. The basic block is unlinked from its
#	successors. 

oo::define quadcode::transformer method va_UnlinkTail {b pc} {

    set bb [lindex $bbcontent $b]





    set tail [lrange $bb $pc end]
    set bb [lreplace $bb[set bb {}] $pc end]
    foreach q $tail {
        if {[lindex $q 1 0] in {"temp" "var"}} {
            dict unset udchain [lindex $q 1]
        }
        foreach arg [lrange $q 2 end] {
................................................................................
#	pos - Position of the argument (0 = first) in the argument list
#	argl - Argument list of the 'invoke' or 'invokeExpanded' instruction
#
# Results:
#	Returns 0 if the parameter was transferred, 1 if we are at the
#	end of the possible static transfers.

oo::define quadcode::transformer method va_NonExpandedArgument {newqVar
                                                                    arginfo
                                                                    pos argl} {

    upvar 1 $newqVar newq
    
    set param [lindex $arginfo $pos]
    set arg [lindex $argl $pos]




    switch -exact -- [lindex $arg 0] {
        "literal" {
        }
        "temp" - "var" {
            lassign [my findDef $arg] defb defpc defstmt
            if {[lindex $defstmt 0] eq "expand"} {
                return 1
................................................................................
#	Takes the non-fixed-position arguments of 'invokeExpanded'
#	and emits code to make them into a list.
#
# Parameters:
#	B - quadcode::builder that is rewriting the invocation sequence.
#	argl - Argument list being analyzed
#	pos - Position in the argument list

#
# Results:
#


#	Returns the name of a variable, temporary or literal that holds the
#	expanded list.

oo::define quadcode::transformer method va_MakeArgList {B argl pos} {





    # 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]} {



        set listLoc "literal {}"

    } else {
        set arg [lindex $argl $pos]



        switch -exact -- [lindex $arg 0] {
            "literal" {
                set listloc [$B maketemp arglist]
                $B emit [list list $listloc $arg]







                set mightThrow 0
            }
            "temp" - "var" {
                lassign [my findDef $arg] defb defpc defstmt
                if {[lindex $defstmt 0] eq "expand"} {



                    set listLoc [lindex $defstmt 2]
                    set mightThrow 1
                } else {

                    set listLoc [$B maketemp arglist]



                    $B emit [list list $listLoc $arg]







                    set mightThrow 0
                }
            }
        }
    }
    puts "did first arg, arglist is $listLoc, and b so far is\n[join [$B bb] \n]"
    puts "lhsMightThrow = $lhsMightThrow"


    if {$lhsMightThrow} {

    exit 1

    # listLoc now holds the location of the list under
    # construction. Concatenate the remaining params onto it.

        foreach arg [lrange $argl [expr {1 + $pos}] end] {





            # Do we need to expand this arg?
            switch -exact -- [lindex $arg 0] {
                "literal" {
                    set op "listAppend"
                }
                "temp" - "var" {
                    lassign [my findDef $arg] defb defpc defstmt
                    if {[lindex $defstmt 0] eq "expand"} {
                        set op "listConcat"

                    } else {
                        set op "listAppend"
                    }
                }
            }

            # Make variable to hold Maybe result from the concatenation,
            # and emit the concatenation.
            set nloc [$B maketemp arglist]
            $B emit [list $op $nloc $listLoc $arg]



            if {$lhsMightThrow || $op == "listConcat"} {









































                my makeErrorBlock $B
                set intb [$B makeblock]
                set nextb [$B makeblock]



                $B emit [list jumpMaybe [list bb $intb] $nloc]
                set lhsMightThrow 0



                $B emit [list jump [list bb $nextb]]
                $B buildin $intb
                set error [$B maketemp nloc]
                $B emit [list extractFail $error $nloc]
                $B emit [list jump [list bb $errorb]]
                $B phi $errorb error $error
                $B emit [list jump [list bb $errorb]]
                $B buildin $nextb



                # KBK is here - need to get my context back!!!
            }



            # extract the result from the Maybe
            set listLoc [$B maketemp arglist]
            $B emit [list extractMaybe $listLoc $nloc]


        }




        return $listLoc
}





}



 
# quadcode::transformer method va_CheckEnough --
#
#	Emits code to check for too few args passed to invokeExpanded
#
# Parameters:
#	b - Basic block number under construction







<
<
|
<
>







 







<
<
<
<
<
<




|










|




|
|






>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>









|
>
>
>



|
>
>
>
|

>
>


<
<
<
<
>
|
<
<



<
<
<
<











|







|




|

<
<
<
<
<
<
<
<
<
<
<



|
|
|
>
>
>
>
|
>
>
|
<

>
>


>
>
>
>

>
>
>




>
>
>


>
>
>
>
>
>
>
>
>







 







>

>
>
>
>
>







 







|
<
|





>
>
>
>







 







>



>
>
|


|
>
>
>
>





>
>
>

>


>
>
>




>
>
>
>
>
>
>





>
>
>



>

>
>
>
|
>
>
>
>
>
>
>





|
|
>
|
<
<
<




|

>
>
>
>
|
|
|
|
|
|
|
|
|
>
|
|
|
|
|
|
|
|
|
|
>
>
|
<
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
|
>
>
>
|
<
>
>
>
|
<
<
<
<
<
<
<
>
>
|
<
|
>
>
|
<
<
<
>
>
|
>
>
>
|
<
|
>
>
>
>
>
|
>
>
|







27
28
29
30
31
32
33


34

35
36
37
38
39
40
41
42
..
97
98
99
100
101
102
103






104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180




181
182


183
184
185




186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211











212
213
214
215
216
217
218
219
220
221
222
223
224
225

226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
...
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
...
473
474
475
476
477
478
479
480

481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
...
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589



590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622

623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670

671
672
673
674







675
676
677

678
679
680
681



682
683
684
685
686
687
688

689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
#
# Preconditions:
#       This pass presumes that the quadcode is partitioned into basic blocks,
#       and that SSA conversion has been run (so a constant procedure name
#       will have propagated into 'invoke' instructions. It also presumes
#       that procedure names have been resolved into the fully qualified names.
#


#       This pass must run prior to parameter type checking (including the

#       'rewriteParamChecks' peephole).
#
#       There is a hidden assumption in this method that default args are
#       always of acceptable type - and so type checks need not be
#       emitted for default parameters. (There is major rethinking needed
#       if this ever might not be the case.)

oo::define quadcode::transformer method varargs {} {
................................................................................
#
# Side effects:
#	Rewrites the instruction and 'expand' instructions that it
#       uses. Updates ud- and du-chains.

oo::define quadcode::transformer method va_RewriteInvoke {b pc q} {







    # We can process only those sequences where the procedure name is known
    # a priori, the expected arguments are known, and the target procedure
    # is compiled.  BUG - We know the arguments to a great many Core commands
    # and need to work with them as well.
    lassign [my va_GetArgInfo $q] status arginfo
    if {!$status} return
    my debug-varargs {
        puts "[my full-name]: $b:$pc: $q"
        puts "    arginfo = $arginfo"
    }

    # We are going to be doing major surgery on the basic block.
    # Remove the 'invokeExpanded' and all following instructions
    # from the block. Unlink the block from its successors, and
    # remove ud- and du-chaining for the removed instructions.
    set bb [my va_UnlinkTail $b $pc]
    set B [quadcode::builder new [self] $b $bb]

    # Prepare parameters for the 'invoke' (or 'invokeExpanded') call, and
    # add the call to the instruction sequence under construction.
    my va_PrepareArgs $B $b $pc $q $arginfo
 
    puts "NOT FINISHED."
    exit
    $B destroy
    $call destroy
    return
}
 
# quadcode::transformer method va_GetArgInfo --
#
#	Determines the target of an invocation and performs [info args] on
#	that target to get its argument list.
#
# Parameters:
#	q - Quadcode 'invoke' or 'invokeExpanded' instruction
#
# Results:
#	Returns [list 1 $arglist] if the callee is known and [info args]
#	succeeds. Returns [list 0 {}] for an unknown callee or one whose
#	expected args are unknown.

oo::define quadcode::transformer method va_GetArgInfo {q} {
    set cmd [lindex $q 3]
    if {[lindex $cmd 0] ne "literal"
        || [catch {info args [lindex $cmd 1]} arginfo]} {
        return {0 {}}
    } else {
        return [list 1 $arginfo]
    }
}
 
# quadcode::transformer method va_PrepareArgs --
#
#	Emits code to prepare the arguments for an 'invoke' or
#	'invokeExpanded' command, up to the point where the actual
#	'invoke' is issued.
#
# Parameters:
#	B - quadcode::builder where the new invocation sequence is being built.
#	b - Basic block where the original 'invoke' instruction resided
#	pc - Program counter within the basic block
#	q - 'invoke' or 'invokeExpanded' instruction.
#	arginfo - Arguments expected by the invoked command
#
# Results:
#	None.
#
# The command name being invoked, and the expected arguments, ar always known
# at this point.

oo::define quadcode::transformer method va_PrepareArgs {B b pc q arginfo} {
    
    set argl [lassign $q opcode result cfin cmd]

    # Create the first part of the 'invoke' instruction.
    




    set iresult [my newVarInstance $result]
    set newq [list invoke $result $cfin $cmd]



    # Find out how many plain parameters (that is, not 'args') the
    # called command has.




    set nPlainParams [llength $arginfo]
    set haveargs 0
    if {[lindex $arginfo end] eq "args"} {
        set haveargs 1
        incr nPlainParams -1
    }

    # Any leading plain arguments that do not have {*} can simply be retained
    # 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
    while {$pos < $nPlainParams} {
        if {[my va_NonExpandedArgument newq $arginfo $pos $argl]} break
        incr pos
    }

    my debug-varargs {
        puts "varargs: $b:$pc: matched $pos out of $nPlainParams\
              leading non-expanded arg(s)."
    }

    # Generate code to make the rest of the args into a list
    lassign [my va_MakeArgList $B $argl $pos $cfin] mightThrow listLoc












    # We are going to need the length of the list, so
    # extract that now. (If it turns out somehow that we
    # don't use it, 'deadvars' will get rid of this, anyway.)
    set lenLoc1 [my newVarInstance {temp @arglen}]
    set lenLoc [my newVarInstance {temp @arglen}]
    $B emit [list listLength $lenLoc1 $listLoc]
    
    my debug-varargs {
        $B log-last
    }
    $B emit [list extractMaybe $lenLoc $lenLoc1]
    my debug-varargs {
        $B log-last
    }



    # Count the mandatory args
    set firstMandatory $pos
    while {$pos < $nPlainParams} {
        my debug-varargs {
            puts "varargs: does arg $pos: \"[lindex $arginfo $pos]\"\
                  have a default?"
        }
        if {[info default $callee [lindex $arginfo $pos] defaultVal]} {
            my debug-varargs {
                puts "         yes: \"defaultVal\""
            }
            break
        }
        incr pos
    }
    my debug-varargs {
        puts "varargs: first optional arg is at position $pos"
    }
    set firstOptional $pos


    puts "NOT DONE - varargs built the arglist in $listLoc"
    exit 1

}


if 0 {

    set compTemp [list temp [incr $tempIndex]]

    set nMandatory 0
    if {$firstOptional > $firstMandatory} {

        # Make code to check length of arg list, starting a
        # new basic block
................................................................................
#
# Side effects:
#	Variable defs and uses in the invocation sequence are removed
#	from ud- and du-chains. The basic block is unlinked from its
#	successors. 

oo::define quadcode::transformer method va_UnlinkTail {b pc} {

    set bb [lindex $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]
    foreach q $tail {
        if {[lindex $q 1 0] in {"temp" "var"}} {
            dict unset udchain [lindex $q 1]
        }
        foreach arg [lrange $q 2 end] {
................................................................................
#	pos - Position of the argument (0 = first) in the argument list
#	argl - Argument list of the 'invoke' or 'invokeExpanded' instruction
#
# Results:
#	Returns 0 if the parameter was transferred, 1 if we are at the
#	end of the possible static transfers.

oo::define quadcode::transformer method va_NonExpandedArgument {newqVar arginfo

                                                                pos argl} {

    upvar 1 $newqVar newq
    
    set param [lindex $arginfo $pos]
    set arg [lindex $argl $pos]
    my debug-varargs {
        puts "varargs: transfer actual arg [list $arg] into formal arg\
              \"$param\""
    }
    switch -exact -- [lindex $arg 0] {
        "literal" {
        }
        "temp" - "var" {
            lassign [my findDef $arg] defb defpc defstmt
            if {[lindex $defstmt 0] eq "expand"} {
                return 1
................................................................................
#	Takes the non-fixed-position arguments of 'invokeExpanded'
#	and emits code to make them into a list.
#
# Parameters:
#	B - quadcode::builder that is rewriting the invocation sequence.
#	argl - Argument list being analyzed
#	pos - Position in the argument list
#	cfin - Callframe input to the 'invoke' instruction.
#
# Results:
#
#	Returns a two-element list. The first element is 1 if it is possible
#	that the argument list is a non-list, and 0 otherwise.  The second
#	element is the name of a variable, temporary or literal that holds the
#	expanded list.

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"
    }

    # 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 {}"
        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]
                my debug-varargs {
                    $B log-last
                }
                $B emit [list extractMaybe $listLoc $intLoc]
                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 [lindex $defstmt 2]
                    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 $intLoc $arg]
                    my debug-varargs {
                        $B log-last
                    }
                    $B emit [list extractMaybe $listLoc $intLoc]
                    my debug-varargs {
                        $B log-last
                    }
                    set mightThrow 0
                }
            }
        }
    }
    my debug-varargs {
        puts "varargs: transferred first arg into [list $listLoc]."
        puts "         mightThrow = $mightThrow"
    }




    # listLoc now holds the location of the list under
    # construction. Concatenate the remaining params onto it.

    foreach arg [lrange $argl [expr {1 + $pos}] end] {

        my debug-varargs {
            puts "varargs: transfer arg $arg"
        }

        # Do we need to expand this arg?
        switch -exact -- [lindex $arg 0] {
            "literal" {
                set op "listAppend"
            }
            "temp" - "var" {
                lassign [my findDef $arg] defb defpc defstmt
                if {[lindex $defstmt 0] eq "expand"} {
                    set op "listConcat"
                    set mightThrow 1
                } else {
                    set op "listAppend"
                }
            }
        }
        
        # Make variable to hold Maybe result from the concatenation,
        # and emit the concatenation.
        set nloc [$B maketemp arglist]
        $B emit [list $op $nloc $listLoc $arg]
        my debug-varargs {
            $B log-last
        }


        # If the concatenation might have failed, emit the error check
        if {$mightThrow} {
            my va_MakeErrorCheck $B $cfin $nloc
            set mightThrow 0
        }

        # On normal exit from list construction, extract the result from the
        # 'maybe' returned by listAppend or listConcat
        set listLoc [$B maketemp arglist]
        $B emit [list extractMaybe $listLoc $nloc]
        my debug-varargs {
            $B log-last
        }
    }

    set retval [list $mightThrow $listLoc]
    return $retval

}
 
# quadcode::transformer method va_MakeErrorCheck --
#
#	Emits code to jump to an error block if a given value is FAIL.
#
# Parameters:
#	B - Builder that is emitting code
#	cf - Callframe that is active at the time of the check
#	val - Value that might be FAIL
#
# Results:
#	None.
#
# Side effects:
#	Emits the necessary jumpMaybe, and adds callframe and FAIL value
#	to the phi operations at the head of the error block.

oo::define quadcode::transformer method va_makeErrorCheck {B cf val} {

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

    # Close out the current block with jumpMaybe to an intermediate
    # block and jump to the normal return
    $B emit [list jumpMaybe [list bb $intb] $val]

    my debug-varargs {
        $B log-last
    }
    $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
    



    my debug-varargs {
        $B log-last
    }
    $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 get-or-make-temp error]
    set callframeInPhi [$B get-or-make-temp error-callframe]
    $B phi $errorb $errorInPhi $val
    $B phi $errorb $callframeInPhi $cf

    # Now continue building in the normal exit
    $B buildin $nextb
}
 
# quadcode::transformer method va_CheckEnough --
#
#	Emits code to check for too few args passed to invokeExpanded
#
# Parameters:
#	b - Basic block number under construction