Check-in [fcf84a8631]

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

Overview
Comment:Add NRE test that throws error
Timelines: family | ancestors | descendants | both | notworking | kbk-nre
Files: files | file ages | folders
SHA3-256:fcf84a86318a4a2eacd9774fa651c4bd4e4df24e70c50b92aa5686c2515efc95
User & Date: kbk 2018-04-20 02:26:21
Context
2018-04-23
03:10
Force alignment of coroutine promise to 2*sizeof(pointer), in hopes of getting consistent alignment between coro.begin and later references to the coro frame. (Didn't help, alas, but it doesn't hurt to specify the alignment that's required in any case. check-in: bc3db1940d user: kbk tags: notworking, kbk-nre
2018-04-20
02:26
Add NRE test that throws error check-in: fcf84a8631 user: kbk tags: notworking, kbk-nre
2018-04-18
23:03
Alignment constraints on coroutine intrinsics must be actual integer constants, not just constant expressions of integer type. check-in: d611cc5908 user: kbk tags: notworking, kbk-nre
Changes

Changes to codegen/coro.tcl.

61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
...
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
	# callback.

	set llvm.coro.done [$m intrinsic coro.done]
	set done [my call ${llvm.coro.done} [list ${coro.handle}] "doneFlag"]
	my condBr $done $finished $needResume

    label needResume:
	
	# We will need to resume the coroutine. Stack this callback again so
	# that the next time it suspends, we'll loop back to here.

	$api Tcl_NRAddCallback $interp ${tcl.coro.runner} ${coro.handle} \
	    [my null char*] [my null char*] [my null char*]
    
	# Transfer the interpreter status into the coroutine promise
................................................................................
    set typestr named 
    append typestr \{ $realname .promise
    append typestr , status:int32
    append typestr , retval: [nameOfType $rettype]
    append typestr \}
    return [Type $typestr]
}
 

 
# Builder method launchCoroRunner --
#
#	Generates code to launch the Tcl_NRAddCallback chain that executes
#	the LLVM coroutine representing a Tcl command invocation.
#
# Parameters:







|







 







<
<







61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
...
301
302
303
304
305
306
307


308
309
310
311
312
313
314
	# callback.

	set llvm.coro.done [$m intrinsic coro.done]
	set done [my call ${llvm.coro.done} [list ${coro.handle}] "doneFlag"]
	my condBr $done $finished $needResume

    label needResume:

	# We will need to resume the coroutine. Stack this callback again so
	# that the next time it suspends, we'll loop back to here.

	$api Tcl_NRAddCallback $interp ${tcl.coro.runner} ${coro.handle} \
	    [my null char*] [my null char*] [my null char*]
    
	# Transfer the interpreter status into the coroutine promise
................................................................................
    set typestr named 
    append typestr \{ $realname .promise
    append typestr , status:int32
    append typestr , retval: [nameOfType $rettype]
    append typestr \}
    return [Type $typestr]
}


 
# Builder method launchCoroRunner --
#
#	Generates code to launch the Tcl_NRAddCallback chain that executes
#	the LLVM coroutine representing a Tcl command invocation.
#
# Parameters:

Changes to codegen/thunk.tcl.

143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
		set metathunkblock [$metathunk block createCommands]
		$b br $metathunkblock
		set makingThunks 1
		$metathunkblock build-in $b
	    }
	    set namestr [$b constString $name "name.thunk$name"]
	    if {$wrapper ne ""} {
		my Print [Const "Install NRE command: $namestr" STRING]
		set result [my Tcl_NRCreateCommand $interp $namestr \
				[$wrapper ref] [$func ref] {} {}]
	    } else {
		set result [my Tcl_CreateObjCommand $interp $namestr \
				[$func ref] {} {}]
	    }
	    if {[dict exists $thunkprocmeta $name]} {







<







143
144
145
146
147
148
149

150
151
152
153
154
155
156
		set metathunkblock [$metathunk block createCommands]
		$b br $metathunkblock
		set makingThunks 1
		$metathunkblock build-in $b
	    }
	    set namestr [$b constString $name "name.thunk$name"]
	    if {$wrapper ne ""} {

		set result [my Tcl_NRCreateCommand $interp $namestr \
				[$wrapper ref] [$func ref] {} {}]
	    } else {
		set result [my Tcl_CreateObjCommand $interp $namestr \
				[$func ref] {} {}]
	    }
	    if {[dict exists $thunkprocmeta $name]} {

Changes to demos/perftest/tester.tcl.

1272
1273
1274
1275
1276
1277
1278









1279
1280
1281
1282
1283
1284
1285
....
2202
2203
2204
2205
2206
2207
2208

2209
2210
2211
2212
2213
2214
2215
....
2402
2403
2404
2405
2406
2407
2408

2409
2410
2411
2412
2413
2414
2415
proc rectest1 {{n 3}} {
    if {$n == 0} {
	return {}
    } else {
	return .[rectest1 [expr {$n-1}]]
    }
}










proc qsort {L {left 0} {right -1}} {
    set left [expr {int($left)}]
    set right [expr {int($right)}]
    if {$right < 0} {set right [expr {[llength $L] - 1}]}
    set pivot [lindex $L [expr {($left + $right) / 2}]]

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

    {bug-0616bcf08e::msrange 0 10}
    {bug-0616bcf08e::msrange2 0 10}
    {singleton::lforeach}
    {singleton::llindex}
    {singleton::srange}
    {rectest1}

    {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}
................................................................................
    expandtest::test11
    expandtest::test12

    # Combined feature tests
    lcmRange
    bug-0616bcf08e::*
    rectest1

    qsort
    impure
    impure-caller
    impure-typecheck-int
    impure2
    comps
    bug-7c599d4029::*







>
>
>
>
>
>
>
>
>







 







>







 







>







1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
....
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
....
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
proc rectest1 {{n 3}} {
    if {$n == 0} {
	return {}
    } else {
	return .[rectest1 [expr {$n-1}]]
    }
}

proc rectest2 {{n 3}} {
    if {$n == 0} {
	return -code error "Error thrown from recursive proc"
    } else {
	return .[rectest2 [expr {$n-1}]]
    }
}


proc qsort {L {left 0} {right -1}} {
    set left [expr {int($left)}]
    set right [expr {int($right)}]
    if {$right < 0} {set right [expr {[llength $L] - 1}]}
    set pivot [lindex $L [expr {($left + $right) / 2}]]

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

    {bug-0616bcf08e::msrange 0 10}
    {bug-0616bcf08e::msrange2 0 10}
    {singleton::lforeach}
    {singleton::llindex}
    {singleton::srange}
    {rectest1}
    {list [catch rectest2 result] $result}
    {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}
................................................................................
    expandtest::test11
    expandtest::test12

    # Combined feature tests
    lcmRange
    bug-0616bcf08e::*
    rectest1
    rectest2
    qsort
    impure
    impure-caller
    impure-typecheck-int
    impure2
    comps
    bug-7c599d4029::*