Check-in [41fe6d416f]
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:Add return from invokeExpanded. Add a test case for invokeExpanded. Correct a few comments in the compilation of invokeExpanded.
Timelines: family | ancestors | kbk-nre
Files: files | file ages | folders
SHA3-256: 41fe6d416f1bf770b23e11e8eb96199b24a61b472a50a400aaa34750e599de20
User & Date: kbk 2018-10-23 01:34:13
Context
2018-10-23
01:34
Add return from invokeExpanded. Add a test case for invokeExpanded. Correct a few comments in the compilation of invokeExpanded. Leaf check-in: 41fe6d416f user: kbk tags: kbk-nre
2018-10-21
22:49
Squelch unnecessary test failures. check-in: 35ee4b3111 user: dkf tags: kbk-nre
Changes

Changes to codegen/build.tcl.

4532
4533
4534
4535
4536
4537
4538
4539
4540
4541
4542
4543
4544
4545
4546
....
4558
4559
4560
4561
4562
4563
4564
4565
4566
4567
4568
4569
4570
4571
4572
....
4584
4585
4586
4587
4588
4589
4590
4591
4592
4593
4594
4595
4596
4597
4598
    #	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 invokeNRE {arguments havecf cf ec {resultName ""}} {
	my ExtractVector $arguments
	if {!$havecf} {
	    set cf {}
	}
	my call ${tcl.invoke.command.nre} [list $len $ary $cf $ec] $resultName
................................................................................
    #	flags -	LLVM bit array indicating which arguments to expand.
    #	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 invokeExpanded {arguments flags ec {resultName ""}} {
	my ExtractVector $arguments
	my call ${tcl.invoke.expanded} [list $len $ary $flags $ec] $resultName
    }

    # Builder:invokeExpandedNRE --
................................................................................
    #	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] \






|







 







|







 







|







4532
4533
4534
4535
4536
4537
4538
4539
4540
4541
4542
4543
4544
4545
4546
....
4558
4559
4560
4561
4562
4563
4564
4565
4566
4567
4568
4569
4570
4571
4572
....
4584
4585
4586
4587
4588
4589
4590
4591
4592
4593
4594
4595
4596
4597
4598
    #	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:
    #	None. The command's return value is in the coroutine promise.

    method invokeNRE {arguments havecf cf ec {resultName ""}} {
	my ExtractVector $arguments
	if {!$havecf} {
	    set cf {}
	}
	my call ${tcl.invoke.command.nre} [list $len $ary $cf $ec] $resultName
................................................................................
    #	flags -	LLVM bit array indicating which arguments to expand.
    #	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:
    #	None. The command's return value is in the coroutine promise.

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

    # Builder:invokeExpandedNRE --
................................................................................
    #	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:
    #	None.

    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] \

Changes to codegen/compile.tcl.

902
903
904
905
906
907
908










909
910
911
912
913
914
915
....
1424
1425
1426
1427
1428
1429
1430












1431
1432
1433
1434
1435
1436
1437
		    set arguments [my IssueNREReturnFromInvoke $theframe $l]
		    foreach aa $arguments {
			set arguments [lassign $arguments a]
			if {$a ni $arguments && consumed($a, $pc + 1)} {
			    lappend consumed $a
			}
		    }










		}
		"frameArgs" {
		    lassign $l opcode tgt src
		    set name [my LocalVarName $tgt]
		    set opcode frame.args
		    append opcode ( [my ValueTypes $src] )
		    set val [my LoadOrLiteral $src]
................................................................................
	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]}






>
>
>
>
>
>
>
>
>
>







 







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







902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
....
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
		    set arguments [my IssueNREReturnFromInvoke $theframe $l]
		    foreach aa $arguments {
			set arguments [lassign $arguments a]
			if {$a ni $arguments && consumed($a, $pc + 1)} {
			    lappend consumed $a
			}
		    }
		}
		"NRE.returnFromInvokeExpanded" {
		    set arguments \
			[my IssueNREReturnFromInvokeExpanded $theframe $l]
		    foreach aa $arguments {
			set arguments [lassign $arguments a]
			if {$a ni $arguments && consumed($a, $pc + 1)} {
			    lappend consumed $a
			}
		    }
		}
		"frameArgs" {
		    lassign $l opcode tgt src
		    set name [my LocalVarName $tgt]
		    set opcode frame.args
		    append opcode ( [my ValueTypes $src] )
		    set val [my LoadOrLiteral $src]
................................................................................
	if {callframe($thecallframe)} {
	    set result [$b frame.pack $callframe $result]
	}
	my StoreResult $tgt $result
	$b clearVector $objv $types $arguments
	return $arguments
    }

    # TclCompiler:IssueNREInvokeExpanded --
    #
    #	Issues the codeburst needed to handle invocation with argument
    #	expansion in the NRE environment.
    #
    # Parameters:
    #	callframe - LLVM reference to the call frame
    #	operation - The quadcode operation being compiled
    #
    # Results:
    #	None.

    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]}

Changes to demos/perftest/tester.tcl.

1326
1327
1328
1329
1330
1331
1332





1333
1334
1335
1336
1337
1338
1339
....
2283
2284
2285
2286
2287
2288
2289

2290
2291
2292
2293
2294
2295
2296
....
2491
2492
2493
2494
2495
2496
2497

2498
2499
2500
2501
2502
2503
2504
	return .[rectest3 nn]
    }
}

proc openclose {} {
    close [open /dev/null w]
}






proc treecollect {t} {
    set l {}
    treewalk l $t
    return $l
}
proc treewalk {lvar t} {
................................................................................
    {singleton::llindex}
    {singleton::srange}
    {rectest1}
    {treecollect {a {b {d {h i}} {e {j k}}} {c {f {l m}} {g {n o}}}}}
    {list [catch rectest2 result] $result}
    {set x 3; rectest3 x}
    {openclose}

    {qsort {3 6 8 7 0 1 4 2 9 5}}
    {impure 0x0 0 0}
    {impure 0x3 0 0}
    {impure 0 1 1}
    {impure 10 10000 10}
    {impure 1 +2000 [string range "123" 2 2]}
    {impure-typecheck-int 10 10000 10}
................................................................................
    # Combined feature tests
    lcmRange
    bug-0616bcf08e::*
    rectest1
    rectest2
    rectest3
    openclose

    treecollect
    treewalk
    qsort
    impure
    impure-caller
    impure-typecheck-int
    impure2






>
>
>
>
>







 







>







 







>







1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
....
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
....
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
	return .[rectest3 nn]
    }
}

proc openclose {} {
    close [open /dev/null w]
}

proc openclose2 {lst} {
    close [open {*}$lst]
}
    

proc treecollect {t} {
    set l {}
    treewalk l $t
    return $l
}
proc treewalk {lvar t} {
................................................................................
    {singleton::llindex}
    {singleton::srange}
    {rectest1}
    {treecollect {a {b {d {h i}} {e {j k}}} {c {f {l m}} {g {n o}}}}}
    {list [catch rectest2 result] $result}
    {set x 3; rectest3 x}
    {openclose}
    {openclose2 {/dev/null w}}
    {qsort {3 6 8 7 0 1 4 2 9 5}}
    {impure 0x0 0 0}
    {impure 0x3 0 0}
    {impure 0 1 1}
    {impure 10 10000 10}
    {impure 1 +2000 [string range "123" 2 2]}
    {impure-typecheck-int 10 10000 10}
................................................................................
    # Combined feature tests
    lcmRange
    bug-0616bcf08e::*
    rectest1
    rectest2
    rectest3
    openclose
    openclose2
    treecollect
    treewalk
    qsort
    impure
    impure-caller
    impure-typecheck-int
    impure2