Check-in [bc3db1940d]

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

Overview
Comment: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.
Timelines: family | ancestors | descendants | both | notworking | kbk-nre
Files: files | file ages | folders
SHA3-256:bc3db1940d963b8fde6a86bceed49e59df55f3eb15fc280d20a9da0ebda399d0
User & Date: kbk 2018-04-23 03:10:13
Context
2018-04-24
03:39
Use llvmtcl 3.9 (release) features to provide the target platform information before starting to generate code in a module, and to do 'sizeof' and 'alignof' correctly. mrtest::* now compile correctly. check-in: c2b79891aa user: kbk tags: kbk-nre
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
Changes

Changes to codegen/compile.tcl.

1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461

	# Handle the return

	if {$tgttype eq "FAIL"} {
	    # This procedure only ever fails.
	    $b store $retval $errorCode
	    my SetErrorLine $errorCode
	    my StoreResult $tgt $errorCode
	} else {
	    set restype [TypeOf $retval]; # LLVM type ref of the return val
	    if {$restype in $ts} {
		$b store [$b extract $retval 0] $errorCode
	    } elseif {[Type $restype?] eq [Type $tgttype]} {
		set retval [$b ok $reval]
	    }
	    if {"FAIL" in $tgttype} {
		my SetErrorLine $errorCode [$b maybe $retval]
	    }
	}

	# Pack a callframe reference with the return if needed







<





|







1441
1442
1443
1444
1445
1446
1447

1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460

	# Handle the return

	if {$tgttype eq "FAIL"} {
	    # This procedure only ever fails.
	    $b store $retval $errorCode
	    my SetErrorLine $errorCode

	} else {
	    set restype [TypeOf $retval]; # LLVM type ref of the return val
	    if {$restype in $ts} {
		$b store [$b extract $retval 0] $errorCode
	    } elseif {[Type $restype?] eq [Type $tgttype]} {
		set retval [$b ok $retval]
	    }
	    if {"FAIL" in $tgttype} {
		my SetErrorLine $errorCode [$b maybe $retval]
	    }
	}

	# Pack a callframe reference with the return if needed

Changes to codegen/coro.tcl.

71
72
73
74
75
76
77

78
79
80
81
82
83
84
85
86
87
88
89
...
175
176
177
178
179
180
181

182

183
184
185
186
187
188
189
190
191
192
193
194
195
196
...
353
354
355
356
357
358
359


360
361
362
363
364
365
366
...
393
394
395
396
397
398
399

400
401
402
403
404
405
406
407
408
409
410

	$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
	# so that the body of the coroutine can see it.


	set llvm.coro.promise [$m intrinsic coro.promise]
	set promise.addr.raw \
	    [my call ${llvm.coro.promise} \
		 [list ${coro.handle} \
		      [Const $::tcl_platform(pointerSize) int32] \
		      [Const false bool]] \
		 "promise.addr.raw"]
	set promise.addr [my cast(ptr) ${promise.addr.raw} int32 "promise.addr"]
	my store $result ${promise.addr}

	# Resume the coroutine, and return to the trampoline to await
	# further developments
................................................................................
    set trap [$func block "coro.trap"]
    set cleanup [$func block "coro.cleanup"]
    set free_frame [$func block "coro.free.frame"]
    set suspend [$func block "coro.suspend"]

    # Allocate the coroutine promise


    set promise [$b alloc [my CoroPromiseType] "coro,promise"]

    set clientData [$b cast(ptr) $promise char]

    # Get a coroutine ID

    set llvm.coro.id [$m intrinsic coro.id]
    set coro_id [$b call ${llvm.coro.id} \
		     [list [Const 0 int32] $clientData \
			  [$b null char*] [$b null char*]] "coro.id"]

    # Determine whether coroutine frame elision has been performed

    set llvm.coro.alloc [$m intrinsic coro.alloc]
    set needToAlloc [$b call ${llvm.coro.alloc} [list $coro_id] \
			 "coro.need.to.alloc"]
................................................................................
#
# Results:
#	Returns a list of two LLVM value refs: the status code and the
#	return value.

oo::define TclCompiler method returnedFromCoro {rettype callee corohandle} {



    # Retrieve the coroutine promise from the coroutine handle

    set handle [my LoadOrLiteral $corohandle]
    set ptype [my CoroPromiseType $rettype $callee]
    set alignment [Const $::tcl_platform(pointerSize) int32]
    set paddr_raw [$b call [$m intrinsic coro.promise] \
		       [list $handle $alignment [Const false bool]] \
................................................................................
#		 wrapped function invocation
#	restype - Type of the result that is stored in the coroutine promise
#
# Results:
#	Returns the LLVM value reference to the result of the wrapped function

oo::define Builder method NRReturnToThunk {handle resType} {

    set llvm.coro.promise [$m intrinsic coro.promise]
    set promiseAddrRaw [my call ${llvm.coro.promise} \
			    [list $handle \
				 [Const $::tcl_platform(pointerSize) int32] \
				 [Const false bool]] "promise.addr.raw"]
    set promiseType named{$resType.promise,int32,$resType}
    set promiseAddr [my cast(ptr) $promiseAddrRaw $promiseType]
    set value [my load [my gep $promiseAddr 0 1] "value"]
    set llvm.coro.destroy [$m intrinsic coro.destroy]
    my call ${llvm.coro.destroy} $handle
    return $value







>




|







 







>

>






|







 







>
>







 







>


|
<







71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
...
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
...
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
...
398
399
400
401
402
403
404
405
406
407
408

409
410
411
412
413
414
415

	$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
	# so that the body of the coroutine can see it.

	set alignment [expr {2 * $::tcl_platform(pointerSize)}]
	set llvm.coro.promise [$m intrinsic coro.promise]
	set promise.addr.raw \
	    [my call ${llvm.coro.promise} \
		 [list ${coro.handle} \
		      [Const $alignment int32] \
		      [Const false bool]] \
		 "promise.addr.raw"]
	set promise.addr [my cast(ptr) ${promise.addr.raw} int32 "promise.addr"]
	my store $result ${promise.addr}

	# Resume the coroutine, and return to the trampoline to await
	# further developments
................................................................................
    set trap [$func block "coro.trap"]
    set cleanup [$func block "coro.cleanup"]
    set free_frame [$func block "coro.free.frame"]
    set suspend [$func block "coro.suspend"]

    # Allocate the coroutine promise

    set alignment [expr {2 * $::tcl_platform(pointerSize)}]
    set promise [$b alloc [my CoroPromiseType] "coro,promise"]
    $b align $promise $::tcl_platform(pointerSize)
    set clientData [$b cast(ptr) $promise char]

    # Get a coroutine ID

    set llvm.coro.id [$m intrinsic coro.id]
    set coro_id [$b call ${llvm.coro.id} \
		     [list [Const $alignment int32] $clientData \
			  [$b null char*] [$b null char*]] "coro.id"]

    # Determine whether coroutine frame elision has been performed

    set llvm.coro.alloc [$m intrinsic coro.alloc]
    set needToAlloc [$b call ${llvm.coro.alloc} [list $coro_id] \
			 "coro.need.to.alloc"]
................................................................................
#
# Results:
#	Returns a list of two LLVM value refs: the status code and the
#	return value.

oo::define TclCompiler method returnedFromCoro {rettype callee corohandle} {

    # TODO - How to determine alignment to pass to coro,promise?

    # Retrieve the coroutine promise from the coroutine handle

    set handle [my LoadOrLiteral $corohandle]
    set ptype [my CoroPromiseType $rettype $callee]
    set alignment [Const $::tcl_platform(pointerSize) int32]
    set paddr_raw [$b call [$m intrinsic coro.promise] \
		       [list $handle $alignment [Const false bool]] \
................................................................................
#		 wrapped function invocation
#	restype - Type of the result that is stored in the coroutine promise
#
# Results:
#	Returns the LLVM value reference to the result of the wrapped function

oo::define Builder method NRReturnToThunk {handle resType} {
    set alignment [expr {2 * $::tcl_platform(pointerSize)}]
    set llvm.coro.promise [$m intrinsic coro.promise]
    set promiseAddrRaw [my call ${llvm.coro.promise} \
			    [list $handle [Const $alignment int32] \

				 [Const false bool]] "promise.addr.raw"]
    set promiseType named{$resType.promise,int32,$resType}
    set promiseAddr [my cast(ptr) $promiseAddrRaw $promiseType]
    set value [my load [my gep $promiseAddr 0 1] "value"]
    set llvm.coro.destroy [$m intrinsic coro.destroy]
    my call ${llvm.coro.destroy} $handle
    return $value

Changes to codegen/llvmbuilder.tcl.

68
69
70
71
72
73
74


















75
76
77
78
79
80
81
	if {[TypeOf $left] ne [TypeOf $right]} {
	    return -code error "values must both be of the same type"
	} elseif {[GetTypeKind [TypeOf $left]] ne "LLVMIntegerTypeKind"} {
	    return -code error "values must be integers"
	}
	my Locate [BuildNSWAdd $b $left $right $name]
    }



















    # Builder:alloc --
    #
    #	Generate code to allocate a writable memory location on the stack.
    #
    # Parameters:
    #	type -	The type of the memory location to allocate.







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







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
	if {[TypeOf $left] ne [TypeOf $right]} {
	    return -code error "values must both be of the same type"
	} elseif {[GetTypeKind [TypeOf $left]] ne "LLVMIntegerTypeKind"} {
	    return -code error "values must be integers"
	}
	my Locate [BuildNSWAdd $b $left $right $name]
    }

    # Builder:align --
    #
    #	Set the alignment on an LLVM value
    #
    # Parameters:
    #	v - Value to set the alignment on
    #	align - Integer alignment in bytes - must be a power of 2

    method align {v align} {
	if {![string is integer $align]
	    || $align <= 0
	    || ($align & ($align - 1)) != 0} {
	    return -code error "alignment must be a power of 2"
	}
	return [SetAlignment $v $align]
    }


    # Builder:alloc --
    #
    #	Generate code to allocate a writable memory location on the stack.
    #
    # Parameters:
    #	type -	The type of the memory location to allocate.

Changes to codegen/thunk.tcl.

194
195
196
197
198
199
200

201
202
203
204
205
206
207
	    set block [$metathunk block leave]
	    $metathunkblock build $b {
		$b br $block
	    }
	    $block build $b {
		if {$version ne ""} {
		    set pkgname tclquadcoded::[string trimleft [$m name] ":"]

		    $b ret [my Tcl_PkgProvideEx $interp \
			    [$b constString $pkgname "pkg.name"] \
			    [$b constString $version "pkg.version"] {}]
		} else {
		    $b ret $OK
		}
	    }







>







194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
	    set block [$metathunk block leave]
	    $metathunkblock build $b {
		$b br $block
	    }
	    $block build $b {
		if {$version ne ""} {
		    set pkgname tclquadcoded::[string trimleft [$m name] ":"]
		    $b call [$m intrinsic debugtrap] {}
		    $b ret [my Tcl_PkgProvideEx $interp \
			    [$b constString $pkgname "pkg.name"] \
			    [$b constString $version "pkg.version"] {}]
		} else {
		    $b ret $OK
		}
	    }