Check-in [a7ae4fde24]
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

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

Overview
Comment:Reform buildVector and clearVector to use preallocated space in the LLVM callframe
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA3-256: a7ae4fde248316a209973b416df0cf628e37c4b3481f2e6311f1bec319909471
User & Date: kbk 2018-04-10 02:46:52
Context
2018-04-10
03:05
Reform 'buildBitArray' to use preallocated space in the LLVM callframe check-in: 7f04a0d947 user: kbk tags: trunk
02:46
Reform buildVector and clearVector to use preallocated space in the LLVM callframe check-in: a7ae4fde24 user: kbk tags: trunk
2018-03-27
01:36
Merge changes: complete type checking of Boolean args to 'jumpTrue', 'jumpFalse', 'not', 'land', and 'lor' check-in: 0b62f38ede user: kbk tags: trunk
Changes

Changes to codegen/build.tcl.

1222
1223
1224
1225
1226
1227
1228






































1229
1230
1231
1232
1233
1234
1235
....
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730

1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
....
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
....
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
    #
    # Results:
    #	None.

    method addReference(FAIL\040DICTITER) {value} {
	my Call tcl.dict.addIterFailReference $value
    }







































    # Builder:appendString --
    #
    #	Append a string value to a working buffer. The working buffer is
    #	assumed to be an UNSHARED Tcl_Obj reference; caller must ensure this,
    #	and the quadcode stream does not provide this guarantee. See also the
    #	unshare(STRING) and unshareCopy(STRING) methods.
................................................................................

    # Builder:buildVector --
    #
    #	Create a vector value that can be used with variadic operations such
    #	as where a multi-element dictionary path is required. This value
    #	*MUST* be cleaned up after use with clearVector.
    #
    #	The vector "type" is special, as it is actually a family of related
    #	types. It *must* not be passed directly to a function, as it isn't a
    #	fixed type and causes confusion. It exists to efficiently assemble a
    #	group of (STRING-typed) arguments into an array and length.
    #
    # Parameters:

    #	types -	The types of the values used to build the vector, as a Tcl
    #		list of type descriptors.
    #	values -
    #		Tcl list of LLVM value references that are the individual
    #		elements of the vector.
    #
    # Results:
    #	LLVM vector value reference.

    method buildVector {types values} {
	# Implementation note: there must be no branches in the issued code.
	set arraytype [Type array{STRING,[llength $values]}]
	set vectortype [Type struct{int,$arraytype*,void*}]
	set stack [my call [$m intrinsic stacksave] {} "SP"]
	set ary [my alloc $arraytype]
	set idx -1
	foreach src $values t $types {
	    set s [my stringify($t) $src]
	    set cell [my gep $ary 0 [incr idx]]
	    my store $s $cell
	    if {![my IsVectorItemConstant $src $t]} {
		my addReference(STRING) $s
	    }
	}
	set vector [my undef $vectortype]
	set vector [my insert $vector [Const [llength $values]] 0]
	set vector [my insert $vector $ary 1]
	set vector [my insert $vector $stack 2]
	return $vector
    }

    # Builder:ExtractVector --
    #
    #	Extract the length and array of STRINGs from a vector.
    #
................................................................................
    #
    # Results:
    #	None.

    method ExtractVector {vector {lenVar len} {aryVar ary}} {
	upvar 1 $lenVar len $aryVar ary
	set len [my extract $vector 0]
	set ary [my cast(ptr) [my extract $vector 1] STRING]
	return
    }

    method buildBitArray {booleans} {
	set type [Type array{bool,[llength $booleans]}]
	set bits [my alloc $type]
	set idx -1
................................................................................
    }

    # Builder:clearVector --
    #
    #	Clean up a vector value created with buildVector.
    #
    # Parameters:
    #	srcs -	The quadcode values that the vector elements were built from.
    #		Used to detect direct literal STRINGs, which don't need
    #		free-ing.
    #	vector -
    #		The LLVM vector value reference.
    #	types -	The types of the values used to build the vector.
    #
    # Results:
    #	None.

    method clearVector {srcs vector types} {
	set idx -1
	set ary [my extract $vector 1]
	set stack [my extract $vector 2]
	foreach src $srcs t $types {
	    my dropReference [my load [my gep $ary 0 [incr idx]]]
	}
	my Call [$m intrinsic stackrestore] $stack
	return
    }

    # Builder:concat() --
    #
    #	Concatenate a collection of values using the classic Tcl algorithm.
    #	Quadcode implementation ('concat').






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







 







<
<
<
<
<

>









|

<
|
<
<



|







|
<







 







|







 







<
<
<


<
<



|

|
|
<
<
<
<







1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
....
1756
1757
1758
1759
1760
1761
1762





1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775

1776


1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788

1789
1790
1791
1792
1793
1794
1795
....
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
....
2091
2092
2093
2094
2095
2096
2097



2098
2099


2100
2101
2102
2103
2104
2105
2106




2107
2108
2109
2110
2111
2112
2113
    #
    # Results:
    #	None.

    method addReference(FAIL\040DICTITER) {value} {
	my Call tcl.dict.addIterFailReference $value
    }

    # Builder:allocBitv --
    #
    #	Allocate a bit vector of a given length.
    #
    # Parameters:
    #	len - The length of the vector
    #
    # Results:
    #	Returns an LLVM int1* reference designating the start of the vector
    #
    # MUST BE CALLED WHILE EMITTING CODE FOR THE ENTRY BLOCK AND AT
    # NO OTHER TIME

    method allocBitv {len} {
	set type [Type array{bool,$len}]
	set bits [my alloc $type]
	return [my gep $bits 0]
    }

    # Builder:allocObjv --
    #
    #	Allocate a STRING vector of a given length
    # 
    # Parameters:
    #	len - The length of the vector
    #
    # Results:
    #	Returns an LLVM STRING* reference designating the start of the vector
    #
    # MUST BE CALLED WHILE EMITTING CODE FOR THE ENTRY BLOCK AND AT
    # NO OTHER TIME

    method allocObjv {len} {
	set type [Type array{STRING,$len}]
	set strs [my alloc $type]
	return [my gep $strs 0]
    }

    # Builder:appendString --
    #
    #	Append a string value to a working buffer. The working buffer is
    #	assumed to be an UNSHARED Tcl_Obj reference; caller must ensure this,
    #	and the quadcode stream does not provide this guarantee. See also the
    #	unshare(STRING) and unshareCopy(STRING) methods.
................................................................................

    # Builder:buildVector --
    #
    #	Create a vector value that can be used with variadic operations such
    #	as where a multi-element dictionary path is required. This value
    #	*MUST* be cleaned up after use with clearVector.
    #





    # Parameters:
    #	start - An LLVM STRING* value that designates the start of the vecotr
    #	types -	The types of the values used to build the vector, as a Tcl
    #		list of type descriptors.
    #	values -
    #		Tcl list of LLVM value references that are the individual
    #		elements of the vector.
    #
    # Results:
    #	LLVM vector value reference.

    method buildVector {start types values} {
	# Implementation note: there must be no branches in the issued code.

	set vectortype [Type struct{int,STRING*}]


	set idx -1
	foreach src $values t $types {
	    set s [my stringify($t) $src]
	    set cell [my gep $start 0 [incr idx]]
	    my store $s $cell
	    if {![my IsVectorItemConstant $src $t]} {
		my addReference(STRING) $s
	    }
	}
	set vector [my undef $vectortype]
	set vector [my insert $vector [Const [llength $values]] 0]
	set vector [my insert $vector [my gep $start 0 0] 1]

	return $vector
    }

    # Builder:ExtractVector --
    #
    #	Extract the length and array of STRINGs from a vector.
    #
................................................................................
    #
    # Results:
    #	None.

    method ExtractVector {vector {lenVar len} {aryVar ary}} {
	upvar 1 $lenVar len $aryVar ary
	set len [my extract $vector 0]
	set ary [my extract $vector 1]
	return
    }

    method buildBitArray {booleans} {
	set type [Type array{bool,[llength $booleans]}]
	set bits [my alloc $type]
	set idx -1
................................................................................
    }

    # Builder:clearVector --
    #
    #	Clean up a vector value created with buildVector.
    #
    # Parameters:



    #	vector -
    #		The LLVM vector value reference.


    # Results:
    #	None.

    method clearVector {vector} {
	set idx -1
	my ExtractVector $vector objc objv
	my call ${tcl.vector.clear} [list $objc $objv]




	return
    }

    # Builder:concat() --
    #
    #	Concatenate a collection of values using the classic Tcl algorithm.
    #	Quadcode implementation ('concat').

Changes to codegen/compile.tcl.

23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
...
337
338
339
340
341
342
343







344
345
346
347
348
349
350
...
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
...
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
...
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
....
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
....
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
....
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
# Public properties:
#	none

oo::class create TclCompiler {
    superclass llvmEntity
    variable bytecode cmd func quads paramTypes returnType vtypes variables
    variable m b pc errorCode currentline currentprocrelline currentscript
    variable bytecodeVars namespace

    constructor {} {
	next
	namespace import \
	    ::quadcode::nameOfType \
	    ::quadcode::typeOfLiteral \
	    ::quadcode::typeOfOperand \
................................................................................

	    try {
	    $b @location $currentline
	    switch -exact -- [lindex $l 0 0] {
		"entry" {
		    lassign [my IssueEntry $l] \
			theframe thevarmap syntheticargs







		}
		"confluence" - "unset" {
		    # Do nothing; required for SSA computations only
		}
		"@debug-file" {
		}
		"@debug-line" {
................................................................................
			append opcode ( [my ValueTypes {*}$srcs] )
			set srcs [lmap s $srcs {my LoadOrLiteral $s}]
			set res [$b $opcode {*}$srcs $errorCode $name]
			my StoreResult $tgt $res
		    } else {
			# Need to construct the variadic path
			set vectortypes [lmap s $srcs {my ValueTypes $s}]
			set vector [$b buildVector $vectortypes \
				  [lmap s $srcs {my LoadOrLiteral $s}]]
			append opcode ( [my ValueTypes $srcObj] )
			set srcObj [my LoadOrLiteral $srcObj]
			set res [$b $opcode $srcObj $vector $errorCode $name]
			my StoreResult $tgt $res
			$b clearVector $srcs $vector $vectortypes
		    }
		    if {"FAIL" in [my ValueTypes $tgt]} {
			my SetErrorLine $errorCode [$b maybe $res]
		    }
		}
		"dictSet" - "listSet" {
		    set srcs [lassign $l opcode tgt srcObj srcValue]
................................................................................
			append opcode ( [my ValueTypes {*}$srcs] )
			set srcs [lmap s $srcs {my LoadOrLiteral $s}]
			set res [$b $opcode {*}$srcs $errorCode $name]
			my StoreResult $tgt $res
		    } else {
			# Need to construct the variadic path
			set vectortypes [lmap s $srcs {my ValueTypes $s}]
			set vector [$b buildVector $vectortypes \
				  [lmap s $srcs {my LoadOrLiteral $s}]]
			set srcs [list $srcObj $srcValue]
			append opcode ( [my ValueTypes {*}$srcs] )
			set srcs [lmap s $srcs {my LoadOrLiteral $s}]
			set res [$b $opcode {*}$srcs $vector $errorCode $name]
			my StoreResult $tgt $res
			$b clearVector $srcs $vector $vectortypes
		    }
		    if {"FAIL" in [my ValueTypes $tgt]} {
			my SetErrorLine $errorCode [$b maybe $res]
		    }
		}
		"copy" - "expand" {
		    lassign $l opcode tgt src
................................................................................
		    }
		    my StoreResult $tgt $result
		}
		"concat" {
		    set srcs [lassign $l opcode tgt]
		    # Need to construct the variadic vector
		    set vectortypes [lmap s $srcs {my ValueTypes $s}]
		    set vector [$b buildVector $vectortypes \
			    [lmap s $srcs {my LoadOrLiteral $s}]]
		    set name [my LocalVarName $tgt]
		    set result [$b concat() $vector $name]
		    my StoreResult $tgt $result
		    $b clearVector $srcs $vector $vectortypes
		}
		"foreachStart" {
		    set srcs [lassign $l opcode tgt assign]
		    set listtypes [lmap s $srcs {my ValueTypes $s}]
		    set lists [$b buildVector $listtypes \
			    [lmap s $srcs {my LoadOrLiteral $s}]]
		    set result [$b foreachStart [lindex $assign 1] $lists $errorCode]
		    if {"FAIL" in [my ValueTypes $tgt]} {
			my SetErrorLine $errorCode [$b maybe $result]
		    }
		    my StoreResult $tgt $result
		}
................................................................................
	upvar 1 callframe callframe thecallframe thecallframe

	set types [lmap s $arguments {my ValueTypes $s}]
	if {$resolved ne ""} {
	    # FIXME: this causes wrong "wrong # args" messages
	    set argvals [lreplace $argvals 0 0 $resolved]
	}
	set vector [$b buildVector $types $argvals]
	set result [$b invoke $vector \
			[expr {callframe($thecallframe)}] $callframe \
			$errorCode $vname]
	$b clearVector $arguments $vector $types
	# Result type is now FAIL STRING, always.
	my SetErrorLine $errorCode [$b maybe $result]
	if {callframe($thecallframe)} {
	    set result [$b frame.pack $callframe $result]
	}
	my StoreResult $tgt $result
    }
................................................................................
	set arguments [lassign $operation opcode tgt thecallframe]
	set vname [my LocalVarName $tgt]
	set expandPositions [lmap s $arguments {
	    expr {"EXPANDED" in [my OperandType $s]}
	}]
	set argvals [lmap s $arguments {my LoadOrLiteral $s}]
	set types [lmap s $arguments {my ValueTypes $s}]
	set vector [$b buildVector $types $argvals]
	set flags [$b buildBitArray $expandPositions]
	set result [$b invokeExpanded $vector $flags $errorCode $vname]
	my SetErrorLine $errorCode [$b maybe $result]
	if {callframe($thecallframe)} {
	    set result [$b frame.pack $callframe $result]
	}
	my StoreResult $tgt $result
	$b clearVector $arguments $vector $types
	return $arguments
    }
 
    # TclCompiler:IssueWiden --
    #
    #	Generate the code for widening the type of a value. Must only be
    #	called from the 'compile' method.
................................................................................
	} elseif {[llength $srcs] == 0 && $srcDict eq "literal \uf8ff"} {
	    my StoreResult $tgt [my LoadOrLiteral "literal 0"]
	    return
	}

	# Need to construct the variadic vector
	set types [lmap s $srcs {my ValueTypes $s}]
	set vector [$b buildVector $types \
		      [lmap s $srcs {my LoadOrLiteral $s}]]
	set name [my LocalVarName $tgt]
	append opcode ( [my ValueTypes $srcDict] )
	set srcDict [my LoadOrLiteral $srcDict]
	my StoreResult $tgt [$b $opcode $srcDict $vector $name]
	$b clearVector $srcs $vector $types
	return
    }
 
    # TclCompiler:IssueExtract --
    #
    #	Generate the code for exactracting the value of a variable which
    #	contains a "possibly-existing" value. Must only be called from the






|







 







>
>
>
>
>
>
>







 







|





|







 







|






|







 







|




|




|







 







|



|







 







|







|







 







|





|







23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
...
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
...
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
...
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
...
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
....
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
....
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
....
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
# Public properties:
#	none

oo::class create TclCompiler {
    superclass llvmEntity
    variable bytecode cmd func quads paramTypes returnType vtypes variables
    variable m b pc errorCode currentline currentprocrelline currentscript
    variable bytecodeVars namespace objv

    constructor {} {
	next
	namespace import \
	    ::quadcode::nameOfType \
	    ::quadcode::typeOfLiteral \
	    ::quadcode::typeOfOperand \
................................................................................

	    try {
	    $b @location $currentline
	    switch -exact -- [lindex $l 0 0] {
		"entry" {
		    lassign [my IssueEntry $l] \
			theframe thevarmap syntheticargs
		}
		"allocObjvForCallees" {
		    set objc [lindex $l 2 1]
		    if {$objc > 0} {
			set objv [$b allocObjv $objc]
			set bitv [$b allocBitv $objc]
		    }
		}
		"confluence" - "unset" {
		    # Do nothing; required for SSA computations only
		}
		"@debug-file" {
		}
		"@debug-line" {
................................................................................
			append opcode ( [my ValueTypes {*}$srcs] )
			set srcs [lmap s $srcs {my LoadOrLiteral $s}]
			set res [$b $opcode {*}$srcs $errorCode $name]
			my StoreResult $tgt $res
		    } else {
			# Need to construct the variadic path
			set vectortypes [lmap s $srcs {my ValueTypes $s}]
			set vector [$b buildVector $objv $vectortypes \
				  [lmap s $srcs {my LoadOrLiteral $s}]]
			append opcode ( [my ValueTypes $srcObj] )
			set srcObj [my LoadOrLiteral $srcObj]
			set res [$b $opcode $srcObj $vector $errorCode $name]
			my StoreResult $tgt $res
			$b clearVector $vector
		    }
		    if {"FAIL" in [my ValueTypes $tgt]} {
			my SetErrorLine $errorCode [$b maybe $res]
		    }
		}
		"dictSet" - "listSet" {
		    set srcs [lassign $l opcode tgt srcObj srcValue]
................................................................................
			append opcode ( [my ValueTypes {*}$srcs] )
			set srcs [lmap s $srcs {my LoadOrLiteral $s}]
			set res [$b $opcode {*}$srcs $errorCode $name]
			my StoreResult $tgt $res
		    } else {
			# Need to construct the variadic path
			set vectortypes [lmap s $srcs {my ValueTypes $s}]
			set vector [$b buildVector $objv $vectortypes \
				  [lmap s $srcs {my LoadOrLiteral $s}]]
			set srcs [list $srcObj $srcValue]
			append opcode ( [my ValueTypes {*}$srcs] )
			set srcs [lmap s $srcs {my LoadOrLiteral $s}]
			set res [$b $opcode {*}$srcs $vector $errorCode $name]
			my StoreResult $tgt $res
			$b clearVector $vector
		    }
		    if {"FAIL" in [my ValueTypes $tgt]} {
			my SetErrorLine $errorCode [$b maybe $res]
		    }
		}
		"copy" - "expand" {
		    lassign $l opcode tgt src
................................................................................
		    }
		    my StoreResult $tgt $result
		}
		"concat" {
		    set srcs [lassign $l opcode tgt]
		    # Need to construct the variadic vector
		    set vectortypes [lmap s $srcs {my ValueTypes $s}]
		    set vector [$b buildVector $objv $vectortypes \
			    [lmap s $srcs {my LoadOrLiteral $s}]]
		    set name [my LocalVarName $tgt]
		    set result [$b concat() $vector $name]
		    my StoreResult $tgt $result
		    $b clearVector $vector
		}
		"foreachStart" {
		    set srcs [lassign $l opcode tgt assign]
		    set listtypes [lmap s $srcs {my ValueTypes $s}]
		    set lists [$b buildVector $objv $listtypes \
			    [lmap s $srcs {my LoadOrLiteral $s}]]
		    set result [$b foreachStart [lindex $assign 1] $lists $errorCode]
		    if {"FAIL" in [my ValueTypes $tgt]} {
			my SetErrorLine $errorCode [$b maybe $result]
		    }
		    my StoreResult $tgt $result
		}
................................................................................
	upvar 1 callframe callframe thecallframe thecallframe

	set types [lmap s $arguments {my ValueTypes $s}]
	if {$resolved ne ""} {
	    # FIXME: this causes wrong "wrong # args" messages
	    set argvals [lreplace $argvals 0 0 $resolved]
	}
	set vector [$b buildVector $objv $types $argvals]
	set result [$b invoke $vector \
			[expr {callframe($thecallframe)}] $callframe \
			$errorCode $vname]
	$b clearVector $vector
	# Result type is now FAIL STRING, always.
	my SetErrorLine $errorCode [$b maybe $result]
	if {callframe($thecallframe)} {
	    set result [$b frame.pack $callframe $result]
	}
	my StoreResult $tgt $result
    }
................................................................................
	set arguments [lassign $operation opcode tgt thecallframe]
	set vname [my LocalVarName $tgt]
	set expandPositions [lmap s $arguments {
	    expr {"EXPANDED" in [my OperandType $s]}
	}]
	set argvals [lmap s $arguments {my LoadOrLiteral $s}]
	set types [lmap s $arguments {my ValueTypes $s}]
	set vector [$b buildVector $objv $types $argvals]
	set flags [$b buildBitArray $expandPositions]
	set result [$b invokeExpanded $vector $flags $errorCode $vname]
	my SetErrorLine $errorCode [$b maybe $result]
	if {callframe($thecallframe)} {
	    set result [$b frame.pack $callframe $result]
	}
	my StoreResult $tgt $result
	$b clearVector $vector
	return $arguments
    }
 
    # TclCompiler:IssueWiden --
    #
    #	Generate the code for widening the type of a value. Must only be
    #	called from the 'compile' method.
................................................................................
	} elseif {[llength $srcs] == 0 && $srcDict eq "literal \uf8ff"} {
	    my StoreResult $tgt [my LoadOrLiteral "literal 0"]
	    return
	}

	# Need to construct the variadic vector
	set types [lmap s $srcs {my ValueTypes $s}]
	set vector [$b buildVector $objv $types \
		      [lmap s $srcs {my LoadOrLiteral $s}]]
	set name [my LocalVarName $tgt]
	append opcode ( [my ValueTypes $srcDict] )
	set srcDict [my LoadOrLiteral $srcDict]
	my StoreResult $tgt [$b $opcode $srcDict $vector $name]
	$b clearVector $vector
	return
    }
 
    # TclCompiler:IssueExtract --
    #
    #	Generate the code for exactracting the value of a variable which
    #	contains a "possibly-existing" value. Must only be called from the

Changes to codegen/stdlib.tcl.

22
23
24
25
26
27
28

29
30
31
32
33
34
35
...
399
400
401
402
403
404
405



























406
407
408
409
410
411
412
    variable tcl.addReference tcl.dropReference
    variable tcl.addFailReference tcl.dropFailReference
    variable tcl.addNExistReference tcl.dropNExistReference
    variable tcl.dropFailNExistReference
    variable tcl.dropReference.failImpureInt tcl.dropReference.failImpureDouble
    variable tcl.dropReference.failImpureZeroOneBoolean
    variable tcl.unshare tcl.unshare.copy

    variable tcl.strlen tcl.append.string tcl.streq tcl.strcmp tcl.strmatch
    variable tcl.stridx tcl.stridx.idx
    variable tcl.strrange tcl.strrange.idx tcl.strreplace tcl.strreplace.idx
    variable tcl.strfind.fwd tcl.strfind.rev
    variable tcl.strmap tcl.strtrim tcl.strcase tcl.strclass
    variable tcl.regexp tcl.concatenate tcl.booleanTest tcl.not.string
    variable tcl.resolveCmd tcl.originCmd
................................................................................
	params value:objPtr
	build {
	    nonnull $value
	    set dupe [$api Tcl_DuplicateObj $value]
	    my addReference(STRING) $dupe
	    my ret $dupe
	}




























	return
    }
 
    # Builder:StringFunctions --
    #
    #	Generate the functions that implement the string-related quadcodes.






>







 







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







22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
...
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
    variable tcl.addReference tcl.dropReference
    variable tcl.addFailReference tcl.dropFailReference
    variable tcl.addNExistReference tcl.dropNExistReference
    variable tcl.dropFailNExistReference
    variable tcl.dropReference.failImpureInt tcl.dropReference.failImpureDouble
    variable tcl.dropReference.failImpureZeroOneBoolean
    variable tcl.unshare tcl.unshare.copy
    variable tcl.vector.clear
    variable tcl.strlen tcl.append.string tcl.streq tcl.strcmp tcl.strmatch
    variable tcl.stridx tcl.stridx.idx
    variable tcl.strrange tcl.strrange.idx tcl.strreplace tcl.strreplace.idx
    variable tcl.strfind.fwd tcl.strfind.rev
    variable tcl.strmap tcl.strtrim tcl.strcase tcl.strclass
    variable tcl.regexp tcl.concatenate tcl.booleanTest tcl.not.string
    variable tcl.resolveCmd tcl.originCmd
................................................................................
	params value:objPtr
	build {
	    nonnull $value
	    set dupe [$api Tcl_DuplicateObj $value]
	    my addReference(STRING) $dupe
	    my ret $dupe
	}

	##### tcl.vector.clear #####
	#
	# Type signature: objc:int,objv:STRING*->void
	#
	# Releases the references on a vector of STRING pointers all at once.

	set f [$m local "tcl.vector.clear" void<-int,STRING*]
	params objc objv
	build {
	    nonnull $objv
	    my br $entry
	label entry:
	    my br $loop
	label loop:
	    set count_loop [my phi [list $objc] [list $entry] "count"]
	    set res [my cmpInt $count_loop SGT [Const 0 int]]
	    my condBr $res $freeOne $done
	label freeOne:
	    set count_freeOne [my sub $count_loop [Const 1 int] "count"]
	    set obj [my load [my getelementptr $objv $count_freeOne]]
	    my br $loop
        label done:
	    my ret
	    
	    AddIncoming $count_loop $count_freeOne [my LABEL $freeOne]
	}

	return
    }
 
    # Builder:StringFunctions --
    #
    #	Generate the functions that implement the string-related quadcodes.

Changes to quadcode/flatten.tcl.

29
30
31
32
33
34
35




36
37
38
39
40
41



















42
43
44
45
46
47
48
49
50
51
52


53
54
55
56
57
58
59
60
61
62
63
64





65


66
67



68
69


70
71








72
73
74
75
76
77


78
79
80
81
82
83
84
# lists of quads to the basic block representation is incomplete. It
# simply concatenates all the basic block together, removing superfluous
# jumps and rewriting basic block references to program counter
# references. It also rewrites phi's so that their arguments are transposed:
#    var origin var origin ...
# as opposed to
#    origin var origin var ...





oo::define quadcode::transformer method flatten {} {
    my debug-flatten {
	puts "flatten:"
	my dump-bb
    }




















    # Concatenate the basic blocks, removing superfluous jumps.
    # Generate new names for all the variables and hold them in
    # 'varmap'. Hold the locations of start and end PC's of the
    # basic blocks in 'bbstart' and 'bbend' respectively.

    set quads {}
    set varmap {}
    set newtypes {}
    set b 0
    set pc 0


    foreach content $bbcontent {
	set i 0
	lappend bbstart [llength $quads]
	foreach q $content {
	    set result [lindex $q 1]
	    if {[lindex $result 0] in {"var" "temp"}} {
		set newresult [lreplace $result 2 2 $pc]
		lset q 1 $newresult
		dict set varmap $result $newresult
		dict set newtypes $newresult [dict get $types $result]
	    }
	    if {[lindex $q 0] eq "jump"





		&& [lindex $q 1 1] == ($b + 1)} {


		# do nothing: eliminate jump pc+1
	    } elseif {[lindex $q 0] eq "split"} {



		# do nothing: eliminate split markers
	    } else {


		lappend quads $q
		incr pc








	    }
	    incr i
	}
	lappend bbend [expr {[llength $quads] - 1}]
	incr b
    }



    # Rewrite PC and variable references in the quadcode according to the
    # mapping.

    set pc 0
    foreach q $quads {
	if {[lindex $q 1 0] eq "bb"} {






>
>
>
>






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











>
>






|




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






>
>







29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98

99
100
101
102

103
104
105

106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
# lists of quads to the basic block representation is incomplete. It
# simply concatenates all the basic block together, removing superfluous
# jumps and rewriting basic block references to program counter
# references. It also rewrites phi's so that their arguments are transposed:
#    var origin var origin ...
# as opposed to
#    origin var origin var ...
#
# This method also counts the maximum number of args required by method
# invocations, and if any invocation is present, preallocates objv so that
# method calls have a space in the callframe for assembling their parameters.

oo::define quadcode::transformer method flatten {} {
    my debug-flatten {
	puts "flatten:"
	my dump-bb
    }

    # For the quads listed in 'toSkip', the values are the number of
    # args to ignore. Any remaining args must be preallocated in
    # objv

    set toSkip {
	"concat"		2
	"dictExists"		3
	"dictGet"		3
	"dictSet"		4
	"dictUnset"		3
	"foreachStart"		3
	"invoke"		3
	"invokeExpanded"	3
	"listIndex"		3
	"listSet"		4
	"NRE.invoke"		3
	"NRE.invokeExpanded" 	3
    }

    # Concatenate the basic blocks, removing superfluous jumps.
    # Generate new names for all the variables and hold them in
    # 'varmap'. Hold the locations of start and end PC's of the
    # basic blocks in 'bbstart' and 'bbend' respectively.

    set quads {}
    set varmap {}
    set newtypes {}
    set b 0
    set pc 0
    set maxobjc 0

    foreach content $bbcontent {
	set i 0
	lappend bbstart [llength $quads]
	foreach q $content {
	    set result [lindex $q 1]
	    if {[lindex $result 0] in {"var" "temp"}} {
		set newresult [lreplace $result 2 2 [llength $quads]]
		lset q 1 $newresult
		dict set varmap $result $newresult
		dict set newtypes $newresult [dict get $types $result]
	    }
	    switch -exact -- [lindex $q 0] {
		"jump" {
		    if {$b == 0} {
			set allocIdx [llength $quads]
			lappend quads [list allocObjvForCallees {} {}]
		    }
		    if {[lindex $q 1 1] != ($b + 1)} {
			lappend quads $q
		    } else {
			# do nothing: eliminate jump pc+1

		    }
		}
		"split" {
		    # do nothing: eliminate split markers

		}
		default {
		    lappend quads $q

		}
	    }
	    if {[dict exists $toSkip [lindex $q 0 0]]} {
		set nSkip [dict get $toSkip [lindex $q 0 0]]
		set objc [expr {[llength $q] - $nSkip}]
		if {$objc > $maxobjc} {
		    set maxobjc $objc
		}
	    }
	    incr i
	}
	lappend bbend [expr {[llength $quads] - 1}]
	incr b
    }

    lset quads $allocIdx 2 [list literal $maxobjc]

    # Rewrite PC and variable references in the quadcode according to the
    # mapping.

    set pc 0
    foreach q $quads {
	if {[lindex $q 1 0] eq "bb"} {

Changes to quadcodes.txt.

185
186
187
188
189
190
191



192
193
194
195
196
197
198
    Let TGT contain the current interpreter return options, given that SRC
    contains the exception code, as obtained by 'returnCode'.
setReturnCode {} SRC
    Sets the current return code to SRC.

General/Structural Operations
-----------------------



confluence
    Comes at the start of a block that has execution flowing in from multiple
    other blocks.
copy TGT SRC
    Let TGT become SRC
entry
    Marks the entry to the function.






>
>
>







185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
    Let TGT contain the current interpreter return options, given that SRC
    contains the exception code, as obtained by 'returnCode'.
setReturnCode {} SRC
    Sets the current return code to SRC.

General/Structural Operations
-----------------------
allocObjvForCallees {} {literal N}
    Preallocates the 'objv' vector for commands that this command invokes.
    N is the required length of the vector.
confluence
    Comes at the start of a block that has execution flowing in from multiple
    other blocks.
copy TGT SRC
    Let TGT become SRC
entry
    Marks the entry to the function.