tclquadcode
Check-in [7c9d400e5e]
Login
HomeTimelineBranchesTagsTicketsWiki
Bounty program for improvements to Tcl and certain Tcl packages.

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

Overview
Comment:Very rough beginning of a refactored 'varargs' pass
Timelines: family | ancestors | descendants | both | notworking | kbk-refactor-varargs
Files: files | file ages | folders
SHA3-256: 7c9d400e5e7e22c778af26d006c14188cec536db32c480382173ef92f352498d
User & Date: kbk 2018-12-27 19:44:51
Context
2018-12-27
19:47
Add 'buiilder.tcl' inadvertently omitted from previous commit Closed-Leaf check-in: 2e3b3ea76f user: kbk tags: notworking, kbk-refactor-varargs
19:44
Very rough beginning of a refactored 'varargs' pass check-in: 7c9d400e5e user: kbk tags: notworking, kbk-refactor-varargs
04:12
Eliminate the 'isBoolean' instruction in favour of using the type checking machinery check-in: 0718166269 user: kbk tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to quadcode/duchain.tcl. 

424
425
426
427
428
429
430
431
432
433
434
435
436
437
438

	if {[lindex $opd 0] in {"var" "temp"}} {
	    my addUse $opd $b
	}
    }

    set bb [lindex $bbcontent $b]
    lset bbcontent $b {}
    lset bbcontent $b [linsert $bb[unset -nocomplain bb] $pc $q]
    return
}
 
# quadcode::transformer method audit-duchain --
#
#	Makes sure that the 'duchain' dictionary matches the actual uses
#	of variables in the quadcode







|








424
425
426
427
428
429
430
431
432
433
434
435
436
437
438

	if {[lindex $opd 0] in {"var" "temp"}} {
	    my addUse $opd $b
	}
    }

    set bb [lindex $bbcontent $b]
    lset bbcontent $b {}
    lset bbcontent $b [linsert $bb[set bb {}] $pc $q]
    return
}
 
# quadcode::transformer method audit-duchain --
#
#	Makes sure that the 'duchain' dictionary matches the actual uses
#	of variables in the quadcode

Changes to quadcode/invoke.tcl. 

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
..
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
...
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
...
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
...
224
225
226
227
228
229
230









231
232
233
234
235
236
237
238
239


    # 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



    # 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 argl \
	pc0 cfin invars retval cfout outvars errexit normexit

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

................................................................................
    set pc $pc_

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

    # Take apart the invocation

    set argl [lassign $q op cfo_invoke cfi_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 {$cfi_invoke ne "Nothing"} {
	set qb [lindex $bb [expr {$pc-1}]]
	if {[lindex $qb 0] eq "moveToCallFrame"} {
	    if {[lindex $qb 1] ne $cfi_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"
		}
................................................................................
	    }
	    set pc0 [expr {$pc-1}]
	}
    }

    # Find the result value

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

    # Find the output callframe

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

    # Find the output variables
................................................................................
    } else {
	error "cannot analyze: basic block does not end with a jump"
    }
	
    return
}
 


























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

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










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

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



























# 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 pc0 --
#
#	Returns the starting program counter for an invocation sequence

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










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

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









>
>
>












|







 







|









|


|







 







|



|








|



|







 







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







>
>
>
>
>
>
>
>
>








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







 







>
>
>
>
>
>
>
>
>









>

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
..
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
...
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
...
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
...
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

    # 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.
    }

................................................................................
    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"
		}
................................................................................
	    }
	    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
................................................................................
    } 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 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/narrow.tcl. 

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
..
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
...
116
117
118
119
120
121
122
123





124
125
126
127
128
129
130
...
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

#	Inserts narrowing operations in the quadcode.
#
# Results:
#	None.
#
# Preconditions:
#
#	The program must be in SSA form, and the DJ graph (bbidom, bbkids,
#	bbnlevels, bblevel) must be accurate. ud- and du-chains must be
#	present.
#
# Side effects:
#
#	Wherever a conditional branch tests the data type or existence of
#	a value, narrowing instructions are inserted in the quadcode to
#	mark that the value is of the required type.
#
#	The ud- and du-chains are updated as the narrowing instructions
#	are inserted, and phi instructions for the controlled variables
#	are inserted on the iterated dominance frontier. The phi's may
#	turn out to be useless, in which case a subsequent 'uselessphis'
#	pass will clean them up.
#
# All of the operations introduced in this pass consist of introducing
# new quads of the form
#	v2 := some_narrowing_operation(v1)
# where v2 is a new variable instance, followed by fixup to the SSA diagram.



oo::define quadcode::transformer method narrow {} {
    upvar #0 quadcode::dataType::IMPURE IMPURE

    my debug-narrow {
	puts "before inserting narrowing operations:"
	my dump-bb
................................................................................
		    set falseBranch [lindex $bb end 1 1]
		} else {
		    set falseBranch [lindex $q 1 1]
		    set trueBranch [lindex $bb end 1 1]
		}

		# These operations may narrow if the defining instruction
		# is 'exists' or 'instanceOf'

		# The assignment appears at 'dpc' within basic block 'dbb'
		# and consists of the quadcode statement 'dquad'.





		lassign [my findDef [lindex $q 2]] 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
			my insertQuad $trueBranch 0 \
			    [list extractArray $dvar $dvar]
			my insertQuad $falseBranch 0 \
			    [list extractScalar $dvar $dvar]
			my narrow_repairSSA $dvar $trueBranch $falseBranch





		    }
		    exists {
			set dvar [lindex $dquad 2]
			if {[lindex $dvar 0] ni {var temp}} continue
			my insertQuad $trueBranch 0 \
			    [list extractExists $dvar $dvar]
			my insertQuad $falseBranch 0 \
			    [list unset $dvar]
			my narrow_repairSSA $dvar $trueBranch $falseBranch





		    }

		    instanceOf {
			set typecode [lindex $dquad 0 1]
			set typename [lindex $dquad 0 2]
			set dvar [lindex $dquad 2]
			if {[lindex $dvar 0] ni {var temp}} continue
................................................................................
			set notname [nameOfType $nottype]
			my insertQuad $trueBranch 0 \
			    [list [list narrowToType $typecode $typename] \
				 $dvar $dvar]
			my insertQuad $falseBranch 0 \
			    [list [list narrowToType $nottype $notname] \
				 $dvar $dvar]
			my narrow_repairSSA $dvar $trueBranch $falseBranch





		    }
		}
	    }

	    jumpMaybe {
		set okBranch [lindex $bb end 1 1]
		set failBranch [lindex $q 1 1]
................................................................................
		my debug-narrow {
		    puts "  $bbindex:end-1: $q"
		    puts "  $okBranch:0: [list copy $var $var]"
		    puts "  $failBranch:0: [list extractFail $var $var]"
		}
		my insertQuad $okBranch 0 [list copy $var $var]
		my insertQuad $failBranch 0 [list extractFail $var $var]
		my narrow_repairSSA $var $okBranch $failBranch
	    }
	}
    }
    my debug-narrow {
	puts "after inserting narrowing operations:"
	my dump-bb
    }

}
 
# quadcode::transformer method narrow_repairSSA --
#
#	Repairs the SSA property after introducing a narrowing operation
#	on a variable.
#
# Parameters:
#	v - Variable that has been narrowed and now has duplicate assignments
#	b1 - First block containing a new assignment to v
#	b2 - Second block containing a new assignment to v
#
# Results:
#	None.
#
# Side effects:
#	The SSA property is restored by giving new names to the assignments to
#	$v, and updating the uses, possibly introducing new phi operations.

oo::define quadcode::transformer method narrow_repairSSA {v b1 b2} {
    set d [dict create [dict get $udchain $v] 1]
    dict incr d $b1
    dict incr d $b2

    my repairSSAVariable $v $d
}
 
# quadcode::transformer method cleanupNarrow --
#
#	Removes narrowing instructions that are no longer relevant
#
# Preconditions:
#	The 'narrow' pass must have run to insert narrowing instructions,







|
|
|







<
<
<
<
<
<


|
<
>
>







 







|



>
>
>
>
>
|
>
>











|
>
>
>
>
>








|
>
>
>
>
>







 







|
>
>
>
>
>







 







<









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








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
..
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
...
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
...
150
151
152
153
154
155
156

157
158
159
160
161
162
163
164
165

























166
167
168
169
170
171
172

#	Inserts narrowing operations in the quadcode.
#
# Results:
#	None.
#
# Preconditions:
#
#	The program must be deconstructed from SSA form. ud- and du-chains
#	must reflect the state of the program before deconstruction. One
#	round of copy propagation must have been done.
#
# Side effects:
#
#	Wherever a conditional branch tests the data type or existence of
#	a value, narrowing instructions are inserted in the quadcode to
#	mark that the value is of the required type.
#






# All of the operations introduced in this pass consist of introducing
# new quads of the form
#	v := some_narrowing_operation(v)

# where v is the value being tested (possibly indirectly) by the conditional
# jump. 

oo::define quadcode::transformer method narrow {} {
    upvar #0 quadcode::dataType::IMPURE IMPURE

    my debug-narrow {
	puts "before inserting narrowing operations:"
	my dump-bb
................................................................................
		    set falseBranch [lindex $bb end 1 1]
		} else {
		    set falseBranch [lindex $q 1 1]
		    set trueBranch [lindex $bb end 1 1]
		}

		# These operations may narrow if the defining instruction
		# is 'arrayExists', 'exists' or 'instanceOf'

		# The assignment appears at 'dpc' within basic block 'dbb'
		# 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
			my insertQuad $trueBranch 0 \
			    [list extractArray $dvar $dvar]
			my insertQuad $falseBranch 0 \
			    [list extractScalar $dvar $dvar]
			my debug-narrow {
			    puts "$trueBranch:0:\
                                  [lindex $bbcontent $trueBranch 0]"
			    puts "$falseBranch:0:\
                                  [lindex $bbcontent $falseBranch 0]"
			}
		    }
		    exists {
			set dvar [lindex $dquad 2]
			if {[lindex $dvar 0] ni {var temp}} continue
			my insertQuad $trueBranch 0 \
			    [list extractExists $dvar $dvar]
			my insertQuad $falseBranch 0 \
			    [list unset $dvar]
			my debug-narrow {
			    puts "$trueBranch:0:\
                                  [lindex $bbcontent $trueBranch 0]"
			    puts "$falseBranch:0:\
                                  [lindex $bbcontent $falseBranch 0]"
			}
		    }

		    instanceOf {
			set typecode [lindex $dquad 0 1]
			set typename [lindex $dquad 0 2]
			set dvar [lindex $dquad 2]
			if {[lindex $dvar 0] ni {var temp}} continue
................................................................................
			set notname [nameOfType $nottype]
			my insertQuad $trueBranch 0 \
			    [list [list narrowToType $typecode $typename] \
				 $dvar $dvar]
			my insertQuad $falseBranch 0 \
			    [list [list narrowToType $nottype $notname] \
				 $dvar $dvar]
			my debug-narrow {
			    puts "$trueBranch:0:\
                                  [lindex $bbcontent $trueBranch 0]"
			    puts "$falseBranch:0:\
                                  [lindex $bbcontent $falseBranch 0]"
			}
		    }
		}
	    }

	    jumpMaybe {
		set okBranch [lindex $bb end 1 1]
		set failBranch [lindex $q 1 1]
................................................................................
		my debug-narrow {
		    puts "  $bbindex:end-1: $q"
		    puts "  $okBranch:0: [list copy $var $var]"
		    puts "  $failBranch:0: [list extractFail $var $var]"
		}
		my insertQuad $okBranch 0 [list copy $var $var]
		my insertQuad $failBranch 0 [list extractFail $var $var]

	    }
	}
    }
    my debug-narrow {
	puts "after inserting narrowing operations:"
	my dump-bb
    }

}

























 
# quadcode::transformer method cleanupNarrow --
#
#	Removes narrowing instructions that are no longer relevant
#
# Preconditions:
#	The 'narrow' pass must have run to insert narrowing instructions,

Changes to quadcode/transformer.tcl. 

324
325
326
327
328
329
330

331



332



333
334
335
336
337
338
339
...
764
765
766
767
768
769
770

771
772
773
774
775
776
777

	    copyprop
	    fqcmd
	    varargs
	    deadbb
	    bbidom
	    bblevel
	    rewriteParamChecks

	    narrow



	} {



	    lappend timings $pass [lindex [time [list my $pass]] 0]
	    my debug-audit {
		my audit-duchain $pass
		my audit-phis $pass
	    }
	}
	my debug-timings {
................................................................................
# types comes first - other modules' initialization can depend on it

source [file join $quadcode::libdir types.tcl]

source [file join $quadcode::libdir abbreviate.tcl]
source [file join $quadcode::libdir aliases.tcl]
source [file join $quadcode::libdir bb.tcl]

source [file join $quadcode::libdir bytecode.tcl]
source [file join $quadcode::libdir callframe.tcl]
source [file join $quadcode::libdir constfold.tcl]
source [file join $quadcode::libdir constjump.tcl]
source [file join $quadcode::libdir copyprop.tcl]
source [file join $quadcode::libdir dbginfo.tcl]
source [file join $quadcode::libdir deadcode.tcl]







>

>
>
>

>
>
>







 







>








324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
...
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785

	    copyprop
	    fqcmd
	    varargs
	    deadbb
	    bbidom
	    bblevel
	    rewriteParamChecks
	    deconstructSSA
	    narrow
	    ssa
	    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 {
................................................................................
# types comes first - other modules' initialization can depend on it

source [file join $quadcode::libdir types.tcl]

source [file join $quadcode::libdir abbreviate.tcl]
source [file join $quadcode::libdir aliases.tcl]
source [file join $quadcode::libdir bb.tcl]
source [file join $quadcode::libdir builder.tcl]
source [file join $quadcode::libdir bytecode.tcl]
source [file join $quadcode::libdir callframe.tcl]
source [file join $quadcode::libdir constfold.tcl]
source [file join $quadcode::libdir constjump.tcl]
source [file join $quadcode::libdir copyprop.tcl]
source [file join $quadcode::libdir dbginfo.tcl]
source [file join $quadcode::libdir deadcode.tcl]

Changes to quadcode/varargs.tcl. 

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
..
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
...
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
...
330
331
332
333
334
335
336
337
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
398
399
400
401
402
403
404
405
406
407
408
409
410
411
...
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
...
459
460
461
462
463
464
465


466
467
468
469
470
471
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
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
...
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
728
729
730
731
732
...
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
...
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
...
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
...
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
...
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
...
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
...
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
....
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028

        set pc -1
        foreach q $bb {
            incr pc

            # At this point in optimization, all invokes are part of a
            # sequence that is followed within a few instructions by a
            # jumpMaybe, so there can never be more than one in a basic
            # block. Since rewriting invocations can peform major surgery
            # on the program, simply call out to the appropriate handling
            # routine and 'break' to the next basic block.

            switch -exact [lindex $q 0] {
                "invoke" - "invokeExpanded" {
                    my debug-varargs {
                        puts "varargs: examine $b:$pc: $q"
                    }
                    my varargsRewriteInvoke $b $pc $q
                    break
                }
            }
        }
    }

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

}
 
# quadcode::transformer method varargsRewriteInvoke --
#
#       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.
#
# Parameters:
#       b - Basic block number
................................................................................
#
# Results:
#	None.
#
# Side effects:
#	Rewrites the instruction and 'expand' instructions that it
#       uses. Updates ud- and du-chains.
#
# We actually have to work on a whole code burst here. What we need to
# consider is a sequence like
#
# (may be omitted) moveToCallFrame cf1 cf0 name0 var0 name1 var1 ...
#                  invokeExpanded res0 cf1 command args...
# (may be omitted) retrieveResult res1 res0
# (may be omitted) extractCallframe cf2 res0
# (zero or more)   moveFromCallFrame var cf2 name
#                  jumpMaybe catchHandler res1
#                  jump normalReturn
#
# The reason is that there is a considerable amount of logic in
# optimization and code generation that isn't prepared to have
# a moveFromCallFrame's callframe argument be the result of a phi.
# (There are places where the optimizer needs to track moveFromCallFrame
# back to a unique 'invoke' or other callframe-altering operation).
#
# What we want the result to look like:
#
#    (... code to unpack arguments. Normal exit is bbNormal. Wrong
#    number of args exit is bbWrong.)
#
# bbNormal:
#    moveToCallFrame cf3 cf0 name0 var0 name1 var1 ...
#    invoke res2 cf3 command args ...
#    retrieveResult res3 res2
#    extractCallframe cf4 res3
#    moveFromCallFrame var' cf4 name (zero or more)
#    jumpMaybe bb0 res3
#    jump bb1
#
# bbWrong:
#    (no need for moveToCallFrame)
#    invokeExpanded res4 Nothing command originalArgs...
#    (no need for callframe manipulation)
#    jumpMaybe bb0 res4
#    jump bb1 (this jump is never taken, the 'invokeExpanded' always errors
#	       out in this case).
#
# bb0:
#    cf2* = phi(cf4 [bbNormal], cf0 [bbWrong])
#    res1* = phi(res3 [bbNormal], res4 [bbWrong])
#    zero or more:
#      var* = phi(var' [bbnormal], var' reaching def [bbWrong])
#    jump catchHandler
#
# bb1:
#    cf2** = phi(cf4 [bbNormal], cf0 [bbWrong])
#    res1** = phi(res3 [bbNormal], res4 [bbWrong])
#    zero or more:
#      var** = phi(var' [bbnormal], var' reaching def [bbWrong])
#    jump normalReturn
#
# Then, cf2*/cf2**, res1*/res1** and all instances of var*/var** become and
# are treated as duplicate definitions for repairSSAVariable.
#
# Note that the reaching definition of each variable in 'moveFromCallFrame'
# is easily obtained, because it has to be in the 'moveToCallFrame' that
# precedes the 'invokeExpanded'.

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

    set newqds {}






    # Take apart the quad
    set argv [lassign $q opcode cfout cfin calleeLit]

    # We care only about 'invokeExpanded' operations where the procedure

    # name is known a priori, the expected args are known, and
    # the target procedure is compiled.

    # TODO: We also care about {*} expansion passed to non-variadic
    #       Core commands. That will give us information about
    #	their stack effects.

    if {[lindex $calleeLit 0] ne "literal"
        || [catch {
            set callee [lindex $calleeLit 1]
            info args $callee


        } arginfo]
        || ![$specializer compiling $callee]} {

        return
    }

    my debug-varargs {
        puts "[my full-name]: $b:$pc: $q"

    }

    # Analyze the codeburst that carries out the 'invokeExpanded'.
    # 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]
    trace add variable call unset [list $call destroy]
    $call analyze [self] $b $pc

    # 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 varargsUnlinkTail $b [$call pc0]]




    # Create the basic blocks for the actual invocation sequences. We make
    # them in advance to avoid backpatching.
    # Blocks 'err0b', 'norm0b', 'err1b' and 'norm1b' will be empty and are
    # present in order to split critical edges.






    set norm0b [llength $bbcontent]
    lappend bbcontent {}; lappend bbpred {}
    set err0b [llength $bbcontent]
    lappend bbcontent {}; lappend bbpred {}
    set notokb [llength $bbcontent]
    lappend bbcontent {}; lappend bbpred {}
    set norm1b [llength $bbcontent]
    lappend bbcontent {}; lappend bbpred {}
    set err1b [llength $bbcontent]
    lappend bbcontent {}; lappend bbpred {}
    set normb [llength $bbcontent]
    lappend bbcontent {}; lappend bbpred {}
    set normphis {}
    set errorb [llength $bbcontent]
    lappend bbcontent {}; lappend bbpred {}
    set errorphis {}

    # Create the first part of the 'invoke' instruction
    set invokeres [my newVarInstance $cfin]
    set newq [list invoke $invokeres $cfin $calleeLit]


    # Generate code for the 'wrong # args' case
    set notokbb {}
    set invexpres [my newVarInstance [$call retval]]
    foreach qq [my varargsEmitWrongArgs $invexpres {} Nothing $calleeLit] {
        my varargsEmitAndTrack $notokb notokbb $qq










    }
    dict set normphis [$call retval] [list bb $norm1b] $invexpres
    dict set errorphis [$call retval] [list bb $err1b] $invexpres
    dict set normphis [$call cfout] [list bb $norm1b] [$call cfin]
    dict set errorphis [$call cfout] [list bb $err1b] [$call cfin]
    my varargsEmitAndTrack $notokb notokbb \
        [list jumpMaybe [list bb $err1b] $invexpres]
    my varargsEmitAndTrack $notokb notokbb [list jump [list bb $norm1b]]
    lset bbcontent $notokb $notokbb


    # Split the critical edges
    foreach {edge target} [list $norm0b $normb $err0b $errorb \
                               $norm1b $normb $err1b $errorb] {
        set splitbb {}
        my varargsEmitAndTrack $edge splitbb [list jump [list bb $target]]
        lset bbcontent $edge $splitbb

    }




    # Now start the parameter checking logic










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

    # Start by matching off non-expanded args with parameters in the callee






    set pos 0
    while {$pos < $nPlainParams} {
        if {[my varargsNonExpandedArgument newq $arginfo $pos $q]} break
        incr pos
    }

    # Concatenate the remaining args into a list. 'listLoc' will
    # be the name of the object that holds the list.
    my debug-varargs {
        puts "varargs: $b:$pc: $q:\n\

              \    Matched leading non-expanded args.\


                   $pos of $nPlainParams plain params"

    }








    set tempIndex -1
    set listLoc [my varargsExpandFixed 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 varargsEmitAndTrack $b bb [list listLength $lenLoc1 $listLoc]
    my varargsEmitAndTrack $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
................................................................................

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

        # Make code to check length of arg list, starting a
        # new basic block
        set nMandatory [expr {$firstOptional - $firstMandatory}]
        set b [my varargsCheckEnough $b $bb $lenLoc $compTemp \
                   $nMandatory $notokb]
        set bb {}

        # Make code to transfer mandatory args
        my varargsUnpackMandatory tempIndex bb newq $b $listLoc $nMandatory
    }

    # Now we have the parameters that have default values.

    set j $nMandatory
    if {$nPlainParams > $firstOptional} {

................................................................................
        set optInfo {}
        set finishB [llength $bbcontent]
        lappend bbcontent {}
        lappend bbpred {}
        set i $firstOptional
        while {$i < $nPlainParams} {
            info default $callee [lindex $arginfo $i] defaultVal
            lassign [my varargsUnpackOptional tempIndex b bb \
                         $finishB $compTemp $listLoc $lenLoc $j] \
                fromBlock argLoc
            lappend optInfo [list $fromBlock $defaultVal $argLoc]
            incr i
            incr j
        }

        # Close out the last basic block, switch to the 'finish' block
        # and emit 'phi' instructions to get the correct parameter set
        my varargsFinishOptional b bb newq $finishB $optInfo

    }

    # If the procedure has 'args', then fill it in with the remainder of the
    # arg list.
    if {$haveargs} {
        my varargsDoArgs tempIndex $b bb newq $listLoc $j
    } else {
        my varargsCheckTooMany b bb $lenLoc $compTemp $j $notokb
    }

    # Create the normal invocation sequence.
    # 1. Create moveToCallFrame

    set cfin [$call cfin]
    set invars [$call invars]
    if {[$call pc0] < $pc} {
        set cf2 [my newVarInstance $cfin]
        set q2 [list moveToCallFrame $cf2 $cfin]
        dict for {vname val} $invars {
            lappend q2 [list literal $vname] $val
        }
        my varargsEmitAndTrack $b bb $q2
        set cfin $cf2
        lset newq 2 $cfin
    }
    
    # 2. Emit the call as rewritten
    my varargsEmitAndTrack $b bb $newq

    # 3. Make the 'retrieveResult'
    set okresult [my newVarInstance [$call retval]]
    my varargsEmitAndTrack $b bb [list retrieveResult $okresult $invokeres]
    dict set normphis [$call retval] [list bb $norm0b] $okresult
    dict set errorphis [$call retval] [list bb $err0b] $okresult

    # 4. Make the 'extractCallFrame'
    set okcf [my newVarInstance [$call cfout]]
    my varargsEmitAndTrack $b bb [list extractCallFrame $okcf $invokeres]
    dict set normphis [$call cfout] [list bb $norm0b] $okcf
    dict set errorphis [$call cfout] [list bb $err0b] $okcf

    # 5. Make 'moveFromCallFrame' for all output values
    dict for {vname outval} [$call outvars] {
        set okval [my newVarInstance $outval]
        my varargsEmitAndTrack $b bb \
            [list moveFromCallFrame $okval $okcf [list literal $vname]]
        dict set normphis $outval [list bb $norm0b] $okval
        dict set errorphis $outval [list bb $err0b] $okval
        set notokval [dict get [$call invars] $vname]
        dict set normphis $outval [list bb $norm1b] $notokval
        dict set errorphis $outval [list bb $err1b] $notokval
    }        

    # 6. Make the terminal jumps
    my varargsEmitAndTrack $b bb [list jumpMaybe [list bb $err0b] $okresult]
    my varargsEmitAndTrack $b bb [list jump [list bb $norm0b]]

    # Emit the final basic block rewrite

    lset bbcontent $b $bb

    # toRepair will have the variables that have to be fixed up by
    # repairSSAVariable after this stuff runs
................................................................................
    foreach {v sources} $normphis {
        set val 0
        if {[dict exists $toRepair $v $normb]} {
            set val [dict get $toRepair $v $normb]
        }
        incr val
        dict set toRepair $v $normb $val
        my varargsEmitAndTrack $normb normbb [list phi $v {*}$sources]
    }
    my varargsEmitAndTrack $normb normbb [list jump [list bb [$call normexit]]]
    lset bbcontent $normb $normbb

    # Make the block for the error exit
    set errorbb {}
    foreach {v sources} $errorphis {
        set val 0
        if {[dict exists $toRepair $v $errorb]} {
            set val [dict get $toRepair $v $errorb]
        }
        incr val
        dict set toRepair $v $errorb $val
        my varargsEmitAndTrack $errorb errorbb [list phi $v {*}$sources]
    }
    my varargsEmitAndTrack $errorb errorbb [list jump [list bb [$call errexit]]]
    lset bbcontent $errorb $errorbb

    # Restore dominance relationships
    my bbidom; my bblevel

    my debug-varargs {
        puts "Before repairing SSA relationships:"
................................................................................
    }

    my debug-varargs {
        puts "After repairing SSA relationships:"
        my dump-bb
    }
    


    return
}
 
# quadcode::transformer method varargsUnlinkTail --
#
#	Takes the last few instructions of a basic block and removes
#	them temporarily, unlinking the block from its successors and
#	the instructions from their ud- and du-chains.
#
# Parameters:
#	b - Number of the basic block
#	pc - Program counter of the first instruction being deleted
#
# Results:
#	Returns the partial basic block that remains
#
# Side effects:
#	Linkages are destroyed.



oo::define quadcode::transformer method varargsUnlinkTail {b pc} {
    set bb [lindex $bbcontent $b]
    set head [lrange $bb 0 [expr {$pc-1}]]
    set tail [lrange $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] {
            if {[lindex $arg 0] in {"temp" "var"}} {
                my removeUse $arg $b
            }
        }
    }
    foreach b2 [my bbsucc $b] {
        my removePred $b2 $b
    }
    
    lset bbcontent $b $head

    return $head
}
 
# quadcode::transformer method varargsNonExpandedArgument --
#
#	Transfer a leading non-expanded argument into a quad
#	under construction when rewriting 'invokeExpanded'
#
# Parameters:
#	newqVar - Name of a variable in caller's scope storing the
#	          plain 'invoke' operation under construction
#	arginfo - Result of [info args] against the invoked proc
#	pos - Position of the argument (0 = first) in the argument list
#	q - Quadruple under construction
#
# 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 \
    varargsNonExpandedArgument {newqVar arginfo pos q} {


        upvar 1 $newqVar newq

        set param [lindex $arginfo $pos]
        set arg [lindex $q [expr {4 + $pos}]]
        switch -exact -- [lindex $arg 0] {
            "literal" {
            }
            "temp" - "var" {
                lassign [my findDef $arg] defb defpc defstmt
                if {[lindex $defstmt 0] eq "expand"} {
                    return 1
                }
            }
            default {
                return 1
            }
        }
        lappend newq $arg
        return 0
    }
 
# quadcode::transformer method varargsExpandFixed --
#
#	Takes the non-fixed-position arguments of 'invokeExpanded'
#	and emits code to make them into a list.
#
# Parameters:
#	bbVar - Variable in caller holding the basic block under construction
#	tempIdxVar - Variable in caller holding the number of the last
#	             temporary allocated.
#	posVar - Position in the parameter list where the list construction
#	         should begin.
#	b - Basic block number of the block under construction
#	q - 'invokeExpanded' instruction being deconstructed
#
# Results:
#
#	Returns the name of a variable, temporary or literal that holds the
#	expanded list.

oo::define quadcode::transformer method \
    varargsExpandFixed {bbVar tempIdxVar posVar b q} {

        upvar 1 $bbVar bb $tempIdxVar tempIndex $posVar pos

        set listTemp [list temp [incr tempIndex]]

        # Handle the first arg. Since 'invokeExpanded' always
        # has at least one expanded arg, there has to be a first
        # arg.


        if {4 + $pos >= [llength $q]} {
            set listLoc "literal {}"
        } else {
            set arg [lindex $q [expr {4 + $pos}]]
            switch -exact -- [lindex $arg 0] {
                "literal" {
                    set listLoc [my newVarInstance $listTemp]

                    my varargsEmitAndTrack $b bb [list list $listLoc $arg]

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

                    } else {
                        set listLoc [my newVarInstance $listTemp]

                        my varargsEmitAndTrack $b bb [list list $listLoc $arg]

                    }
                }
            }
        }







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

        foreach arg [lrange $q [expr {5 + $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.
            # This can't fail, $listTemp is known to be a list
            set nloc [my newVarInstance $listTemp]
            my varargsEmitAndTrack $b bb [list $op $nloc $listLoc $arg]



















            # extract the result from the Maybe
            set listLoc [my newVarInstance $listTemp]

            my varargsEmitAndTrack $b bb [list extractMaybe $listLoc $nloc]
        }

        return $listLoc
    }
 
# quadcode::transformer method varargsCheckEnough --
#
#	Emits code to check for too few args passed to invokeExpanded
#
# Parameters:
#	b - Basic block number under construction
#	bb - Instructions in the block
#	lenLoc - Location holding the length of the arg list
................................................................................
#	compTemp - Temporary variable name to use for comparison
#	nMandatory - Number of mandatory args still unpaired
#	errorB - Basic block to jump to if too few args
#
# Results:
#	Returns the new basic block number; this method ends the block.

oo::define quadcode::transformer method varargsCheckEnough {b bb lenLoc compTemp
                                                            nMandatory errorB} {
    # Emit {$nMandatory > $lenLoc}
    set compLoc [my newVarInstance $compTemp]
    my varargsEmitAndTrack $b bb \
        [list gt $compLoc [list literal $nMandatory] $lenLoc]

    # Emit jumpTrue to the error block. This has to go through an
    # intermediate block because it will be a critical edge otherwise.
    # Emit jump to the following block
    set intb [llength $bbcontent]
    lappend bbcontent {}
    lappend bbpred {}
    set newb [llength $bbcontent]
    lappend bbcontent {}
    lappend bbpred {}

    my varargsEmitAndTrack $b bb [list jumpTrue [list bb $intb] $compLoc]
    my varargsEmitAndTrack $b bb [list jump [list bb $newb]]

    lset bbcontent $b $bb
    set bb {}

    # Emit the intermediate jump
    my varargsEmitAndTrack $intb bb [list jump [list bb $errorB]]
    lset bbcontent $intb $bb
    set bb {}

    return $newb
}
 
# quadcode::transformer method varargsUnpackMandatory --
#
#	Unpacks the mandatory args to a proc from the list created
#	by argument expansion
#
# Parameters;
#	tempIdxVar - Variable in caller's scope containing the last
#	             allocated temporary
................................................................................
#
# Results:
#	None.
#
# Side effects:
#	Emits code to unpack the mandatory parameters

oo::define quadcode::transformer method varargsUnpackMandatory {tempIdxVar
                                                                bbVar newqVar
                                                                b listLoc
                                                                nMandatory} {
    upvar 1 $tempIdxVar tempIdx $bbVar bb $newqVar newq

    for {set i 0} {$i < $nMandatory} {incr i} {

        # Emit the 'listIndex' instruction for one arg. It can't fail
        # because we know we have a list

        set argTemp [list temp [incr tempIdx]]
        set argLoc [my newVarInstance $argTemp]
        my varargsEmitAndTrack $b bb \
            [list listIndex $argLoc $listLoc [list literal $i]]

        # Emit the 'extractMaybe' to get the arg from the Maybe
        # result of 'listIndex'
        set argLoc2 [my newVarInstance $argTemp]
        my varargsEmitAndTrack $b bb [list extractMaybe $argLoc2 $argLoc]

        # Put the extracted arg on the 'invoke' instruction
        lappend newq $argLoc2
    }
}
 
# quadcode::transformer method varargsUnpackOptional --
#
#	Emits code to unpack one optional parameter in an invokeExpanded
#
# Parameters:
#	tempIdxVar - Variable holding the index of the last used temporary
#	bVar - Variable holding the current basic block number
#	bbVar - Variable holding the content of the basic block under
................................................................................
#	to the finish if the parameter is not supplied and the
#	location of a temporary holding the unpacked value if it is.
#
# Side effects:
#	Emits code to unpack one value, or jump to the finish block if
#	there is nothing to unpack.

oo::define quadcode::transformer method varargsUnpackOptional {tempIdxVar bVar
                                                               bbVar finishB
                                                               compTemp listLoc
                                                               lenLoc j} {
    upvar 1 $tempIdxVar tempIndex $bVar b $bbVar bb

    set pos [list literal $j]
    set compLoc [my newVarInstance $compTemp]
    set argTemp [list temp [incr tempIndex]]
    set argLoc1 [my newVarInstance $argTemp]
    set argLoc2 [my newVarInstance $argTemp]

    # Emit the list length comparison
    my varargsEmitAndTrack $b bb [list ge $compLoc $pos $lenLoc]

    # Emit the jump to the finish block We need to make an intermediate block
    # because otherwise the flowgraph edge would be critical
    set intb [llength $bbcontent]
    lappend bbcontent {}
    lappend bbpred {}
    my varargsEmitAndTrack $b bb [list jumpTrue [list bb $intb] $compLoc]

    # Create the next block and jump to it
    set newb [llength $bbcontent]
    lappend bbcontent {}
    lappend bbpred {}
    my varargsEmitAndTrack $b bb [list jump [list bb $newb]]
    lset bbcontent $b $bb

    # Make the intermediate block
    set b $intb
    set bb {}
    my varargsEmitAndTrack $b bb [list jump [list bb $finishB]]
    lset bbcontent $b $bb

    # Advance to the new block

    set b $newb
    set bb {}

    # Emit the 'listIndex' to unpack the arg
    my varargsEmitAndTrack $b bb [list listIndex $argLoc1 $listLoc $pos]

    # Emit the 'extractMaybe' on the 'listIndex' result
    my varargsEmitAndTrack $b bb [list extractMaybe $argLoc2 $argLoc1]

    # Return the place where we stored the arg
    return [list $intb $argLoc2]

}
 
# quadcode::transformer method varargsFinishOptional --
#
#	Finish transmitting the args that have default values when
#	compiling {*}
#
# Parameters:
#	bVar - Variable in caller holding the current basic block number
#	bbVar - Variable in caller's scope holding basic block content
................................................................................
#
# Side effects:
#	Closes out the current basic block, opens the finish block,
#	and emits phi instructions into the finish block. Adds the
#	outputs of the phi instructions to the 'invoke' instruction
#	under construction.

oo::define quadcode::transformer method varargsFinishOptional {bVar bbVar
                                                               newqVar finishB
                                                               optInfo} {

    upvar 1 $bVar b $bbVar bb $newqVar newq

    # Finish the current block and start building into 'finishB'

    my varargsEmitAndTrack $b bb [list jump [list bb $finishB]]
    lset bbcontent $b $bb
    set bb {}
    set fromb $b
    set b $finishB

    # Emit the phi instructions

................................................................................
            if {$k >= $n} {
                lappend q $tempLoc
            } else {
                lappend q $defaultLit
            }
        }
        lappend q [list bb $fromb] $tempLoc
        my varargsEmitAndTrack $b bb $q
        lappend newq $newTemp
    }
}

# quadcode::transformer method varargsDoArgs --
#
#	Emits code to extract the parameter sequence needed to fill '$args'
#	from the parameter list.
#
# Parameters:
#	tempIdxVar - Variable containing the last temporary index used
#	b - basic block number under construction
................................................................................
# Results:
#	None.
#
# Side effects:
#	Emits any code necessary to fill in 'args', and adds the resulting
#	variable onto the end of the new instruction.

oo::define quadcode::transformer method varargsDoArgs {tempIdxVar b bbVar
                                                       newqVar listLoc i} {

    upvar 1 $tempIdxVar tempIndex $bbVar bb $newqVar newq

    if {$i == 0} {
        lappend newq $listLoc
    } else {
        set argsTemp [list temp [incr tempIndex]]
        set argsLoc1 [my newVarInstance $argsTemp]
        my varargsEmitAndTrack $b bb [list listRange $argsLoc1 $listLoc \
                                   [list literal $i] [list literal end]]
        set argsLoc2 [my newVarInstance $argsTemp]
        my varargsEmitAndTrack $b bb [list extractMaybe $argsLoc2 $argsLoc1]
        lappend newq $argsLoc2
    }
}
 
# quadcode::transformer method varargsCheckTooMany --
#
#	Emits a codeburst to check whether an 'invokeExpanded' has
#	too many args
#
# Parameters:
#	bVar - Variable holding the basic block number
#	bbVar - Variable holding the content of the current basic block
................................................................................
#
# Results:
#	None
#
# Side effects:
#	Emits code and closes the basic block

oo::define quadcode::transformer method varargsCheckTooMany {bVar bbVar lenLoc
                                                             compTemp i
                                                             errorB} {

    upvar 1 $bVar b $bbVar bb


    set compLoc [my newVarInstance $compTemp]
    my varargsEmitAndTrack $b bb [list gt $compLoc $lenLoc [list literal $i]]

    set intb [llength $bbcontent]
    lappend bbcontent {}
    lappend bbpred {}
    my varargsEmitAndTrack $b bb [list jumpTrue [list bb $intb] $compLoc]

    set newb [llength $bbcontent]
    lappend bbcontent {}
    lappend bbpred {}
    my varargsEmitAndTrack $b bb [list jump [list bb $newb]]
    lset bbcontent $b $bb

    set b $intb
    set bb {}
    my varargsEmitAndTrack $b bb [list jump [list bb $errorB]]
    lset bbcontent $b $bb

    set b $newb
    set bb {}

}
 
# quadcode::transformer method varargsEmitWrongArgs --
#
#	Generates code to throw the 'wrong # args' error when needed
#
# Parameters:
#	result - Quadcode value that will hold the command result
#	cfout - Quadcode value that will hold the result callframe,
#	        or {} if no callframe need be produced
................................................................................
#
# Results:
#	None.
#
# Side effects:
#	Returns a codeburst that throws the exception

oo::define quadcode::transformer method varargsEmitWrongArgs {result cfout 
                                                              cfin cmd} {

    set burst {}
    if {$cfin ne "Nothing"} {
        lappend burst [list copy $cfout $cfin]
    }

................................................................................
    lappend burst $q
    set q [list extractFail $result $intres]
    lappend burst $q
    return $burst

}
 
# quadcode::transformer method varargsEmitAndTrack --
#
#	Emits a quadcode instruction and tracks its effects
#
# Parameters:
#	b - Basic block number
#	bbVar - Variable containing the basic block content
#	q - Quadcode instruction to emit
................................................................................
# Results:
#	None.
#
# Side effects:
#	Instruction is added to the basic block, and linked in ud- and du-chains
#	Basic block is linked in control flow if needed.

oo::define quadcode::transformer method varargsEmitAndTrack {b bbVar q} {

    upvar 1 $bbVar bb

    set res [lindex $q 1]
    switch -exact -- [lindex $res 0] {
        "bb" {
            my bblink $b [lindex $res 1]







|
<
<
<





|













|







 







|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|

<
>
>
>
>
>

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


>


<
<
<
<
<
<
<
<
<




>
>

<
>
>
>

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

>
>
>
>
>
>







<
<
>
>
>
>
>


|



<
<

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

|






|
|







 







|




|







 







|









|






|

|













|





|



|





|






|









|
|







 







|

|











|

|







 







>
>



|

|
|
<






|


|
>
>

|

<

>













<
<
<
|


|









|





|
|
>

|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|

|





|
|
|
<
<
<
<






|
<

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

>
>
>
>
|
|

|




|




|

|






|
<
|

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

<
>
|





|







 







|



|












|
|





|






|







 







|












|





|






|







 







|












|






|





|





|








|


|






|







 







|







|







 







|




|







 







|









|


|




|







 







|







|




|




|




|







|







 







|







 







|







 







|








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
..
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
...
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
...
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
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
...
337
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
...
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395

396
397
398
399
400
401
402
403
404
405
406
407
408
409
410

411
412
413
414
415
416
417
418
419
420
421
422
423
424
425



426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
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
...
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
...
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
...
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
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
...
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
...
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
...
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
...
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
...
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
...
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
...
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967

        set pc -1
        foreach q $bb {
            incr pc

            # At this point in optimization, all invokes are part of a
            # sequence that is followed within a few instructions by a
            # jumpMaybe, so there can never be more than one in a basic
            # block.



            switch -exact [lindex $q 0] {
                "invoke" - "invokeExpanded" {
                    my debug-varargs {
                        puts "varargs: examine $b:$pc: $q"
                    }
                    my va_RewriteInvoke $b $pc $q
                    break
                }
            }
        }
    }

    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.
#
# Parameters:
#       b - Basic block number
................................................................................
#
# Results:
#	None.
#
# 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
................................................................................

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

        # Make code to check length of arg list, starting a
        # new basic block
        set nMandatory [expr {$firstOptional - $firstMandatory}]
        set b [my va_CheckEnough $b $bb $lenLoc $compTemp \
                   $nMandatory $notokb]
        set bb {}

        # Make code to transfer mandatory args
        my va_UnpackMandatory tempIndex bb newq $b $listLoc $nMandatory
    }

    # Now we have the parameters that have default values.

    set j $nMandatory
    if {$nPlainParams > $firstOptional} {

................................................................................
        set optInfo {}
        set finishB [llength $bbcontent]
        lappend bbcontent {}
        lappend bbpred {}
        set i $firstOptional
        while {$i < $nPlainParams} {
            info default $callee [lindex $arginfo $i] defaultVal
            lassign [my va_UnpackOptional tempIndex b bb \
                         $finishB $compTemp $listLoc $lenLoc $j] \
                fromBlock argLoc
            lappend optInfo [list $fromBlock $defaultVal $argLoc]
            incr i
            incr j
        }

        # Close out the last basic block, switch to the 'finish' block
        # and emit 'phi' instructions to get the correct parameter set
        my va_FinishOptional b bb newq $finishB $optInfo

    }

    # If the procedure has 'args', then fill it in with the remainder of the
    # arg list.
    if {$haveargs} {
        my va_DoArgs tempIndex $b bb newq $listLoc $j
    } else {
        my va_CheckTooMany b bb $lenLoc $compTemp $j $notokb
    }

    # Create the normal invocation sequence.
    # 1. Create moveToCallFrame

    set cfin [$call cfin]
    set invars [$call invars]
    if {[$call pc0] < $pc} {
        set cf2 [my newVarInstance $cfin]
        set q2 [list moveToCallFrame $cf2 $cfin]
        dict for {vname val} $invars {
            lappend q2 [list literal $vname] $val
        }
        my va_EmitAndTrack $b bb $q2
        set cfin $cf2
        lset newq 2 $cfin
    }
    
    # 2. Emit the call as rewritten
    my va_EmitAndTrack $b bb $newq

    # 3. Make the 'retrieveResult'
    set okresult [my newVarInstance [$call retval]]
    my va_EmitAndTrack $b bb [list retrieveResult $okresult $invokeres]
    dict set normphis [$call retval] [list bb $norm0b] $okresult
    dict set errorphis [$call retval] [list bb $err0b] $okresult

    # 4. Make the 'extractCallFrame'
    set okcf [my newVarInstance [$call cfout]]
    my va_EmitAndTrack $b bb [list extractCallFrame $okcf $invokeres]
    dict set normphis [$call cfout] [list bb $norm0b] $okcf
    dict set errorphis [$call cfout] [list bb $err0b] $okcf

    # 5. Make 'moveFromCallFrame' for all output values
    dict for {vname outval} [$call outvars] {
        set okval [my newVarInstance $outval]
        my va_EmitAndTrack $b bb \
            [list moveFromCallFrame $okval $okcf [list literal $vname]]
        dict set normphis $outval [list bb $norm0b] $okval
        dict set errorphis $outval [list bb $err0b] $okval
        set notokval [dict get [$call invars] $vname]
        dict set normphis $outval [list bb $norm1b] $notokval
        dict set errorphis $outval [list bb $err1b] $notokval
    }        

    # 6. Make the terminal jumps
    my va_EmitAndTrack $b bb [list jumpMaybe [list bb $err0b] $okresult]
    my va_EmitAndTrack $b bb [list jump [list bb $norm0b]]

    # Emit the final basic block rewrite

    lset bbcontent $b $bb

    # toRepair will have the variables that have to be fixed up by
    # repairSSAVariable after this stuff runs
................................................................................
    foreach {v sources} $normphis {
        set val 0
        if {[dict exists $toRepair $v $normb]} {
            set val [dict get $toRepair $v $normb]
        }
        incr val
        dict set toRepair $v $normb $val
        my va_EmitAndTrack $normb normbb [list phi $v {*}$sources]
    }
    my va_EmitAndTrack $normb normbb [list jump [list bb [$call normexit]]]
    lset bbcontent $normb $normbb

    # Make the block for the error exit
    set errorbb {}
    foreach {v sources} $errorphis {
        set val 0
        if {[dict exists $toRepair $v $errorb]} {
            set val [dict get $toRepair $v $errorb]
        }
        incr val
        dict set toRepair $v $errorb $val
        my va_EmitAndTrack $errorb errorbb [list phi $v {*}$sources]
    }
    my va_EmitAndTrack $errorb errorbb [list jump [list bb [$call errexit]]]
    lset bbcontent $errorb $errorbb

    # Restore dominance relationships
    my bbidom; my bblevel

    my debug-varargs {
        puts "Before repairing SSA relationships:"
................................................................................
    }

    my debug-varargs {
        puts "After repairing SSA relationships:"
        my dump-bb
    }
    
    $call destroy

    return
}
 
# quadcode::transformer method va_UnlinkTail --
#
#	Removes the invocation sequence from a basic block in preparation
#	for rewriting it.

#
# Parameters:
#	b - Number of the basic block
#	pc - Program counter of the first instruction being deleted
#
# Results:
#	Returns the partial basic block that remains.
#
# 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] {
            if {[lindex $arg 0] in {"temp" "var"}} {
                my removeUse $arg $b
            }
        }
    }
    foreach b2 [my bbsucc $b] {
        my removePred $b2 $b
    }



    return $bb
}
 
# quadcode::transformer method va_NonExpandedArgument --
#
#	Transfer a leading non-expanded argument into a quad
#	under construction when rewriting 'invokeExpanded'
#
# Parameters:
#	newqVar - Name of a variable in caller's scope storing the
#	          plain 'invoke' operation under construction
#	arginfo - Result of [info args] against the invoked proc
#	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
            }
        }
        default {
            return 1
        }
    }
    lappend newq $arg
    return 0
}
 
# quadcode::transformer method va_MakeArgList --
#
#	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
#	bb - Instructions in the block
#	lenLoc - Location holding the length of the arg list
................................................................................
#	compTemp - Temporary variable name to use for comparison
#	nMandatory - Number of mandatory args still unpaired
#	errorB - Basic block to jump to if too few args
#
# Results:
#	Returns the new basic block number; this method ends the block.

oo::define quadcode::transformer method va_CheckEnough {b bb lenLoc compTemp
                                                            nMandatory errorB} {
    # Emit {$nMandatory > $lenLoc}
    set compLoc [my newVarInstance $compTemp]
    my va_EmitAndTrack $b bb \
        [list gt $compLoc [list literal $nMandatory] $lenLoc]

    # Emit jumpTrue to the error block. This has to go through an
    # intermediate block because it will be a critical edge otherwise.
    # Emit jump to the following block
    set intb [llength $bbcontent]
    lappend bbcontent {}
    lappend bbpred {}
    set newb [llength $bbcontent]
    lappend bbcontent {}
    lappend bbpred {}

    my va_EmitAndTrack $b bb [list jumpTrue [list bb $intb] $compLoc]
    my va_EmitAndTrack $b bb [list jump [list bb $newb]]

    lset bbcontent $b $bb
    set bb {}

    # Emit the intermediate jump
    my va_EmitAndTrack $intb bb [list jump [list bb $errorB]]
    lset bbcontent $intb $bb
    set bb {}

    return $newb
}
 
# quadcode::transformer method va_UnpackMandatory --
#
#	Unpacks the mandatory args to a proc from the list created
#	by argument expansion
#
# Parameters;
#	tempIdxVar - Variable in caller's scope containing the last
#	             allocated temporary
................................................................................
#
# Results:
#	None.
#
# Side effects:
#	Emits code to unpack the mandatory parameters

oo::define quadcode::transformer method va_UnpackMandatory {tempIdxVar
                                                                bbVar newqVar
                                                                b listLoc
                                                                nMandatory} {
    upvar 1 $tempIdxVar tempIdx $bbVar bb $newqVar newq

    for {set i 0} {$i < $nMandatory} {incr i} {

        # Emit the 'listIndex' instruction for one arg. It can't fail
        # because we know we have a list

        set argTemp [list temp [incr tempIdx]]
        set argLoc [my newVarInstance $argTemp]
        my va_EmitAndTrack $b bb \
            [list listIndex $argLoc $listLoc [list literal $i]]

        # Emit the 'extractMaybe' to get the arg from the Maybe
        # result of 'listIndex'
        set argLoc2 [my newVarInstance $argTemp]
        my va_EmitAndTrack $b bb [list extractMaybe $argLoc2 $argLoc]

        # Put the extracted arg on the 'invoke' instruction
        lappend newq $argLoc2
    }
}
 
# quadcode::transformer method va_UnpackOptional --
#
#	Emits code to unpack one optional parameter in an invokeExpanded
#
# Parameters:
#	tempIdxVar - Variable holding the index of the last used temporary
#	bVar - Variable holding the current basic block number
#	bbVar - Variable holding the content of the basic block under
................................................................................
#	to the finish if the parameter is not supplied and the
#	location of a temporary holding the unpacked value if it is.
#
# Side effects:
#	Emits code to unpack one value, or jump to the finish block if
#	there is nothing to unpack.

oo::define quadcode::transformer method va_UnpackOptional {tempIdxVar bVar
                                                               bbVar finishB
                                                               compTemp listLoc
                                                               lenLoc j} {
    upvar 1 $tempIdxVar tempIndex $bVar b $bbVar bb

    set pos [list literal $j]
    set compLoc [my newVarInstance $compTemp]
    set argTemp [list temp [incr tempIndex]]
    set argLoc1 [my newVarInstance $argTemp]
    set argLoc2 [my newVarInstance $argTemp]

    # Emit the list length comparison
    my va_EmitAndTrack $b bb [list ge $compLoc $pos $lenLoc]

    # Emit the jump to the finish block We need to make an intermediate block
    # because otherwise the flowgraph edge would be critical
    set intb [llength $bbcontent]
    lappend bbcontent {}
    lappend bbpred {}
    my va_EmitAndTrack $b bb [list jumpTrue [list bb $intb] $compLoc]

    # Create the next block and jump to it
    set newb [llength $bbcontent]
    lappend bbcontent {}
    lappend bbpred {}
    my va_EmitAndTrack $b bb [list jump [list bb $newb]]
    lset bbcontent $b $bb

    # Make the intermediate block
    set b $intb
    set bb {}
    my va_EmitAndTrack $b bb [list jump [list bb $finishB]]
    lset bbcontent $b $bb

    # Advance to the new block

    set b $newb
    set bb {}

    # Emit the 'listIndex' to unpack the arg
    my va_EmitAndTrack $b bb [list listIndex $argLoc1 $listLoc $pos]

    # Emit the 'extractMaybe' on the 'listIndex' result
    my va_EmitAndTrack $b bb [list extractMaybe $argLoc2 $argLoc1]

    # Return the place where we stored the arg
    return [list $intb $argLoc2]

}
 
# quadcode::transformer method va_FinishOptional --
#
#	Finish transmitting the args that have default values when
#	compiling {*}
#
# Parameters:
#	bVar - Variable in caller holding the current basic block number
#	bbVar - Variable in caller's scope holding basic block content
................................................................................
#
# Side effects:
#	Closes out the current basic block, opens the finish block,
#	and emits phi instructions into the finish block. Adds the
#	outputs of the phi instructions to the 'invoke' instruction
#	under construction.

oo::define quadcode::transformer method va_FinishOptional {bVar bbVar
                                                               newqVar finishB
                                                               optInfo} {

    upvar 1 $bVar b $bbVar bb $newqVar newq

    # Finish the current block and start building into 'finishB'

    my va_EmitAndTrack $b bb [list jump [list bb $finishB]]
    lset bbcontent $b $bb
    set bb {}
    set fromb $b
    set b $finishB

    # Emit the phi instructions

................................................................................
            if {$k >= $n} {
                lappend q $tempLoc
            } else {
                lappend q $defaultLit
            }
        }
        lappend q [list bb $fromb] $tempLoc
        my va_EmitAndTrack $b bb $q
        lappend newq $newTemp
    }
}

# quadcode::transformer method va_DoArgs --
#
#	Emits code to extract the parameter sequence needed to fill '$args'
#	from the parameter list.
#
# Parameters:
#	tempIdxVar - Variable containing the last temporary index used
#	b - basic block number under construction
................................................................................
# Results:
#	None.
#
# Side effects:
#	Emits any code necessary to fill in 'args', and adds the resulting
#	variable onto the end of the new instruction.

oo::define quadcode::transformer method va_DoArgs {tempIdxVar b bbVar
                                                       newqVar listLoc i} {

    upvar 1 $tempIdxVar tempIndex $bbVar bb $newqVar newq

    if {$i == 0} {
        lappend newq $listLoc
    } else {
        set argsTemp [list temp [incr tempIndex]]
        set argsLoc1 [my newVarInstance $argsTemp]
        my va_EmitAndTrack $b bb [list listRange $argsLoc1 $listLoc \
                                   [list literal $i] [list literal end]]
        set argsLoc2 [my newVarInstance $argsTemp]
        my va_EmitAndTrack $b bb [list extractMaybe $argsLoc2 $argsLoc1]
        lappend newq $argsLoc2
    }
}
 
# quadcode::transformer method va_CheckTooMany --
#
#	Emits a codeburst to check whether an 'invokeExpanded' has
#	too many args
#
# Parameters:
#	bVar - Variable holding the basic block number
#	bbVar - Variable holding the content of the current basic block
................................................................................
#
# Results:
#	None
#
# Side effects:
#	Emits code and closes the basic block

oo::define quadcode::transformer method va_CheckTooMany {bVar bbVar lenLoc
                                                             compTemp i
                                                             errorB} {

    upvar 1 $bVar b $bbVar bb


    set compLoc [my newVarInstance $compTemp]
    my va_EmitAndTrack $b bb [list gt $compLoc $lenLoc [list literal $i]]

    set intb [llength $bbcontent]
    lappend bbcontent {}
    lappend bbpred {}
    my va_EmitAndTrack $b bb [list jumpTrue [list bb $intb] $compLoc]

    set newb [llength $bbcontent]
    lappend bbcontent {}
    lappend bbpred {}
    my va_EmitAndTrack $b bb [list jump [list bb $newb]]
    lset bbcontent $b $bb

    set b $intb
    set bb {}
    my va_EmitAndTrack $b bb [list jump [list bb $errorB]]
    lset bbcontent $b $bb

    set b $newb
    set bb {}

}
 
# quadcode::transformer method va_EmitWrongArgs --
#
#	Generates code to throw the 'wrong # args' error when needed
#
# Parameters:
#	result - Quadcode value that will hold the command result
#	cfout - Quadcode value that will hold the result callframe,
#	        or {} if no callframe need be produced
................................................................................
#
# Results:
#	None.
#
# Side effects:
#	Returns a codeburst that throws the exception

oo::define quadcode::transformer method va_EmitWrongArgs {result cfout 
                                                              cfin cmd} {

    set burst {}
    if {$cfin ne "Nothing"} {
        lappend burst [list copy $cfout $cfin]
    }

................................................................................
    lappend burst $q
    set q [list extractFail $result $intres]
    lappend burst $q
    return $burst

}
 
# quadcode::transformer method va_EmitAndTrack --
#
#	Emits a quadcode instruction and tracks its effects
#
# Parameters:
#	b - Basic block number
#	bbVar - Variable containing the basic block content
#	q - Quadcode instruction to emit
................................................................................
# Results:
#	None.
#
# Side effects:
#	Instruction is added to the basic block, and linked in ud- and du-chains
#	Basic block is linked in control flow if needed.

oo::define quadcode::transformer method va_EmitAndTrack {b bbVar q} {

    upvar 1 $bbVar bb

    set res [lindex $q 1]
    switch -exact -- [lindex $res 0] {
        "bb" {
            my bblink $b [lindex $res 1]

Powered by Fossil · RSS