tclquadcode

Check-in [cd60d83f32]
Login

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

Overview
Comment:Trying to fix the resolution of commands to really happen at the right time.
Timelines: family | ancestors | fix-call-resolution
Files: files | file ages | folders
SHA3-256:cd60d83f32f66815adae7c1acce0e39451c90fa426b7f7fd3531d5643d3f305c
User & Date: dkf 2017-12-23 08:38:15
Context
2017-12-23
08:38
Trying to fix the resolution of commands to really happen at the right time. Leaf check-in: cd60d83f32 user: dkf tags: fix-call-resolution
2017-12-20
09:25
Resolution context passed to invoke. Still need to stop quadcode engine from pre-resolving (at least in error cases). check-in: 4f606de75c user: dkf tags: fix-call-resolution
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to codegen/compile.tcl.

1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
....
1258
1259
1260
1261
1262
1263
1264
1265

1266
1267

1268

1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
	set procmeta [dict get $bytecode procmeta]
	set localcache [dict get $bytecode localcache]
	lassign [$b frame.create $varmeta $argc $argv \
			[$b load $procmeta "proc.metadata"] \
			[$b load $localcache "proc.localcache"]] \
	    theframe thevarmap
	my StoreResult $tgt $theframe
	set thens [$b call dereference $theframe 0 CallFrame.nsPtr]
	return [list $theframe $thevarmap $thens $drop]
    }
 
    # TclCompiler:IssueInvoke --
    #
    #	Generate the code for invoking another Tcl command. Must only be
    #	called from the 'compile' method.
................................................................................
	# Is this a literal name for a function we already know the signature
	# of? If so, we can use a direct call. To work this out, we need to
	# resolve the command within the namespace context of the procedure.

	if {literal($origname)} {
	    # Resolve the name.
	    set name [my FuncName [lindex $origname 1]]
	    set fullname [my GenerateFunctionName $name arguments $arguments]

	    if {[$m function.defined $fullname]} {
		set called [[$m function.get $fullname] ref]

		set argvals [lmap arg $arguments {my LoadOrLiteral $arg}]

		my IssueInvokeFunction $tgt $called $argvals $vname
		return {}
	    }
	    if {[dict exist $vtypes $tgt]} {
		set type [nameOfType [dict get $vtypes $tgt]]
		if {"FAIL" ni $type || "STRING" ni $type} {
		    my Warn "didn't find implementation of '$fullname'"
		}
	    }
	}

	set arguments [list $origname {*}$arguments]
	set argvals [lmap s $arguments {my LoadOrLiteral $s}]

	# Dynamic dispatch via direct call is OK, *provided* someone has
	# fetched the function reference for us.

	if {[TypeOf [lindex $argvals 0]] ne [Type STRING]} {
	    set argvals [lassign $argvals called]







|







 







|
>


>
|
>











<







1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
....
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282

1283
1284
1285
1286
1287
1288
1289
	set procmeta [dict get $bytecode procmeta]
	set localcache [dict get $bytecode localcache]
	lassign [$b frame.create $varmeta $argc $argv \
			[$b load $procmeta "proc.metadata"] \
			[$b load $localcache "proc.localcache"]] \
	    theframe thevarmap
	my StoreResult $tgt $theframe
	set thens [$b dereference $theframe 0 CallFrame.nsPtr]
	return [list $theframe $thevarmap $thens $drop]
    }
 
    # TclCompiler:IssueInvoke --
    #
    #	Generate the code for invoking another Tcl command. Must only be
    #	called from the 'compile' method.
................................................................................
	# Is this a literal name for a function we already know the signature
	# of? If so, we can use a direct call. To work this out, we need to
	# resolve the command within the namespace context of the procedure.

	if {literal($origname)} {
	    # Resolve the name.
	    set name [my FuncName [lindex $origname 1]]
	    set fullname [my GenerateFunctionName $name arguments \
			      [lrange $arguments 1 end]]
	    if {[$m function.defined $fullname]} {
		set called [[$m function.get $fullname] ref]
		set argvals [lmap arg [lrange $arguments 1 end] {
		    my LoadOrLiteral $arg
		}]
		my IssueInvokeFunction $tgt $called $argvals $vname
		return {}
	    }
	    if {[dict exist $vtypes $tgt]} {
		set type [nameOfType [dict get $vtypes $tgt]]
		if {"FAIL" ni $type || "STRING" ni $type} {
		    my Warn "didn't find implementation of '$fullname'"
		}
	    }
	}


	set argvals [lmap s $arguments {my LoadOrLiteral $s}]

	# Dynamic dispatch via direct call is OK, *provided* someone has
	# fetched the function reference for us.

	if {[TypeOf [lindex $argvals 0]] ne [Type STRING]} {
	    set argvals [lassign $argvals called]

Changes to quadcode/builtin_specials.tcl.

20
21
22
23
24
25
26
27
28

29
30

31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46


47
48
49
50
51
52
53
..
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
...
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
...
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
# Results:
#	Returns the frame effect.

oo::define quadcode::specializer method frameEffect___lsort {q} {

    if {[lindex $q 0] eq "invokeExpanded"} {
	# lsort with {*} for the args - punt
	my diagnostic error "lsort with argument expansion is not supported yet"
	return {reads 0 writes 0 readsNonLocal {} writesNonLocal {}}

    }


    # Only [lsort - command] has an interesting frame effect

    # Only [lsort -command] might use callframe data

    lassign [my parse___lsort $q] usesCommand command
    if {!$usesCommand} {
	return {killable Inf noCallFrame {} pure {}}
    }

    # TODO: We can't analyze [lsort -command] yet, but we could.
    #       What it would take is to generate bytecode for the
    #	    command prefix with two dummy arguments, and then
    #	    determine the effect of the bytecode on the callframe.

    my diagnostic error "lsort -command is not supported yet"
    return {reads 0 writes 0 readsNonLocal {} writesNonLocal {}}



}

# quadcode::specializer method frameEffect___regexp --
#
#	Determines the callframe effect of the [regexp] command
#
................................................................................
#	Returns the frame effect.

oo::define quadcode::specializer method frameEffect___regexp {q} {
    # 0  - 'invoke'
    # 1  - result callframe
    # 2  - input callframe
    # 3  - ::regexp

    # 4+ - remaining args

    if {[lindex $q 0] eq "invokeExpanded"} {
	# can't figure out what vars are written, but we know there are
	# no other untoward side effects

	return {reads 0 writes 0}
    }

    # Skip over the command line switches

    set ind 4
    while {$ind < [llength $q] - 2} {
	if {[lindex $q $ind 0] ne "literal"} {
	    return {writes 0}
	}
	switch -exact -- [lindex $q $ind 1] {
	    -about -
	    -expanded -
................................................................................

oo::define quadcode::specializer method frameEffect___regsub {q} {

    # 0  - 'invoke'
    # 1  - result callframe
    # 2  - input callframe
    # 3  - ::regsub

    # 4+ - remaining args

    if {[lindex $q 0] eq "invokeExpanded"} {
	# can't figure out variable effects but otherwise the command is benign

	return {reads 0 writes 0}
    }

    # Skip over the command line switches

    set ind 4
    while {$ind < [llength $q]} {
	if {[lindex $q $ind 0] ne "literal"} {
	    if {$ind + 3 == [llength $q]} {
		return {killable Inf noCallFrame {} pure {}}
	    } else {
		return [dict create writes $ind]
	    }
................................................................................
#
# Results:
#	Returns a two-element list. The first element is a flag for
#	whether -command is present; the second is the command provided.

oo::define quadcode::specializer method parse___lsort {q} {

    set ind 4
    while {$ind + 1 < [llength $q]} {
	if {[lindex $q $ind 0] eq "literal"} {
	    set opt [lindex $q $ind 1]
	} else {
	    error "substitution in lsort flags is not supported."
	}
	switch -exact -- $opt {







|
|
>
|
|
>
|













|
|
>
>







 







>
|










|







 







>
|









|







 







|







20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
..
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
...
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
...
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
# Results:
#	Returns the frame effect.

oo::define quadcode::specializer method frameEffect___lsort {q} {

    if {[lindex $q 0] eq "invokeExpanded"} {
	# lsort with {*} for the args - punt
	return {
	    reads 0 writes 0 readsNonLocal {} writesNonLocal {}
	    error "lsort with argument expansion is not supported yet"
	}
    }

    # Only [lsort -command] has an interesting frame effect

    # Only [lsort -command] might use callframe data

    lassign [my parse___lsort $q] usesCommand command
    if {!$usesCommand} {
	return {killable Inf noCallFrame {} pure {}}
    }

    # TODO: We can't analyze [lsort -command] yet, but we could.
    #       What it would take is to generate bytecode for the
    #	    command prefix with two dummy arguments, and then
    #	    determine the effect of the bytecode on the callframe.

    return {
	reads 0 writes 0 readsNonLocal {} writesNonLocal {}
	error "lsort -command is not supported yet"
    }

}

# quadcode::specializer method frameEffect___regexp --
#
#	Determines the callframe effect of the [regexp] command
#
................................................................................
#	Returns the frame effect.

oo::define quadcode::specializer method frameEffect___regexp {q} {
    # 0  - 'invoke'
    # 1  - result callframe
    # 2  - input callframe
    # 3  - ::regexp
    # 4  - regexp
    # 5+ - remaining args

    if {[lindex $q 0] eq "invokeExpanded"} {
	# can't figure out what vars are written, but we know there are
	# no other untoward side effects

	return {reads 0 writes 0}
    }

    # Skip over the command line switches

    set ind 5
    while {$ind < [llength $q] - 2} {
	if {[lindex $q $ind 0] ne "literal"} {
	    return {writes 0}
	}
	switch -exact -- [lindex $q $ind 1] {
	    -about -
	    -expanded -
................................................................................

oo::define quadcode::specializer method frameEffect___regsub {q} {

    # 0  - 'invoke'
    # 1  - result callframe
    # 2  - input callframe
    # 3  - ::regsub
    # 4  - regsub
    # 5+ - remaining args

    if {[lindex $q 0] eq "invokeExpanded"} {
	# can't figure out variable effects but otherwise the command is benign

	return {reads 0 writes 0}
    }

    # Skip over the command line switches

    set ind 5
    while {$ind < [llength $q]} {
	if {[lindex $q $ind 0] ne "literal"} {
	    if {$ind + 3 == [llength $q]} {
		return {killable Inf noCallFrame {} pure {}}
	    } else {
		return [dict create writes $ind]
	    }
................................................................................
#
# Results:
#	Returns a two-element list. The first element is a flag for
#	whether -command is present; the second is the command provided.

oo::define quadcode::specializer method parse___lsort {q} {

    set ind 5
    while {$ind + 1 < [llength $q]} {
	if {[lindex $q $ind 0] eq "literal"} {
	    set opt [lindex $q $ind 1]
	} else {
	    error "substitution in lsort flags is not supported."
	}
	switch -exact -- $opt {

Changes to quadcode/callframe.tcl.

501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
...
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
...
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
....
1361
1362
1363
1364
1365
1366
1367
































		    "invoke" - "invokeExpanded" {

			# The variables altered by the 'invoke', plus
			# all aliases, are potentially changed.

			set aliases {}
			set atypes [lmap x [lrange $producer 4 end] {
			    typeOfOperand $types $x
			}]
			lassign [my variablesProducedBy $producer $atypes] \
			    known wlist
			if {$known} {
			    foreach v $wlist {
				dict set aliases $v {}
................................................................................
		}
		lset bbcontent $b [incr outpc] $q
		continue
	    }

	    # Determine argument types of the consuming call, which always
	    # begins with some output and a callframe input
	    set atypes [lmap x [lrange $consumer 4 end] {
		typeOfOperand $types $x
	    }]

	    # Find out what variables that the consumer potentially reads.
	    # Because potentially changed variables may also be unchanged,
	    # list them also.

................................................................................

	    # A callframe is always in a temporary
	    if {[lindex $toCF 0] ne "temp"} continue

	    # Is the result a callframe, and can we eliminate it?
	    set toCFType [typeOfOperand $types $toCF]
	    if {$opcode in {"invoke" "invokeExpanded"}} {
		set atypes [lmap x [lrange $q 4 end] {
		    typeOfOperand $types $x
		}]
	    } else {
		set atypes {}
	    }
	    if {($toCFType & $CALLFRAME)
		    && [my canEliminateCallFrame $q $atypes]} {
................................................................................
    # name in the next outer callframe, so can't be done safely.

    # If none of the above conditions hold, the callframe reference and
    # definition can be removed safely from the quad.

    return 1
}






































|







 







|







 







|







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
...
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
...
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
....
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398

		    "invoke" - "invokeExpanded" {

			# The variables altered by the 'invoke', plus
			# all aliases, are potentially changed.

			set aliases {}
			set atypes [lmap x [my invoke-args $producer] {
			    typeOfOperand $types $x
			}]
			lassign [my variablesProducedBy $producer $atypes] \
			    known wlist
			if {$known} {
			    foreach v $wlist {
				dict set aliases $v {}
................................................................................
		}
		lset bbcontent $b [incr outpc] $q
		continue
	    }

	    # Determine argument types of the consuming call, which always
	    # begins with some output and a callframe input
	    set atypes [lmap x [my invoke-args $consumer] {
		typeOfOperand $types $x
	    }]

	    # Find out what variables that the consumer potentially reads.
	    # Because potentially changed variables may also be unchanged,
	    # list them also.

................................................................................

	    # A callframe is always in a temporary
	    if {[lindex $toCF 0] ne "temp"} continue

	    # Is the result a callframe, and can we eliminate it?
	    set toCFType [typeOfOperand $types $toCF]
	    if {$opcode in {"invoke" "invokeExpanded"}} {
		set atypes [lmap x [my invoke-args $q] {
		    typeOfOperand $types $x
		}]
	    } else {
		set atypes {}
	    }
	    if {($toCFType & $CALLFRAME)
		    && [my canEliminateCallFrame $q $atypes]} {
................................................................................
    # name in the next outer callframe, so can't be done safely.

    # If none of the above conditions hold, the callframe reference and
    # definition can be removed safely from the quad.

    return 1
}
 
# quadcode::transformer method invoke-args --
#
#	Get the real arguments (other than the command name) that will
#	be used with the invocation.
#
# Parameters:
#	q - Quadcode instruction that produces a callframe.
#
# Results:
#	Returns the list of arguments (quadcode values) if they are
#	meaningful, otherwise produces an error..

oo::define quadcode::transformer method invoke-args {q} {
    switch [lindex $q 0 0] {
	"invoke" {
	    return [lrange $q 5 end]
	}
	"invokeExpanded" {
	    return [lrange $q 4 end]
	}
	"" {
	    # What is going on here?
	    return
	}
	default {
	    return -code error "cannot get invoke arguments from non-invoke\
		opcode '$q'"
	}
    }
}

Changes to quadcode/fqcmd.tcl.

26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51

oo::define quadcode::transformer method fqcmd {} {
    set b 0
    foreach content $bbcontent {
	set i 0
	foreach q $content {
	    if {[lindex $q 0 0] in {"invoke" "invokeExpanded"}
		&& [lindex $q 3 0] eq "literal"} {
		set cmdname [lindex $q 3 1]
		set resolved \
		    [namespace eval $ns [list namespace which $cmdname]]
		if {$resolved ne {}} {
		    set cmdname $resolved
		}
		if {![catch {
		    namespace eval $ns [list namespace origin $cmdname]
		} resolved]} {
			set cmdname $resolved
		}
		lset bbcontent $b $i 3 1 $cmdname
	    }
	    incr i
	}
	incr b
    }
}







|









|








26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51

oo::define quadcode::transformer method fqcmd {} {
    set b 0
    foreach content $bbcontent {
	set i 0
	foreach q $content {
	    if {[lindex $q 0 0] in {"invoke" "invokeExpanded"}
		    && [lindex $q 3 0] eq "literal"} {
		set cmdname [lindex $q 3 1]
		set resolved \
		    [namespace eval $ns [list namespace which $cmdname]]
		if {$resolved ne {}} {
		    set cmdname $resolved
		}
		if {![catch {
		    namespace eval $ns [list namespace origin $cmdname]
		} resolved]} {
		    set cmdname $resolved
		}
		lset bbcontent $b $i 3 1 $cmdname
	    }
	    incr i
	}
	incr b
    }
}

Changes to quadcode/translate.tcl.

890
891
892
893
894
895
896
897

898
899
900
901
902
903
904
...
906
907
908
909
910
911
912
913

914
915
916
917
918
919
920
		#	  the invoked procedure raises an error
		set qd [list [list temp [expr {$depth + $acount}]]]
		for {set i $rcount} {$i < $acount} {incr i} {
		    lappend qd [list temp [expr {$depth + $i}]]
		}
		my generate-function-param-check $pc $qd
		# generate the call itself
		my quads invoke {temp @callframe} {temp @callframe} {*}$qd

		my quads retrieveResult $result {temp @callframe}
		my quads extractCallFrame {temp @callframe} {temp @callframe}
		my generate-jump [my exception-target $pc catch] maybe $result
		my quads extractMaybe $result $result
	    }
	    invokeStk1 - invokeStk4 {
		set acount [lindex $insn 1]
................................................................................
		set result [list temp $depth]
		set qd {}
		for {set i 0} {$i < $acount} {incr i} {
		    lappend qd [list temp [expr {$depth + $i}]]
		}
		my generate-function-param-check $pc $qd
		# generate the call itself
		my quads invoke {temp @callframe} {temp @callframe} {*}$qd

		my quads retrieveResult $result {temp @callframe}
		my quads extractCallFrame {temp @callframe} {temp @callframe}
		my generate-jump [my exception-target $pc catch] maybe $result
		my quads extractMaybe $result $result
	    }
	    jump1 - jump4 {
		switch -exact -- [lindex $insn 1 0] {







|
>







 







|
>







890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
...
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
		#	  the invoked procedure raises an error
		set qd [list [list temp [expr {$depth + $acount}]]]
		for {set i $rcount} {$i < $acount} {incr i} {
		    lappend qd [list temp [expr {$depth + $i}]]
		}
		my generate-function-param-check $pc $qd
		# generate the call itself
		my quads invoke {temp @callframe} {temp @callframe} \
		    [lindex $qd 0] {*}$qd
		my quads retrieveResult $result {temp @callframe}
		my quads extractCallFrame {temp @callframe} {temp @callframe}
		my generate-jump [my exception-target $pc catch] maybe $result
		my quads extractMaybe $result $result
	    }
	    invokeStk1 - invokeStk4 {
		set acount [lindex $insn 1]
................................................................................
		set result [list temp $depth]
		set qd {}
		for {set i 0} {$i < $acount} {incr i} {
		    lappend qd [list temp [expr {$depth + $i}]]
		}
		my generate-function-param-check $pc $qd
		# generate the call itself
		my quads invoke {temp @callframe} {temp @callframe} \
		    [lindex $qd 0] {*}$qd
		my quads retrieveResult $result {temp @callframe}
		my quads extractCallFrame {temp @callframe} {temp @callframe}
		my generate-jump [my exception-target $pc catch] maybe $result
		my quads extractMaybe $result $result
	    }
	    jump1 - jump4 {
		switch -exact -- [lindex $insn 1 0] {

Changes to quadcode/upvar.tcl.

534
535
536
537
538
539
540
541
542
543
544
545
546
547
548






549
550
551
552
553
554
555
...
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
			    # must do: dict unset result killable;
			}
		    }
		}

		"invoke" {
		    set did 1
		    set argList [lassign $q opcode cfout cfin cmdName]
		    set typeList [lmap arg $argList {typeOfOperand $types $arg}]
		    if {[catch {
			$specializer frameEffect $q $typeList
		    } attrs]} {
			my diagnostic error $b $pc $attrs
			set attrs {readsAny 1 readsNonLocal 1 \
				       writesAny 1 writesNonLocal 1}






		    }
		    my upvarInvoke result $aliasInfo $attrs $q $typeList
		}

	    }

	    my debug-upvar {
................................................................................
#	None.
#
# Side effects:
#	Records the effect of the 'invoke' on the current callframe.

oo::define quadcode::transformer method upvarInvoke {resultV aliasInfo
						     effect q typeList} {


    upvar 1 $resultV result

    set callframe [lindex $q 1]

    # Record purity

    if {![dict exists $effect pure]} {
	dict unset result pure
    }







|







>
>
>
>
>
>







 







<
<

<







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
...
643
644
645
646
647
648
649


650

651
652
653
654
655
656
657
			    # must do: dict unset result killable;
			}
		    }
		}

		"invoke" {
		    set did 1
		    set argList [lassign $q opcode cfout cfin resolvedcCmdName orignalCmdName]
		    set typeList [lmap arg $argList {typeOfOperand $types $arg}]
		    if {[catch {
			$specializer frameEffect $q $typeList
		    } attrs]} {
			my diagnostic error $b $pc $attrs
			set attrs {readsAny 1 readsNonLocal 1 \
				       writesAny 1 writesNonLocal 1}
		    }
		    foreach dgtype {error warning} {
			if {[dict exists $attrs $dgtype]} {
			    my diagnostic $dgtype $b $pc [dict get $attrs $dgtype]
			    dict unset attrs $dgtype
			}
		    }
		    my upvarInvoke result $aliasInfo $attrs $q $typeList
		}

	    }

	    my debug-upvar {
................................................................................
#	None.
#
# Side effects:
#	Records the effect of the 'invoke' on the current callframe.

oo::define quadcode::transformer method upvarInvoke {resultV aliasInfo
						     effect q typeList} {


    upvar 1 $resultV result

    set callframe [lindex $q 1]

    # Record purity

    if {![dict exists $effect pure]} {
	dict unset result pure
    }

Changes to quadcode/varargs.tcl.

110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
...
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
...
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
#       Updates ud- and du-chains.

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 'invoke' instructions where the procedure name
    # is known a priori, the expected args are known, and the
    # target procedure is compiled.
    if {[lindex $calleeLit 0] ne "literal"
        || [catch {
            set callee [lindex $calleeLit 1]
................................................................................
        #    compilation going.
        return
    }

    # Make a new quad that passes all supplied params that
    # don't go in 'args'. Set 'paramsLeft' to the list of
    # parameters that weren't filled.
    set newq [list invoke $cfout $cfin $calleeLit \
                  {*}[lrange $argv 0 [expr {$nonargs-1}]]]
    set paramsleft [lrange $arginfo [llength $argv] [expr {$nonargs-1}]]

    # If we need to fill in optional parameters, do that now
    foreach param $paramsleft {
        if {![info default $callee $param defaultv]} {
            my diagnostic error "Too few args provided to $callee"
................................................................................
    my debug-varargs {
        puts "[my full-name]: $b:$pc: $q"
    }

    # Make the first part of the 'invoke' instruction that will
    # replace the 'invokeExpanded'

    set newq [list invoke $cfout $cfin $calleeLit]

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

    lassign [my varargsUnlinkTail $b $pc] bb tail







|







 







|







 







|







110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
...
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
...
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
#       Updates ud- and du-chains.

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

    set newqds {}

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

    # We care only about 'invoke' instructions where the procedure name
    # is known a priori, the expected args are known, and the
    # target procedure is compiled.
    if {[lindex $calleeLit 0] ne "literal"
        || [catch {
            set callee [lindex $calleeLit 1]
................................................................................
        #    compilation going.
        return
    }

    # Make a new quad that passes all supplied params that
    # don't go in 'args'. Set 'paramsLeft' to the list of
    # parameters that weren't filled.
    set newq [list invoke $cfout $cfin $calleeLit $origCallee \
                  {*}[lrange $argv 0 [expr {$nonargs-1}]]]
    set paramsleft [lrange $arginfo [llength $argv] [expr {$nonargs-1}]]

    # If we need to fill in optional parameters, do that now
    foreach param $paramsleft {
        if {![info default $callee $param defaultv]} {
            my diagnostic error "Too few args provided to $callee"
................................................................................
    my debug-varargs {
        puts "[my full-name]: $b:$pc: $q"
    }

    # Make the first part of the 'invoke' instruction that will
    # replace the 'invokeExpanded'

    set newq [list invoke $cfout $cfin $calleeLit $calleeLit]

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

    lassign [my varargsUnlinkTail $b $pc] bb tail