tclquadcode

Check-in [5557b1e592]
Login

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

Overview
Comment:Enough changes to get through first two 'expandtest' tests
Timelines: family | ancestors | descendants | both | notworking | kbk-refactor-callframe
Files: files | file ages | folders
SHA3-256:5557b1e592c23fc9ba0b380b8c224c3e62d582125b562ddf4f0b80587a4aa5f3
User & Date: kbk 2019-01-21 18:14:59
Context
2019-01-21
19:45
Fix mislinking of phi operations on the error branch of 'invoke' check-in: 407e1ef055 user: kbk tags: notworking, kbk-refactor-callframe
18:14
Enough changes to get through first two 'expandtest' tests check-in: 5557b1e592 user: kbk tags: notworking, kbk-refactor-callframe
2019-01-18
04:22
Add the final processing in 'varargs' - next, emit the error path. check-in: 305328fa6b user: kbk tags: notworking, kbk-refactor-callframe
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to quadcode/bb.tcl.

338
339
340
341
342
343
344

345
346

347



348
349
350
351
352
353
354
355
356





























357
358
359
360
361
362
363
    # Parameters:
    #	to - Successor of the new block
    #
    # Results:
    #	Returns the new block's block number

    method makeEmptyBB {{to -1}} {

	# Create the block
	set newb [llength $bbcontent]

	lappend bbcontent [list [list jump [list bb $to]]]



	lappend bbpred {}

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

	return $newb
    }





























 
    # bbcopy --
    #
    #	Makes a copy of a basic block
    #
    # Parameters:
    #	b - Block number to copy







>
|

>
|
>
>
>









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







338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
    # Parameters:
    #	to - Successor of the new block
    #
    # Results:
    #	Returns the new block's block number

    method makeEmptyBB {{to -1}} {

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

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

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

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

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

Changes to quadcode/builder.tcl.

23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
..
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
..
94
95
96
97
98
99
100



















101
102
103
104
105
106
107
...
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
...
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
oo::class create quadcode::builder {

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

    variable b;			# Basic block number under construction

    variable bb;		# Content of the basic block under construction

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

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

oo::define quadcode::builder constructor {xfmr_ b_ bb_} {
    set xfmr $xfmr_
    set b $b_
    set bb $bb_
    set bbindex {}
    set varindex {}












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

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

    # Create the block
    set b [$xfmr makeEmptyBB]

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

    return $b
}
 
# quadcode::builder method getblock --
#
#	Finds a basic block created by 'makeblock'
#
# Parameters:
................................................................................

oo::define quadcode::builder method getblock {name} {
    if {![dict exists $bbindex $name]} {
        return -1
    } else {
        return [dict get $bbindex $name]
    }



















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

    # Split the instruction
    lassign $q opcode res argl

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

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

	    # Instrtuction is an assignment, update the ud-chain.
            dict set udchain $res $b
        }
    }

    # Handle the arguments
    foreach arg [lrange $q 2 end] {
        switch -exact -- [lindex $arg 0] {
            "temp" - "var" {
................................................................................
		# Argument is an SSA value, update the du-chain.
		$xfmr addUse $arg $b
            }
        }
    }

    # Add the instruction to the block


    lappend bb $q


    return
}
 





















































# quadcode::builder method bb --
#
#	Returns the content of the basic block under construction.
#
# Results:
#	Returns the instructions.

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

 
# quadcode::builder method log-last --
#
#	Logs the last instruction emitted to the standard output
#
# Results:
#	None.

oo::define quadcode::builder method log-last {} {

    set 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:







<
<







 







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




|







 







|



|


|







 







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







 







<




<

|







 







>
>

>




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










>









>











23
24
25
26
27
28
29


30
31
32
33
34
35
36
..
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
...
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
...
188
189
190
191
192
193
194

195
196
197
198

199
200
201
202
203
204
205
206
207
...
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
oo::class create quadcode::builder {

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

    variable b;			# Basic block number under construction



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

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

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

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

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

    # Create the block
    set newb [$xfmr makeEmptyBB]

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

    return $newb
}
 
# quadcode::builder method getblock --
#
#	Finds a basic block created by 'makeblock'
#
# Parameters:
................................................................................

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

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

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

    return

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

    # Split the instruction
    lassign $q opcode res argl

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

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

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

    # Handle the arguments
    foreach arg [lrange $q 2 end] {
        switch -exact -- [lindex $arg 0] {
            "temp" - "var" {
................................................................................
		# Argument is an SSA value, update the du-chain.
		$xfmr addUse $arg $b
            }
        }
    }

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

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

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

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

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

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

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

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

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

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

Changes to quadcode/duchain.tcl.

101
102
103
104
105
106
107
108
















109
110
111
112
113
114
115
			}
			my addUse $opd $b
		    }
		}
	    }
	}
    }
     
















    # addUse --
    #
    #   Updates du-chains to add a use to a variable
    #
    # Parameters:
    #	var - Variable whose use is being added. It is harmless to call
    #	      this procedure for things other than variables, but has no







|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







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

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

Changes to quadcode/narrow.tcl.

78
79
80
81
82
83
84
85





86



87
88
89
90
91
92
93
		# and consists of the quadcode statement 'dquad'.
		if {[catch {

		    # Finding the definition will throw an error at a phi.
		    # The error can be ignored, because phi is not 'arrayExists'
		    # 'exists' or 'instanceOf'.
		    my findDef [lindex $q 2]
		} result]} continue





		lassign $result dbb dpc dquad



		set dop [lindex $dquad 0 0]

		switch -exact -- $dop {

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







|
>
>
>
>
>

>
>
>







78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
		# and consists of the quadcode statement 'dquad'.
		if {[catch {

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

		switch -exact -- $dop {

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

Changes to quadcode/ssa.tcl.

1245
1246
1247
1248
1249
1250
1251



1252
1253
1254
1255
1256
1257
1258
....
1278
1279
1280
1281
1282
1283
1284

1285
1286
1287
1288
1289
1290
1291
	set newb {}
	set newpc -1
	set pc -1
	set singleExit 1
	foreach q $bb {
	    incr pc
	    if {[lindex $q 0 0] eq "phi"} {



		continue
	    }
	    if {[lindex $q 0 0] eq "jump"} {
		break
	    }
	    if {[lindex $q 1 0] eq "bb"} {
		set singleExit 0
................................................................................
		    break
		}
		set src [dict get $argl $bkey]
		if {$src eq "Nothing"} {
		    set q3 [list unset $dest]
		} else {
		    set q3 [list copy $dest $src]

		}
		my debug-deconstructSSA {
		    puts "    [incr newpc]: $q3"
		}
		lappend newb $q3
	    }
	}







>
>
>







 







>







1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
....
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
	set newb {}
	set newpc -1
	set pc -1
	set singleExit 1
	foreach q $bb {
	    incr pc
	    if {[lindex $q 0 0] eq "phi"} {
		foreach {from val} [lrange $q 2 end] {
		    my removeUse $val $from
		}
		continue
	    }
	    if {[lindex $q 0 0] eq "jump"} {
		break
	    }
	    if {[lindex $q 1 0] eq "bb"} {
		set singleExit 0
................................................................................
		    break
		}
		set src [dict get $argl $bkey]
		if {$src eq "Nothing"} {
		    set q3 [list unset $dest]
		} else {
		    set q3 [list copy $dest $src]
		    my addUse $src $b
		}
		my debug-deconstructSSA {
		    puts "    [incr newpc]: $q3"
		}
		lappend newb $q3
	    }
	}

Changes to quadcode/transformer.tcl.

333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
	    ud_du_chain
	    copyprop
	} {
	    my debug-transform {
		puts "Run: $pass"
	    }
	    lappend timings $pass [lindex [time [list my $pass]] 0]
	    my debug-audit {
		my audit-duchain $pass
		my audit-phis $pass
	    }
	}
	my debug-timings {
	    foreach {pass usec} $timings {
		puts "$pass: $usec microseconds"
	    }
	}
	my debug-transform {







<
<
<
<







333
334
335
336
337
338
339




340
341
342
343
344
345
346
	    ud_du_chain
	    copyprop
	} {
	    my debug-transform {
		puts "Run: $pass"
	    }
	    lappend timings $pass [lindex [time [list my $pass]] 0]




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

Changes to quadcode/varargs.tcl.

75
76
77
78
79
80
81





82
83
84
85
86
87
88
...
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
...
262
263
264
265
266
267
268




269
270
271
272
273
274
275
...
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
...
383
384
385
386
387
388
389
390

391
392
393
394
395
396
397
...
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
...
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
...
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
....
1030
1031
1032
1033
1034
1035
1036

1037
1038
1039
1040




1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051




































1052
1053
1054
1055
1056
1057
1058
    }

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






}
 
# quadcode::transformer method va_RewriteInvoke --
#
#       Rewrites 'invoke' and 'invokeExpanded' instructions to accommodate
#       compiled procs that accept variable numbers of arguments without going
#       through a call thunk or losing data type information.
................................................................................
    my debug-varargs {
        puts "varargs: result retrieval: $q1"
    }
    if {[lindex $q1 0] ne "retrieveResult" || [lindex $q1 2] ne [lindex $q 1]} {
        error "mislinked invoke: should be followed with 'retrieveResult'"
    }
    set result [lindex $q1 1]
    $B emit [list retrieveResult [$B maketemp "result"] [lindex $q1 1]]
    my debug-varargs {
        $B log-last
    }

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

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

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




    $B emit [list extractMaybe $lenLoc $lenLoc1]
    my debug-varargs {
        $B log-last
    }


    # Count the mandatory args
................................................................................
    set bb [lindex $bbcontent $b]
    lset bbcontent $b {}
    my debug-varargs {
        puts "varargs: Split basic block $b:"
        puts "   $b:$pc: [lindex $bb $pc]"
    }

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

}
 
# quadcode::transformer method va_NonExpandedArgument --
#
#	Transfer a leading non-expanded argument into a quad
#	under construction when rewriting 'invokeExpanded'
#
................................................................................
        switch -exact -- [lindex $arg 0] {
            "literal" {
                set listloc [$B maketemp arglist]
                $B emit [list list $listloc $arg]
                my debug-varargs {
                    $B log-last
                }
                $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
                }
            }
        }
................................................................................
# Results:
#	None.
#
# Side effects:
#	Emits the necessary jumpMaybe, and adds FAIL value
#	to the phi operation at the head of the error block.

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

    error "va_MakeErrorCheck: Not yet reached in testing"

    # Emit any required error checking when building the variable
    # argument list.
    my va_MakeErrorBlock $B
    set errorb [$B getblock error]
    set intb [$B makeblock]
    set nextb [$B makeblock]
................................................................................
    $B emit [list jump [list bb $nextb]]
    my debug-varargs {
        $B log-last
    }

    # Make an intermediate block that jumps to the error block
    $B buildin $intb
    
    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]
    $B phi $errorb $errorInPhi $val

    # Now continue building in the normal exit
    $B buildin $nextb
}



































 
# quadcode::transformer method va_UnpackMandatory --
#
#	Unpacks the mandatory args to a proc from the list created
#	by argument expansion
#
# Parameters;
................................................................................
#
# Side effects:
#	Emits all the remaining code.

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


    set errorb [$B getblock "error"]
    set normresult [$B gettemp "result"]
    set normcf [$B gettemp "callframe"]
    if {$errorb <  00} {




        $B emit [list copy $cf $normcf]
        my debug-varargs {
            $B log-last
        }
        $B emit [list copy $result $normresult]
        my debug-varargs {
            $B log-last
        }
    } else {
        error "Need to emit convergence from error handling at block $errorb"
        




































    }

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







>
>
>
>
>







 







|








|






|







 







>
>
>
>







 







|







 







|
>







 







<
<
<
<








>
|
>
>
>







|
<
<
<
<







 







|
<
<







 







<
<
<
<






|
|




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







 







>



|
>
>
>
>









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







75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
...
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
...
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
...
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
...
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
...
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
...
645
646
647
648
649
650
651
652


653
654
655
656
657
658
659
...
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
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
....
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089

1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
    }

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

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

}
 
# quadcode::transformer method va_RewriteInvoke --
#
#       Rewrites 'invoke' and 'invokeExpanded' instructions to accommodate
#       compiled procs that accept variable numbers of arguments without going
#       through a call thunk or losing data type information.
................................................................................
    my debug-varargs {
        puts "varargs: result retrieval: $q1"
    }
    if {[lindex $q1 0] ne "retrieveResult" || [lindex $q1 2] ne [lindex $q 1]} {
        error "mislinked invoke: should be followed with 'retrieveResult'"
    }
    set result [lindex $q1 1]
    $B emit [list retrieveResult [$B maketemp "result"] [lindex $newq 1]]
    my debug-varargs {
        $B log-last
    }

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

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

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


    # Count the mandatory args
................................................................................
    set bb [lindex $bbcontent $b]
    lset bbcontent $b {}
    my debug-varargs {
        puts "varargs: Split basic block $b:"
        puts "   $b:$pc: [lindex $bb $pc]"
    }

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

    return [lreplace $tail[set tail {}] 0 0]
}
 
# quadcode::transformer method va_NonExpandedArgument --
#
#	Transfer a leading non-expanded argument into a quad
#	under construction when rewriting 'invokeExpanded'
#
................................................................................
        switch -exact -- [lindex $arg 0] {
            "literal" {
                set listloc [$B maketemp arglist]
                $B emit [list list $listloc $arg]
                my debug-varargs {
                    $B log-last
                }




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




                    my debug-varargs {
                        $B log-last
                    }
                    set mightThrow 0
                }
            }
        }
................................................................................
# Results:
#	None.
#
# Side effects:
#	Emits the necessary jumpMaybe, and adds FAIL value
#	to the phi operation at the head of the error block.

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



    # Emit any required error checking when building the variable
    # argument list.
    my va_MakeErrorBlock $B
    set errorb [$B getblock error]
    set intb [$B makeblock]
    set nextb [$B makeblock]
................................................................................
    $B emit [list jump [list bb $nextb]]
    my debug-varargs {
        $B log-last
    }

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




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

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

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

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

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

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

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

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

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

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

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


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

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

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

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

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