Check-in [7e61b1c24c]
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:Implement NRE.invokeExpanded
Timelines: family | ancestors | descendants | both | kbk-nre
Files: files | file ages | folders
SHA3-256: 7e61b1c24cc48231bfea25a4fdca55660e77a61259e0ae5262cdca3ad44ac688
User & Date: dkf 2018-10-21 22:41:51
Context
2018-10-21
22:49
Squelch unnecessary test failures. check-in: 35ee4b3111 user: dkf tags: kbk-nre
22:41
Implement NRE.invokeExpanded check-in: 7e61b1c24c user: dkf tags: kbk-nre
17:48
Test case for NRE.invokeExpanded check-in: 7c7508effb user: dkf tags: kbk-nre
Changes

Changes to codegen/build.tcl.

4517
4518
4519
4520
4521
4522
4523
4524
4525
4526
4527
4528
4529
4530
4531
....
4564
4565
4566
4567
4568
4569
4570


































4571
4572
4573
4574
4575
4576
4577
	}
	my call ${tcl.invoke.command} [list $len $ary $cf $ec] $resultName
    }

    # Builder:invokeNRE --
    #
    #	Generate code to call a Tcl command with non-recursive eval.
    # Quadcode implementation ('NRE.invoke').
    #
    # Parameters:
    #	arguments -
    #		The arguments as an LLVM array value reference. Note that
    #		this includes the function name as the first argument.
    #	havecf -
    #		Tcl boolean indicating if we have a valid callframe.
................................................................................
    # Results:
    #	An LLVM value reference.

    method invokeExpanded {arguments flags ec {resultName ""}} {
	my ExtractVector $arguments
	my call ${tcl.invoke.expanded} [list $len $ary $flags $ec] $resultName
    }



































    # Builder:isBoolean(INT BOOLEAN) --
    #
    #	Test if a value is a boolean. Quadcode implementation ('isBoolean').
    #
    # Parameters:
    #	value -	The value to test, as an LLVM value reference.






|







 







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







4517
4518
4519
4520
4521
4522
4523
4524
4525
4526
4527
4528
4529
4530
4531
....
4564
4565
4566
4567
4568
4569
4570
4571
4572
4573
4574
4575
4576
4577
4578
4579
4580
4581
4582
4583
4584
4585
4586
4587
4588
4589
4590
4591
4592
4593
4594
4595
4596
4597
4598
4599
4600
4601
4602
4603
4604
4605
4606
4607
4608
4609
4610
4611
	}
	my call ${tcl.invoke.command} [list $len $ary $cf $ec] $resultName
    }

    # Builder:invokeNRE --
    #
    #	Generate code to call a Tcl command with non-recursive eval.
    #	Quadcode implementation ('NRE.invoke').
    #
    # Parameters:
    #	arguments -
    #		The arguments as an LLVM array value reference. Note that
    #		this includes the function name as the first argument.
    #	havecf -
    #		Tcl boolean indicating if we have a valid callframe.
................................................................................
    # Results:
    #	An LLVM value reference.

    method invokeExpanded {arguments flags ec {resultName ""}} {
	my ExtractVector $arguments
	my call ${tcl.invoke.expanded} [list $len $ary $flags $ec] $resultName
    }

    # Builder:invokeExpandedNRE --
    #
    #	Generate code to call a command with non-recursive eval while doing
    #	argument expansion. Quadcode implementation ('NRE.invokeExpanded').
    #
    # Parameters:
    #	arguments -
    #		The arguments as an LLVM vector value reference. Note that
    #		this includes the function name as the first argument.
    #	flags -	LLVM bit array indicating which arguments to expand.
    #	havecf -
    #		Tcl boolean indicating if we have a valid callframe.
    #	cf -	The reference to the current callframe if 'havecf' is true.
    #	ec -	Location to write the Tcl return code into, as an LLVM int*
    #		reference.
    #	resultName (optional) -
    #		A name to give to the result value.
    #
    # Results:
    #	An LLVM value reference.

    method invokeExpandedNRE {arguments flags havecf cf ec {resultName ""}} {
	my ExtractVector $arguments
	if {!$havecf} {
	    set cf {}
	}
	my call ${tcl.invoke.expanded.nre} [list $len $ary $flags $cf $ec] \
	    $resultName
    }

    method restoreFrame {frame} {
	my call ${tcl.restoreFrame} [list $frame]
    }

    # Builder:isBoolean(INT BOOLEAN) --
    #
    #	Test if a value is a boolean. Quadcode implementation ('isBoolean').
    #
    # Parameters:
    #	value -	The value to test, as an LLVM value reference.

Changes to codegen/compile.tcl.

1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
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
....
1454
1455
1456
1457
1458
1459
1460


























1461
1462
1463
1464
1465
1466
1467
	} else {
	    set arguments [linsert $arguments[set arguments ""] 0 $origname]
	    set argvals [lmap arg $arguments {my LoadOrLiteral $arg}]
	    my IssueNREInvokeCommand $tgt $called $arguments $argvals $vname
	}
    }

    method IssueNREInvokeExpanded {callframe operation} {
	set arguments [lassign $operation opcode tgt thecallframe origname]
	set rettype [lindex $opcode 1]
	set vname [my LocalVarName $tgt]
	set expandPositions [lmap s $arguments {
	    expr {"EXPANDED" in [my OperandType $s]}
	}]

	# Only try to do command resolution if we're not expanding the first
	# argument. If we're expanding the command name itself, the only
	# option that makes sense is a full invoke.
	if {![lindex $expandPositions 0]} {
	    set called [my ResolveInvoke $rettype $origname $arguments]
	    if {$called ne {}} {
		set argvals [lmap arg $arguments {my LoadOrLiteral $arg}]
		set useCallframe [expr {callframe($thecallframe)}]
		my IssueNREInvokeFunctionExpanded \
		    $useCallframe $callframe \
		    $rettype $tgt $called $argvals \
		    $expandPositions $vname
		return
	    }
	}

	set arguments [linsert $arguments[set arguments ""] 0 $origname]
	set argvals [lmap arg $arguments {my LoadOrLiteral $arg}]
	my IssueNREInvokeCommandExpanded \
	    $tgt $called $arguments $argvals $expandPositions $vname
    }

    method IssueInvokeCommand {tgt resolved arguments argvals vname} {
	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]
................................................................................
	if {callframe($thecallframe)} {
	    set result [$b frame.pack $callframe $result]
	}
	my StoreResult $tgt $result
	$b clearVector $objv $types $arguments
	return $arguments
    }


























 
    # TclCompiler:IssueNREReturnFromInvoke --
    #
    #	Generates the code to tidy up after an invoked NRE command returns.
    #
    # Parameters:
    #	callframe - The current callframe






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







 







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







1346
1347
1348
1349
1350
1351
1352






























1353
1354
1355
1356
1357
1358
1359
....
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
	} else {
	    set arguments [linsert $arguments[set arguments ""] 0 $origname]
	    set argvals [lmap arg $arguments {my LoadOrLiteral $arg}]
	    my IssueNREInvokeCommand $tgt $called $arguments $argvals $vname
	}
    }































    method IssueInvokeCommand {tgt resolved arguments argvals vname} {
	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]
................................................................................
	if {callframe($thecallframe)} {
	    set result [$b frame.pack $callframe $result]
	}
	my StoreResult $tgt $result
	$b clearVector $objv $types $arguments
	return $arguments
    }

    method IssueNREInvokeExpanded {callframe operation} {
	set arguments [lassign $operation opcode tgt thecallframe]
	set rettype [lindex $opcode 1]
	set vname [my LocalVarName $tgt]
	set expandPositions [lmap s $arguments {
	    expr {"EXPANDED" in [my OperandType $s]}
	}]
	set argvals [lmap arg $arguments {my LoadOrLiteral $arg}]
	set types [lmap s $arguments {my ValueTypes $s}]
	set vector [$b buildVector $objv $types $arguments $argvals]
	set flags [$b buildBitArray $bitv $expandPositions]

	$b invokeExpandedNRE $vector $flags [expr {callframe($thecallframe)}] \
	    $callframe $errorCode $vname]

	# For an invoked command, we didn't launch another LLVM coroutine, and
	# the Tcl status and command return value will appear in the current
	# coroutine's promise.

	set result [dict get $coro_info coro_handle]
	if {callframe($thecallframe)} {
	    set result [$b frame.pack $callframe $result]
	}
	my StoreResult $tgt $result
    }
 
    # TclCompiler:IssueNREReturnFromInvoke --
    #
    #	Generates the code to tidy up after an invoked NRE command returns.
    #
    # Parameters:
    #	callframe - The current callframe

Changes to codegen/coro.tcl.

408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
	set rvaladdr [$b gep $paddr 0 1]
	set rval [$b load $rvaladdr "return.value"]
	$b call [$m intrinsic coro.destroy] [list $handle]
    } else {
	set rval [$b getNRCommandReturnValue $rcode $errorCode "return.value"]
	if {"CALLFRAME" in $tgttype} {
	    # Return from an invoked function may need to restore the callframe
	    $b restoreFrame
	}
    }

    # Return the status and result

    return [list $frame $rcode $rval]
}






|







408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
	set rvaladdr [$b gep $paddr 0 1]
	set rval [$b load $rvaladdr "return.value"]
	$b call [$m intrinsic coro.destroy] [list $handle]
    } else {
	set rval [$b getNRCommandReturnValue $rcode $errorCode "return.value"]
	if {"CALLFRAME" in $tgttype} {
	    # Return from an invoked function may need to restore the callframe
	    $b restoreFrame $frame
	}
    }

    # Return the status and result

    return [list $frame $rcode $rval]
}

Changes to codegen/mathlib.tcl.

934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
....
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
	build {
	    set r0 [my int 1 "result.enter"]
	    set n0 [my getInt64 $y "n.enter"]
	    # These are stand-ins for values that we've not generated yet
	    my br $loop(test)
	label loop(test) "loop.test"
	    set sources {$entry $loop(double)}
	    set thisn [PHI [Type int64] {$n0 $nLoop} $sources "n.test"]
	    set xbody [PHI [Type INT] {$x $xLoop} $sources "x.test"]
	    set result [PHI [Type INT] {$r0 $rLoop} $sources "result.test"]
	    my condBr [my neq $thisn $0] $loop(bit0) $loop(result)
	label loop(result) "result"
	    my ret $result
	label loop(bit0) "loop.bit0"
	    my condBr [my cmpInt [my and $thisn $1] NE $0] \
		$loop(mult) $loop(double)
	label loop(mult) "loop.mult"
................................................................................
	    set b2 [$api Tcl_GetString $value]
	    SetValueName $b2 "bytes"
	    my br $get
	label get:
	    set bytes [my phi [list $b1 $b2] [list $entry $generate] "bytes"]
	    my ret [my eq [my dereference $bytes 0] [Const 0 int8]]
	}


	##### Function tcl.isNumeric #####
	#
	# Type signature: value:STRING -> ZEROONE
	#
	# Tests if a STRING can be parsed as a NUMERIC. Part of the
	# implementation of quadcode "instanceOf".






|
|
|







 







<







934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
....
1311
1312
1313
1314
1315
1316
1317

1318
1319
1320
1321
1322
1323
1324
	build {
	    set r0 [my int 1 "result.enter"]
	    set n0 [my getInt64 $y "n.enter"]
	    # These are stand-ins for values that we've not generated yet
	    my br $loop(test)
	label loop(test) "loop.test"
	    set sources {$entry $loop(double)}
	    set thisn [PHI int64 {$n0 $nLoop} $sources "n.test"]
	    set xbody [PHI INT {$x $xLoop} $sources "x.test"]
	    set result [PHI INT {$r0 $rLoop} $sources "result.test"]
	    my condBr [my neq $thisn $0] $loop(bit0) $loop(result)
	label loop(result) "result"
	    my ret $result
	label loop(bit0) "loop.bit0"
	    my condBr [my cmpInt [my and $thisn $1] NE $0] \
		$loop(mult) $loop(double)
	label loop(mult) "loop.mult"
................................................................................
	    set b2 [$api Tcl_GetString $value]
	    SetValueName $b2 "bytes"
	    my br $get
	label get:
	    set bytes [my phi [list $b1 $b2] [list $entry $generate] "bytes"]
	    my ret [my eq [my dereference $bytes 0] [Const 0 int8]]
	}


	##### Function tcl.isNumeric #####
	#
	# Type signature: value:STRING -> ZEROONE
	#
	# Tests if a STRING can be parsed as a NUMERIC. Part of the
	# implementation of quadcode "instanceOf".

Changes to codegen/stdlib.tcl.

57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
...
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
...
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
....
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
....
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
....
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
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
....
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
....
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
....
2766
2767
2768
2769
2770
2771
2772
2773

2774
2775
2776
2777
2778
2779
2780
....
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
2833
2834
2835
2836
2837
2838
....
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
....
4333
4334
4335
4336
4337
4338
4339
4340
4341
4342
4343
4344
4345
4346
4347
....
4365
4366
4367
4368
4369
4370
4371
4372
4373
4374
4375
4376
4377
4378
4379
4380
4381
4382
4383
4384
4385
4386
4387
4388
4389
4390
4391
4392
4393
....
4401
4402
4403
4404
4405
4406
4407


4408
4409
4410
4411
4412
4413
4414
4415
4416
4417
4418
4419
....
4420
4421
4422
4423
4424
4425
4426
4427
4428
4429
4430
4431
4432
4433
4434
4435
4436
....
4512
4513
4514
4515
4516
4517
4518
4519



























































































4520
4521
4522
4523
4524
4525
4526
4527
4528
4529
....
4657
4658
4659
4660
4661
4662
4663
4664
4665
4666
4667
4668
4669
4670
4671
4672
4673
4674
4675
4676
4677
4678
4679
4680
4681
4682
4683
....
4691
4692
4693
4694
4695
4696
4697
4698
4699
4700
4701
4702
4703
4704
4705
4706
4707
4708
4709
4710
4711
4712
4713
    # Variables holding implementations of Tcl's exception-handling machinery
    variable tcl.getresult tcl.getreturnopts tcl.initExceptionOptions
    variable tcl.initExceptionSimple tcl.processReturn tcl.procedure.return
    variable tcl.setErrorLine tcl.existsOrError tcl.logCommandInfo
    variable tcl.handleExceptionResult tcl.invoke.command
    variable tcl.invoke.command.nre tcl.nr.command.result tcl.invoke.expanded
    variable tcl.restoreFrame

    # Helper functions
    variable tcl.impl.trimleft tcl.impl.trimright obj.cleanup
    variable tcl.impl.getIndex tcl.impl.listDupe
    variable tcl.alloc tcl.free
    variable tcl.vector.clear

................................................................................
	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 --
    #
................................................................................
		[my insert $res [my neq [my load $boolVar "bool"] [Const 0]] 1]
	    my ret $res
	}
	my closure GetBoolean {valueObj} {
	    my call ${tcl.impl.getBoolean} [list $valueObj] "result"
	}
	unset -nocomplain valueObj
	

	##### Function tcl.impl.getDouble #####
	##### MAPPED CALL TO METHOD: Build:GetDouble #####
	#
	# Type signature: valueObj:STRING -> int * int8[]
	#
	# Gets the (pseudo-)UTF-8 version of a string. Wrapper around Tcl API
................................................................................
	    my condBr [my eq $numBytes $0] $ret0 $checkTrim
	label checkTrim:
	    my condBr [my eq $numTrim $0] $ret0 $outerLoop
	label ret0:
	    my ret $0
	label outerLoop:
	    set sources {$checkTrim $nextOuter}
	    set p [PHI [Type char*] {$bytes $pLoop} $sources "p"]
	    set numBytes2 [PHI [Type int] {$numBytes $nbLoop} $sources \
			      "numBytes.2"]
	    set pInc [$api Tcl_UtfToUniChar $p $chVar]
	    SetValueName $pInc "pInc"
	    set ch1 [my load $chVar "ch1"]
	    my br $innerLoop
	label innerLoop:
	    set sources [list $outerLoop $nextInner]
	    set q [PHI [Type char*] {$trim $qLoop} $sources "q"]
	    set bytesLeft [PHI [Type int] {$numTrim $blLoop} $sources \
			       "bytesLeft"]
	    set qInc [$api Tcl_UtfToUniChar $q $chVar]
	    SetValueName $qInc "qInc"
	    set ch2 [my load $chVar "ch2"]
	    my condBr [my eq $ch1 $ch2] $doneInner $nextInner
	label nextInner:
	    set qLoop [my getelementptr $q [list $qInc] "q"]
	    set blLoop [set bytesLeft2 [my sub $bytesLeft $qInc "bytesLeft"]]
................................................................................
	    my condBr [my eq $numBytes $0] $ret0 $checkTrim
	label checkTrim:
	    my condBr [my eq $numTrim $0] $ret0 $outerLoop
	label ret0:
	    my ret $0
	label outerLoop:
	    set sources [list $checkTrim $nextOuter]
	    set p1 [PHI [Type char*] {$p0 $pLoop} $sources "p.1"]
	    set numBytes1 [PHI [Type int] {$numBytes $nbLoop} $sources \
			       "numBytes.1"]
	    set p2 [$api Tcl_UtfPrev $p1 $bytes]
	    SetValueName $p2 "p.2"
	    set pInc [$api Tcl_UtfToUniChar $p2 $chVar]
	    SetValueName $pInc "pInc"
	    set ch1 [my load $chVar "ch1"]
	    my br $innerLoop
	label innerLoop:
	    set sources [list $outerLoop $nextInner]
	    set q [PHI [Type char*] {$trim $qLoop} $sources "q"]
	    set bytesLeft [PHI [Type int] {$numTrim $blLoop} $sources \
			       "bytesLeft"]
	    set qInc [$api Tcl_UtfToUniChar $q $chVar]
	    SetValueName $qInc "qInc"
	    set ch2 [my load $chVar "ch2"]
	    my condBr [my eq $ch1 $ch2] $doneInner $nextInner
	label doneInner:
	    my condBr [my le $bytesLeft $0] $fixP $nextOuter
	label nextInner:
................................................................................
	    set end [my getelementptr $string [list $length]]
	    my switch $class $xdigit \
		0 $alnum 1 $alpha 2 $ascii 3 $control \
		4 $digit 5 $graph 6 $lower 7 $print \
		8 $punct 9 $space 10 $upper 11 $word
	    set n [list $1]
	label alnum:
	    set p [PHI [Type int16*] {$string $p0} {$test $alnumNext} "p"]
	    my condBr [my neq [$api Tcl_UniCharIsAlnum [my load $p]] $0] \
		$alnumNext $fail
	label alnumNext "alnum.next"
	    set p0 [my getelementptr $p $n "p.0"]
	    my condBr [my lt $p0 $end] $alnum $match
	label alpha:
	    set p [PHI [Type int16*] {$string $p1} {$test $alphaNext} "p"]
	    my condBr [my neq [$api Tcl_UniCharIsAlpha [my load $p]] $0] \
		$alphaNext $fail
	label alphaNext "alpha.next"
	    set p1 [my getelementptr $p $n "p.1"]
	    my condBr [my lt $p1 $end] $alpha $match
	label ascii:
	    set p [PHI [Type int16*] {$string $p2} {$test $asciiNext} "p"]
	    my condBr [my Call tcl.impl.isAscii [my load $p]] \
		$asciiNext $fail
	label asciiNext "ascii.next"
	    set p2 [my getelementptr $p $n "p.2"]
	    my condBr [my lt $p2 $end] $ascii $match
	label control:
	    set p [PHI [Type int16*] {$string $p3} {$test $controlNext} "p"]
	    my condBr [my neq [$api Tcl_UniCharIsControl [my load $p]] $0] \
		$controlNext $fail
	label controlNext "control.next"
	    set p3 [my getelementptr $p $n "p.3"]
	    my condBr [my lt $p3 $end] $control $match
	label digit:
	    set p [PHI [Type int16*] {$string $p4} {$test $digitNext} "p"]
	    my condBr [my neq [$api Tcl_UniCharIsDigit [my load $p]] $0] \
		$digitNext $fail
	label digitNext "digit.next"
	    set p4 [my getelementptr $p $n "p.4"]
	    my condBr [my lt $p4 $end] $digit $match
	label graph:
	    set p [PHI [Type int16*] {$string $p5} {$test $graphNext} "p"]
	    my condBr [my neq [$api Tcl_UniCharIsGraph [my load $p]] $0] \
		$graphNext $fail
	label graphNext "graph.next"
	    set p5 [my getelementptr $p $n "p.5"]
	    my condBr [my lt $p5 $end] $graph $match
	label lower:
	    set p [PHI [Type int16*] {$string $p6} {$test $lowerNext} "p"]
	    my condBr [my neq [$api Tcl_UniCharIsLower [my load $p]] $0] \
		$lowerNext $fail
	label lowerNext "lower.next"
	    set p6 [my getelementptr $p $n "p.6"]
	    my condBr [my lt $p6 $end] $lower $match
	label print:
	    set p [PHI [Type int16*] {$string $p7} {$test $printNext} "p"]
	    my condBr [my neq [$api Tcl_UniCharIsPrint [my load $p]] $0] \
		$printNext $fail
	label printNext "print.next"
	    set p7 [my getelementptr $p $n "p.7"]
	    my condBr [my lt $p7 $end] $print $match
	label punct:
	    set p [PHI [Type int16*] {$string $p8} {$test $punctNext} "p"]
	    my condBr [my neq [$api Tcl_UniCharIsPunct [my load $p]] $0] \
		$punctNext $fail
	label punctNext "punct.next"
	    set p8 [my getelementptr $p $n "p.8"]
	    my condBr [my lt $p8 $end] $punct $match
	label space:
	    set p [PHI [Type int16*] {$string $p9} {$test $spaceNext} "p"]
	    my condBr [my neq [$api Tcl_UniCharIsSpace [my load $p]] $0] \
		$spaceNext $fail
	label spaceNext "space.next"
	    set p9 [my getelementptr $p $n "p.9"]
	    my condBr [my lt $p9 $end] $space $match
	label upper:
	    set p [PHI [Type int16*] {$string $p10} {$test $upperNext} "p"]
	    my condBr [my neq [$api Tcl_UniCharIsUpper [my load $p]] $0] \
		$upperNext $fail
	label upperNext "upper.next"
	    set p10 [my getelementptr $p $n "p.10"]
	    my condBr [my lt $p10 $end] $upper $match
	label word:
	    set p [PHI [Type int16*] {$string $p11} {$test $wordNext} "p"]
	    my condBr [my neq [$api Tcl_UniCharIsWordChar [my load $p]] $0] \
		$wordNext $fail
	label wordNext "word.next"
	    set p11 [my getelementptr $p $n "p.11"]
	    my condBr [my lt $p11 $end] $word $match
	label xdigit:
	    set p [PHI [Type int16*] {$string $p12} {$test $xdigitNext} "p"]
	    my condBr [my Call tcl.impl.isXdigit [my load $p]] \
		$xdigitNext $fail
	label xdigitNext "xdigit.next"
	    set p12 [my getelementptr $p $n "p.12"]
	    my condBr [my lt $p12 $end] $xdigit $match
	label match:
	    my ret [Const true bool]
................................................................................
	    my condBr [my eq [my dereference $listPtr 0 TclList.refCount] $1] \
		$sublistInplace $sublistNew
	label sublistInplace "sublist.inPlace"
	    set onePast [my add $to $1 "onePast"]
	    my br $sublistInplaceFreeTest
	label sublistInplaceFreeTest "sublist.inPlace.loop.test"
	    set sources {$sublistInplace $sublistInplaceFree}
	    set index [PHI [Type int32] {$onePast $loopIndex} $sources "index"]
	    my condBr [my lt $index $objc] \
		$sublistInplaceFree $sublistInplaceDone
	label sublistInplaceFree "sublist.inPlace.loop.body"
	    set loopIndex [my add $index $1 "index"]
	    set obj [my load [my getelementptr $objv [list $index]] "objPtr"]
	    my dropReference $obj
	    my br $sublistInplaceFreeTest
................................................................................
	    my condBr [my eq [my dereference $listPtr 0 TclList.refCount] $1] \
		$sublistInplace $sublistNew
	label sublistInplace "sublist.inPlace"
	    set onePast [my add $to $1 "onePast"]
	    my br $sublistInplaceFreeTest
	label sublistInplaceFreeTest "sublist.inPlace.free.test"
	    set sources {$sublistInplace $sublistInplaceFree}
	    set index [PHI [Type int32] {$onePast $loopIndex} $sources "index"]
	    my condBr [my lt $index $objc] \
		$sublistInplaceFree $sublistInplaceDone
	label sublistInplaceFree "sublist.inPlace.free"
	    set loopIndex [my add $index $1 "index"]
	    set obj [my load [my getelementptr $objv [list $index]] "objPtr"]
	    my dropReference $obj
	    my br $sublistInplaceFreeTest
................................................................................
	params list idxArg elem ecvar
	build {
	    noalias $ecvar
	    nonnull $list $idxArg $elem $ecvar
	    set ary [my alloc STRING]
	    set argc [my alloc int]
	    set argv [my alloc STRING*]
	    my condBr [my eq [my dereference $idxArg 0 Tcl_Obj.typePtr] [$api tclListType]] \

		$doCopy $checkIndex
	label checkIndex "check.index"
	    my condBr [my GetIndex {} $idxArg $0] $doFlat $doCopy
	label doFlat "flat"
	    my store $idxArg $ary
	    my ret [my Call tcl.list.set $list $1 $ary $elem $ecvar]
	label doCopy "copy"
................................................................................
	    set code [$api Tcl_ListObjGetElements $interp $list $lenVar $objvVar]
	    my condBr [my eq $code $0] $realCheck $fail
	label realCheck:
	    set objc [my load $lenVar "objc"]
	    set objv [my load $objvVar "objv"]
	    my condBr [my gt $objc $0] $loop $done
	label loop:
	    set i [PHI [Type int32] {$0 $iLoop} {$realCheck $loopNext} "i"]
	    set obj [my load [my getelementptr $objv [list $i]] "obj"]
	    lassign [my GetString $obj "element"] len2 bytes2
	    my condBr [my eq $len1 $len2] $loopCompare $loopNext
	label loopCompare:
	    my condBr [my eq [my memcmp $bytes1 $bytes2 $len1] $0] \
		$done $loopNext
	label loopNext:
	    set iLoop [set i [my add $i $1 "i"]]
	    my condBr [my lt $i $objc] $loop $done
	label fail:
	    my store $1 $ecVar
	    my ret [my fail ZEROONE]
	label done:
	    set flag [my phi [list [Const false bool] [Const false bool] [Const true bool]] \
		    [list $realCheck $loopNext $loopCompare] "flag"]
	    my ret [my ok $flag]
	}

	##### Function tcl.list.unshare #####
	#
	# Type signature: list:STRING -> STRING
................................................................................
	    my ret [my fail FOREACH]
	label success:
	    set pair [my undef FOREACH]
	    set pair [my insert $pair $0 FOREACH.val]
	    set pair [my insert $pair [my unmaybe $steps] FOREACH.max]
	    my ret [my ok $pair]
	}


	##### Function tcl.list.foreach.getStep #####
	#
	# Type signature: pair:FOREACH -> INT
	#
	# Core of quadcode implementation ('foreachIter')
	#
................................................................................
	params objPtr
	build {
	    nonnull $objPtr
	    set NULL [my null Interp*]
	    set code [my setFromAny [$api tclBooleanType] $NULL $objPtr]
	    my ret [my eq $code $0]
	}
	

	##### Function tcl.invoke.command #####
	#
	# Type signature: objc:int * objv:STRING* * ecvar:int* -> STRING?
	#
	# Calls the Tcl interpreter to invoke a Tcl command, and packs the
	# result into a STRING FAIL.
................................................................................
	    my store $vf $vfp
	    my condBr [my eq $code2 $0] $ok $fail
	label ok:
	    set result [$api Tcl_GetObjResult $interp]
	    my addReference(STRING) $result
	    my ret [my ok $result]
	label fail:
	    set code [my phi [list $code1 $code2] [list $stdInvoke $frameInvoke] "code"]
	    my store $code $ecvar
	    my ret [my fail STRING $code]
	}

	##### Function tcl.invoke.command.nre #####
	#
	# Type signature: objc:int × objv:STRING* × frame:CALLFRAME × ecvar:int*
	#                        -> CALLFRAME
	#
	# Calls the Tcl interpreter to invoke a Tcl command by means of
	# Tcl_NREvalObjv.
	#
	# Returns the callframe before the invocation if the callframe was
	# swizzled to do the invoke, NULL otherwise.

	set f [$module local "tcl.invoke.command.nre" \
		   CALLFRAME<-int,STRING*,CALLFRAME,int*]
	params objc objv frame ecvar
	build {
	    noalias $objv $frame $ecvar
	    nonnull $objv $ecvar
................................................................................
	    set vf [my load $vfp]
	    my store $frame $vfp
	    $api Tcl_NREvalObjv $interp $objc $objv $0
	    my ret $vf
	}

	##### Function tcl.nr.command.result #####


	#
	# Retrieves the value of a command invoked by tcl.invoke.command.nre
	# after the command has returned.
	#
	# Type signature: ecode:int × ecvar:int* -> STRING?

	set f [$module local "tcl.nr.command.result" STRING?<-int,int*]
	params ecode ecvar
	build {
	    noalias $ecvar
	    nonnull $ecvar
	    my condBr [my eq $ecode $0] $ok $fail
................................................................................
	label ok:
	    set result [$api Tcl_GetObjResult [$api tclInterp]]
	    my addReference(STRING) $result
	    my ret [my ok $result]
	label fail:
	    my store $ecode $ecvar
	    my ret [my fail STRING $ecode]

	}


	##### Function tcl.invoke.expanded #####
	#
	# Type signature: objc:int * objv:STRING* * flags:bool* * ecvar:int*
	#			-> STRING?
	#
	# Calls the Tcl interpreter to invoke a Tcl command, first expanding
................................................................................
	    set result [$api Tcl_GetObjResult $interp]
	    my addReference(STRING) $result
	    my ret [my ok $result]
	label fail:
	    my store $code $ecvar
	    my ret [my fail STRING $code]
	}




























































































	##### Function tcl.restoreFrame #####
	#
	# Type signature: frame:CALLFRAME->void
	#
	# Restores the callframe pointer when returning from a Tcl_NRAddCallback
	# chain.

	set f [$module local "tcl.restoreFrame" void<-CALLFRAME]
	params frame
	build {
................................................................................
	my @coroFunctions $api

	##### Function: tcl.alloc #####
	#
	# Type signature: size:int32->char*
	#
	# Returns a pointer to allocated memory
	
	set f [$module local tcl.alloc char*<-int32]
	params size
	build {
	    my ret [$api Tcl_Alloc $size]
	}

	##### Function: tcl.free #####
	#
	# Type signature: char*->void
	#
	# Frees a block of memory allocated by Tcl_Alloc
	
	set f [$module local tcl.free void<-char*]
	params p
	build {
	    $api Tcl_Free $p
	    my ret
	}

................................................................................
	set f [$module local tcl.vector.clear void<-int,STRING*]
	params objc objv
	build {
	    my br $entry
        label entry:
	    my br $loop
	label loop:
	    set objc.loop [my phi [list $objc] [list $entry] "objc.loop"]
	    set ok [my cmpInt ${objc.loop} SGT [Const 0 int] "objc.gt.0"]
	    my condBr $ok $freeOne $done
	label freeOne:
	    set objc.decr [my sub ${objc.loop} [Const 1 int] "objc.decr"]
	    set toDropPtr [my getelementptr $objv ${objc.decr} "objv.at.ind"]
	    set toDrop [my load $toDropPtr "element.to.drop"]
	    my dropReference $toDrop
	    AddIncoming ${objc.loop} [list ${objc.decr}] [my LABEL $freeOne]
	    my br $loop
	label done:
	    my ret
	}

    }







|







 







|








<
<







 







<







 







|
|
<






|
|
<







 







|
|
<








|
|
<







 







|






|






|






|






|






|






|






|






|






|






|






|






|







 







|







 







|







 







|
>







 







|













|







 







<







 







<







 







|










<
<
|
|







 







>
>



<
<







 







|
<
<







 








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


|







 







|











|







 







|







<







57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
...
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435


436
437
438
439
440
441
442
...
761
762
763
764
765
766
767

768
769
770
771
772
773
774
...
999
1000
1001
1002
1003
1004
1005
1006
1007

1008
1009
1010
1011
1012
1013
1014
1015

1016
1017
1018
1019
1020
1021
1022
....
1055
1056
1057
1058
1059
1060
1061
1062
1063

1064
1065
1066
1067
1068
1069
1070
1071
1072
1073

1074
1075
1076
1077
1078
1079
1080
....
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
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
....
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
....
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
....
2759
2760
2761
2762
2763
2764
2765
2766
2767
2768
2769
2770
2771
2772
2773
2774
....
2804
2805
2806
2807
2808
2809
2810
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
2826
2827
2828
2829
2830
2831
2832
....
2909
2910
2911
2912
2913
2914
2915

2916
2917
2918
2919
2920
2921
2922
....
4326
4327
4328
4329
4330
4331
4332

4333
4334
4335
4336
4337
4338
4339
....
4357
4358
4359
4360
4361
4362
4363
4364
4365
4366
4367
4368
4369
4370
4371
4372
4373
4374


4375
4376
4377
4378
4379
4380
4381
4382
4383
....
4391
4392
4393
4394
4395
4396
4397
4398
4399
4400
4401
4402


4403
4404
4405
4406
4407
4408
4409
....
4410
4411
4412
4413
4414
4415
4416
4417


4418
4419
4420
4421
4422
4423
4424
....
4500
4501
4502
4503
4504
4505
4506
4507
4508
4509
4510
4511
4512
4513
4514
4515
4516
4517
4518
4519
4520
4521
4522
4523
4524
4525
4526
4527
4528
4529
4530
4531
4532
4533
4534
4535
4536
4537
4538
4539
4540
4541
4542
4543
4544
4545
4546
4547
4548
4549
4550
4551
4552
4553
4554
4555
4556
4557
4558
4559
4560
4561
4562
4563
4564
4565
4566
4567
4568
4569
4570
4571
4572
4573
4574
4575
4576
4577
4578
4579
4580
4581
4582
4583
4584
4585
4586
4587
4588
4589
4590
4591
4592
4593
4594
4595
4596
4597
4598
4599
4600
4601
4602
4603
4604
4605
4606
4607
4608
....
4736
4737
4738
4739
4740
4741
4742
4743
4744
4745
4746
4747
4748
4749
4750
4751
4752
4753
4754
4755
4756
4757
4758
4759
4760
4761
4762
....
4770
4771
4772
4773
4774
4775
4776
4777
4778
4779
4780
4781
4782
4783
4784

4785
4786
4787
4788
4789
4790
4791
    # Variables holding implementations of Tcl's exception-handling machinery
    variable tcl.getresult tcl.getreturnopts tcl.initExceptionOptions
    variable tcl.initExceptionSimple tcl.processReturn tcl.procedure.return
    variable tcl.setErrorLine tcl.existsOrError tcl.logCommandInfo
    variable tcl.handleExceptionResult tcl.invoke.command
    variable tcl.invoke.command.nre tcl.nr.command.result tcl.invoke.expanded
    variable tcl.invoke.expanded.nre tcl.restoreFrame

    # Helper functions
    variable tcl.impl.trimleft tcl.impl.trimright obj.cleanup
    variable tcl.impl.getIndex tcl.impl.listDupe
    variable tcl.alloc tcl.free
    variable tcl.vector.clear

................................................................................
	params objc objv
	build {
	    nonnull $objv
	    my br $entry
	label entry:
	    my br $loop
	label loop:
	    set count_loop [PHI int {$objc $count_freeOne} {$entry $freeOne} "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


	}

	return
    }
 
    # Builder:StringFunctions --
    #
................................................................................
		[my insert $res [my neq [my load $boolVar "bool"] [Const 0]] 1]
	    my ret $res
	}
	my closure GetBoolean {valueObj} {
	    my call ${tcl.impl.getBoolean} [list $valueObj] "result"
	}
	unset -nocomplain valueObj


	##### Function tcl.impl.getDouble #####
	##### MAPPED CALL TO METHOD: Build:GetDouble #####
	#
	# Type signature: valueObj:STRING -> int * int8[]
	#
	# Gets the (pseudo-)UTF-8 version of a string. Wrapper around Tcl API
................................................................................
	    my condBr [my eq $numBytes $0] $ret0 $checkTrim
	label checkTrim:
	    my condBr [my eq $numTrim $0] $ret0 $outerLoop
	label ret0:
	    my ret $0
	label outerLoop:
	    set sources {$checkTrim $nextOuter}
	    set p [PHI char* {$bytes $pLoop} $sources "p"]
	    set numBytes2 [PHI int {$numBytes $nbLoop} $sources "numBytes.2"]

	    set pInc [$api Tcl_UtfToUniChar $p $chVar]
	    SetValueName $pInc "pInc"
	    set ch1 [my load $chVar "ch1"]
	    my br $innerLoop
	label innerLoop:
	    set sources [list $outerLoop $nextInner]
	    set q [PHI char* {$trim $qLoop} $sources "q"]
	    set bytesLeft [PHI int {$numTrim $blLoop} $sources "bytesLeft"]

	    set qInc [$api Tcl_UtfToUniChar $q $chVar]
	    SetValueName $qInc "qInc"
	    set ch2 [my load $chVar "ch2"]
	    my condBr [my eq $ch1 $ch2] $doneInner $nextInner
	label nextInner:
	    set qLoop [my getelementptr $q [list $qInc] "q"]
	    set blLoop [set bytesLeft2 [my sub $bytesLeft $qInc "bytesLeft"]]
................................................................................
	    my condBr [my eq $numBytes $0] $ret0 $checkTrim
	label checkTrim:
	    my condBr [my eq $numTrim $0] $ret0 $outerLoop
	label ret0:
	    my ret $0
	label outerLoop:
	    set sources [list $checkTrim $nextOuter]
	    set p1 [PHI char* {$p0 $pLoop} $sources "p.1"]
	    set numBytes1 [PHI int {$numBytes $nbLoop} $sources "numBytes.1"]

	    set p2 [$api Tcl_UtfPrev $p1 $bytes]
	    SetValueName $p2 "p.2"
	    set pInc [$api Tcl_UtfToUniChar $p2 $chVar]
	    SetValueName $pInc "pInc"
	    set ch1 [my load $chVar "ch1"]
	    my br $innerLoop
	label innerLoop:
	    set sources [list $outerLoop $nextInner]
	    set q [PHI char* {$trim $qLoop} $sources "q"]
	    set bytesLeft [PHI int {$numTrim $blLoop} $sources "bytesLeft"]

	    set qInc [$api Tcl_UtfToUniChar $q $chVar]
	    SetValueName $qInc "qInc"
	    set ch2 [my load $chVar "ch2"]
	    my condBr [my eq $ch1 $ch2] $doneInner $nextInner
	label doneInner:
	    my condBr [my le $bytesLeft $0] $fixP $nextOuter
	label nextInner:
................................................................................
	    set end [my getelementptr $string [list $length]]
	    my switch $class $xdigit \
		0 $alnum 1 $alpha 2 $ascii 3 $control \
		4 $digit 5 $graph 6 $lower 7 $print \
		8 $punct 9 $space 10 $upper 11 $word
	    set n [list $1]
	label alnum:
	    set p [PHI int16* {$string $p0} {$test $alnumNext} "p"]
	    my condBr [my neq [$api Tcl_UniCharIsAlnum [my load $p]] $0] \
		$alnumNext $fail
	label alnumNext "alnum.next"
	    set p0 [my getelementptr $p $n "p.0"]
	    my condBr [my lt $p0 $end] $alnum $match
	label alpha:
	    set p [PHI int16* {$string $p1} {$test $alphaNext} "p"]
	    my condBr [my neq [$api Tcl_UniCharIsAlpha [my load $p]] $0] \
		$alphaNext $fail
	label alphaNext "alpha.next"
	    set p1 [my getelementptr $p $n "p.1"]
	    my condBr [my lt $p1 $end] $alpha $match
	label ascii:
	    set p [PHI int16* {$string $p2} {$test $asciiNext} "p"]
	    my condBr [my Call tcl.impl.isAscii [my load $p]] \
		$asciiNext $fail
	label asciiNext "ascii.next"
	    set p2 [my getelementptr $p $n "p.2"]
	    my condBr [my lt $p2 $end] $ascii $match
	label control:
	    set p [PHI int16* {$string $p3} {$test $controlNext} "p"]
	    my condBr [my neq [$api Tcl_UniCharIsControl [my load $p]] $0] \
		$controlNext $fail
	label controlNext "control.next"
	    set p3 [my getelementptr $p $n "p.3"]
	    my condBr [my lt $p3 $end] $control $match
	label digit:
	    set p [PHI int16* {$string $p4} {$test $digitNext} "p"]
	    my condBr [my neq [$api Tcl_UniCharIsDigit [my load $p]] $0] \
		$digitNext $fail
	label digitNext "digit.next"
	    set p4 [my getelementptr $p $n "p.4"]
	    my condBr [my lt $p4 $end] $digit $match
	label graph:
	    set p [PHI int16* {$string $p5} {$test $graphNext} "p"]
	    my condBr [my neq [$api Tcl_UniCharIsGraph [my load $p]] $0] \
		$graphNext $fail
	label graphNext "graph.next"
	    set p5 [my getelementptr $p $n "p.5"]
	    my condBr [my lt $p5 $end] $graph $match
	label lower:
	    set p [PHI int16* {$string $p6} {$test $lowerNext} "p"]
	    my condBr [my neq [$api Tcl_UniCharIsLower [my load $p]] $0] \
		$lowerNext $fail
	label lowerNext "lower.next"
	    set p6 [my getelementptr $p $n "p.6"]
	    my condBr [my lt $p6 $end] $lower $match
	label print:
	    set p [PHI int16* {$string $p7} {$test $printNext} "p"]
	    my condBr [my neq [$api Tcl_UniCharIsPrint [my load $p]] $0] \
		$printNext $fail
	label printNext "print.next"
	    set p7 [my getelementptr $p $n "p.7"]
	    my condBr [my lt $p7 $end] $print $match
	label punct:
	    set p [PHI int16* {$string $p8} {$test $punctNext} "p"]
	    my condBr [my neq [$api Tcl_UniCharIsPunct [my load $p]] $0] \
		$punctNext $fail
	label punctNext "punct.next"
	    set p8 [my getelementptr $p $n "p.8"]
	    my condBr [my lt $p8 $end] $punct $match
	label space:
	    set p [PHI int16* {$string $p9} {$test $spaceNext} "p"]
	    my condBr [my neq [$api Tcl_UniCharIsSpace [my load $p]] $0] \
		$spaceNext $fail
	label spaceNext "space.next"
	    set p9 [my getelementptr $p $n "p.9"]
	    my condBr [my lt $p9 $end] $space $match
	label upper:
	    set p [PHI int16* {$string $p10} {$test $upperNext} "p"]
	    my condBr [my neq [$api Tcl_UniCharIsUpper [my load $p]] $0] \
		$upperNext $fail
	label upperNext "upper.next"
	    set p10 [my getelementptr $p $n "p.10"]
	    my condBr [my lt $p10 $end] $upper $match
	label word:
	    set p [PHI int16* {$string $p11} {$test $wordNext} "p"]
	    my condBr [my neq [$api Tcl_UniCharIsWordChar [my load $p]] $0] \
		$wordNext $fail
	label wordNext "word.next"
	    set p11 [my getelementptr $p $n "p.11"]
	    my condBr [my lt $p11 $end] $word $match
	label xdigit:
	    set p [PHI int16* {$string $p12} {$test $xdigitNext} "p"]
	    my condBr [my Call tcl.impl.isXdigit [my load $p]] \
		$xdigitNext $fail
	label xdigitNext "xdigit.next"
	    set p12 [my getelementptr $p $n "p.12"]
	    my condBr [my lt $p12 $end] $xdigit $match
	label match:
	    my ret [Const true bool]
................................................................................
	    my condBr [my eq [my dereference $listPtr 0 TclList.refCount] $1] \
		$sublistInplace $sublistNew
	label sublistInplace "sublist.inPlace"
	    set onePast [my add $to $1 "onePast"]
	    my br $sublistInplaceFreeTest
	label sublistInplaceFreeTest "sublist.inPlace.loop.test"
	    set sources {$sublistInplace $sublistInplaceFree}
	    set index [PHI int32 {$onePast $loopIndex} $sources "index"]
	    my condBr [my lt $index $objc] \
		$sublistInplaceFree $sublistInplaceDone
	label sublistInplaceFree "sublist.inPlace.loop.body"
	    set loopIndex [my add $index $1 "index"]
	    set obj [my load [my getelementptr $objv [list $index]] "objPtr"]
	    my dropReference $obj
	    my br $sublistInplaceFreeTest
................................................................................
	    my condBr [my eq [my dereference $listPtr 0 TclList.refCount] $1] \
		$sublistInplace $sublistNew
	label sublistInplace "sublist.inPlace"
	    set onePast [my add $to $1 "onePast"]
	    my br $sublistInplaceFreeTest
	label sublistInplaceFreeTest "sublist.inPlace.free.test"
	    set sources {$sublistInplace $sublistInplaceFree}
	    set index [PHI int32 {$onePast $loopIndex} $sources "index"]
	    my condBr [my lt $index $objc] \
		$sublistInplaceFree $sublistInplaceDone
	label sublistInplaceFree "sublist.inPlace.free"
	    set loopIndex [my add $index $1 "index"]
	    set obj [my load [my getelementptr $objv [list $index]] "objPtr"]
	    my dropReference $obj
	    my br $sublistInplaceFreeTest
................................................................................
	params list idxArg elem ecvar
	build {
	    noalias $ecvar
	    nonnull $list $idxArg $elem $ecvar
	    set ary [my alloc STRING]
	    set argc [my alloc int]
	    set argv [my alloc STRING*]
	    my condBr [my eq [my dereference $idxArg 0 Tcl_Obj.typePtr] \
			   [$api tclListType]] \
		$doCopy $checkIndex
	label checkIndex "check.index"
	    my condBr [my GetIndex {} $idxArg $0] $doFlat $doCopy
	label doFlat "flat"
	    my store $idxArg $ary
	    my ret [my Call tcl.list.set $list $1 $ary $elem $ecvar]
	label doCopy "copy"
................................................................................
	    set code [$api Tcl_ListObjGetElements $interp $list $lenVar $objvVar]
	    my condBr [my eq $code $0] $realCheck $fail
	label realCheck:
	    set objc [my load $lenVar "objc"]
	    set objv [my load $objvVar "objv"]
	    my condBr [my gt $objc $0] $loop $done
	label loop:
	    set i [PHI int32 {$0 $iLoop} {$realCheck $loopNext} "i"]
	    set obj [my load [my getelementptr $objv [list $i]] "obj"]
	    lassign [my GetString $obj "element"] len2 bytes2
	    my condBr [my eq $len1 $len2] $loopCompare $loopNext
	label loopCompare:
	    my condBr [my eq [my memcmp $bytes1 $bytes2 $len1] $0] \
		$done $loopNext
	label loopNext:
	    set iLoop [set i [my add $i $1 "i"]]
	    my condBr [my lt $i $objc] $loop $done
	label fail:
	    my store $1 $ecVar
	    my ret [my fail ZEROONE]
	label done:
	    set flag [my phi [lmap flag {false false true} {Const $flag bool}] \
		    [list $realCheck $loopNext $loopCompare] "flag"]
	    my ret [my ok $flag]
	}

	##### Function tcl.list.unshare #####
	#
	# Type signature: list:STRING -> STRING
................................................................................
	    my ret [my fail FOREACH]
	label success:
	    set pair [my undef FOREACH]
	    set pair [my insert $pair $0 FOREACH.val]
	    set pair [my insert $pair [my unmaybe $steps] FOREACH.max]
	    my ret [my ok $pair]
	}


	##### Function tcl.list.foreach.getStep #####
	#
	# Type signature: pair:FOREACH -> INT
	#
	# Core of quadcode implementation ('foreachIter')
	#
................................................................................
	params objPtr
	build {
	    nonnull $objPtr
	    set NULL [my null Interp*]
	    set code [my setFromAny [$api tclBooleanType] $NULL $objPtr]
	    my ret [my eq $code $0]
	}


	##### Function tcl.invoke.command #####
	#
	# Type signature: objc:int * objv:STRING* * ecvar:int* -> STRING?
	#
	# Calls the Tcl interpreter to invoke a Tcl command, and packs the
	# result into a STRING FAIL.
................................................................................
	    my store $vf $vfp
	    my condBr [my eq $code2 $0] $ok $fail
	label ok:
	    set result [$api Tcl_GetObjResult $interp]
	    my addReference(STRING) $result
	    my ret [my ok $result]
	label fail:
	    set code [PHI int {$code1 $code2} {$stdInvoke $frameInvoke} "code"]
	    my store $code $ecvar
	    my ret [my fail STRING $code]
	}

	##### Function tcl.invoke.command.nre #####
	#
	# Type signature: objc:int × objv:STRING* × frame:CALLFRAME × ecvar:int*
	#                        -> CALLFRAME
	#
	# Calls the Tcl interpreter to invoke a Tcl command by means of


	# Tcl_NREvalObjv. Returns the callframe before the invocation if the
	# callframe was swizzled to do the invoke, NULL otherwise.

	set f [$module local "tcl.invoke.command.nre" \
		   CALLFRAME<-int,STRING*,CALLFRAME,int*]
	params objc objv frame ecvar
	build {
	    noalias $objv $frame $ecvar
	    nonnull $objv $ecvar
................................................................................
	    set vf [my load $vfp]
	    my store $frame $vfp
	    $api Tcl_NREvalObjv $interp $objc $objv $0
	    my ret $vf
	}

	##### Function tcl.nr.command.result #####
	#
	# Type signature: ecode:int × ecvar:int* -> STRING?
	#
	# Retrieves the value of a command invoked by tcl.invoke.command.nre
	# after the command has returned.



	set f [$module local "tcl.nr.command.result" STRING?<-int,int*]
	params ecode ecvar
	build {
	    noalias $ecvar
	    nonnull $ecvar
	    my condBr [my eq $ecode $0] $ok $fail
................................................................................
	label ok:
	    set result [$api Tcl_GetObjResult [$api tclInterp]]
	    my addReference(STRING) $result
	    my ret [my ok $result]
	label fail:
	    my store $ecode $ecvar
	    my ret [my fail STRING $ecode]
	}



	##### Function tcl.invoke.expanded #####
	#
	# Type signature: objc:int * objv:STRING* * flags:bool* * ecvar:int*
	#			-> STRING?
	#
	# Calls the Tcl interpreter to invoke a Tcl command, first expanding
................................................................................
	    set result [$api Tcl_GetObjResult $interp]
	    my addReference(STRING) $result
	    my ret [my ok $result]
	label fail:
	    my store $code $ecvar
	    my ret [my fail STRING $code]
	}

	##### Function tcl.invoke.expanded.nre #####
	#
	# Type signature: objc:int * objv:STRING* * flags:bool*
	#			* frame:CALLFRAME * ecvar:int* -> CALLFRAME
	#
	# Calls the Tcl interpreter to invoke a Tcl command by means of
	# Tcl_NREvalObjv, first expanding the arguments indicate by the flags
	# array (which will have objc elements in it). Returns the callframe
	# before the invocation if the callframe was swizzled to do the
	# invoke, NULL otherwise.

	set f [$module local "tcl.invoke.expanded.nre" \
		   CALLFRAME<-int,STRING*,bool*,CALLFRAME,int*]
	params objc objv flags frame ecvar
	build {
	    noalias $objv $flags $frame $ecvar
	    nonnull $objv $flags $ecvar
	    set iPtr [my alloc int "i"]
	    set jPtr [my alloc int "j"]
	    set lenPtr [my alloc int "len"]
	    set objcPtr [my alloc int "objcPtr"]
	    set objvPtr [my alloc STRING* "objvPtr"]
	    set tclobjSize [my cast(int) [my sizeof STRING]]
	    set interp [$api tclInterp]
	    my store $0 $iPtr
	    my store $0 $lenPtr
	    my br $findLenTest
	label findLenTest "test.findLength"
	    set i [my load $iPtr "i"]
	    my condBr [my lt $i $objc] $findLenBody $setupExpansion
	label findLenBody "body.findLength"
	    set flag [my load [my getelementptr $flags $i] "flag"]
	    set len [my load $lenPtr "len"]
	    my condBr $flag $findLenExpand $findLenSimple
	label findLenExpand "body.findLength.expand"
	    set obj [my load [my getelementptr $objv $i] "objPtr"]
	    $api Tcl_ListObjLength {} $obj $objcPtr
	    set lenstep1 [my load $objcPtr "lenStep"]
	    my br $findLenNext
	label findLenSimple "body.findLength.simple"
	    set lenstep2 $1
	    my br $findLenNext
	label findLenNext "next.findLength"
	    set lenstep [my phi [list $lenstep1 $lenstep2] \
			     [list $findLenExpand $findLenSimple] "lenStep"]
	    my store [my add $len $lenstep] $lenPtr
	    my store [my add $i $1] $iPtr
	    my br $findLenTest
	label setupExpansion "setup.expansion"
	    set len [my load $lenPtr "len"]
	    # Do not allocate on stack; might be large
	    set ary [$api ckalloc [my mult $len $tclobjSize] STRING "array"]
	    my store $0 $iPtr
	    my store $0 $jPtr
	    my br $expansionTest
	label expansionTest "test.expansion"
	    set i [my load $iPtr "i"]
	    my condBr [my lt $i $objc] $expansionBody $invoke
	label expansionBody "body.expansion"
	    set j [my load $jPtr "j"]
	    set flag [my load [my getelementptr $flags $i] "flag"]
	    set obj [my load [my getelementptr $objv $i] "objPtr"]
	    set target [my getelementptr $ary $j]
	    my condBr $flag $expansionExpand $expansionSimple
	label expansionExpand "body.expansion.expand"
	    $api Tcl_ListObjGetElements {} $obj $objcPtr $objvPtr
	    set srclen [my load $objcPtr "objc"]
	    set source [my load $objvPtr "objv"]
	    my memcpy $target $source [my mult $srclen $tclobjSize]
	    my store [my add $j $srclen] $jPtr
	    my br $expansionNext
	label expansionSimple "body.expansion.simple"
	    my store $obj $target
	    my store [my add $j $1] $jPtr
	    my br $expansionNext
	label expansionNext "next.expansion"
	    my store [my add $i $1] $iPtr
	    my br $expansionTest
	label invoke:
	    my condBr [my nonnull $frame] $frameInvoke $stdInvoke
	label stdInvoke "invoke.standard"
	    $api Tcl_NREvalObjv $interp $len $ary $0
	    my ret [my null CALLFRAME]
	label frameInvoke "invoke.with.callframe"
	    set vfp [my gep $interp 0 Interp.varFramePtr]
	    set vf [my load $vfp]
	    my store $frame $vfp
	    $api Tcl_NREvalObjv $interp $len $ary $0
	    my ret $vf
	}

	##### Function tcl.restoreFrame #####
	#
	# Type signature: frame:CALLFRAME -> void
	#
	# Restores the callframe pointer when returning from a Tcl_NRAddCallback
	# chain.

	set f [$module local "tcl.restoreFrame" void<-CALLFRAME]
	params frame
	build {
................................................................................
	my @coroFunctions $api

	##### Function: tcl.alloc #####
	#
	# Type signature: size:int32->char*
	#
	# Returns a pointer to allocated memory

	set f [$module local tcl.alloc char*<-int32]
	params size
	build {
	    my ret [$api Tcl_Alloc $size]
	}

	##### Function: tcl.free #####
	#
	# Type signature: char*->void
	#
	# Frees a block of memory allocated by Tcl_Alloc

	set f [$module local tcl.free void<-char*]
	params p
	build {
	    $api Tcl_Free $p
	    my ret
	}

................................................................................
	set f [$module local tcl.vector.clear void<-int,STRING*]
	params objc objv
	build {
	    my br $entry
        label entry:
	    my br $loop
	label loop:
	    set objc.loop [PHI int {$objc ${objc.decr}} {$entry $freeOne} "objc.loop"]
	    set ok [my cmpInt ${objc.loop} SGT [Const 0 int] "objc.gt.0"]
	    my condBr $ok $freeOne $done
	label freeOne:
	    set objc.decr [my sub ${objc.loop} [Const 1 int] "objc.decr"]
	    set toDropPtr [my getelementptr $objv ${objc.decr} "objv.at.ind"]
	    set toDrop [my load $toDropPtr "element.to.drop"]
	    my dropReference $toDrop

	    my br $loop
	label done:
	    my ret
	}

    }

Changes to codegen/struct.tcl.

2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
	#
	# Side effects:
	#	Stores data regarding the fixup in the variable '@[email protected]'
	#	in the caller

	proc PHI {type values sources {name {}}} {
	    upvar 1 @[email protected] phis
	    set phi [uplevel 1 [list my phiStub $type $name]]
	    lappend phis $phi $sources $values
	    return $phi
	}

	# FixupPhis --
	#
	#	Backpatch the phi operations generated by PHI to have their






|







2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
	#
	# Side effects:
	#	Stores data regarding the fixup in the variable '@[email protected]'
	#	in the caller

	proc PHI {type values sources {name {}}} {
	    upvar 1 @[email protected] phis
	    set phi [uplevel 1 [list my phiStub [Type $type] $name]]
	    lappend phis $phi $sources $values
	    return $phi
	}

	# FixupPhis --
	#
	#	Backpatch the phi operations generated by PHI to have their