Check-in [2945c2321c]

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

Overview
Comment:Make sure that local vars are located on the coro frame and not on the stack. Fix a spurious error when an 'upvar' follows a 'moveToCallFrame' for a nonexistent local var.
Timelines: family | ancestors | descendants | both | kbk-nre
Files: files | file ages | folders
SHA3-256:2945c2321c57eb9c0a57352bf7b4dec04332569c40e01e4b6907af90bbf4f24c
User & Date: kbk 2018-05-01 02:13:13
Context
2018-05-02
05:28
Add support for invoking non-compiled Tcl commands using NRE. Still have to do invokeExpanded. Leaf check-in: 9f6d191beb user: kbk tags: kbk-nre
2018-05-01
02:13
Make sure that local vars are located on the coro frame and not on the stack. Fix a spurious error when an 'upvar' follows a 'moveToCallFrame' for a nonexistent local var. check-in: 2945c2321c user: kbk tags: kbk-nre
2018-04-30
19:01
Allow 'inlinehint' as an overriding inline control attribute, just like 'noinline'. check-in: ebcc398686 user: dkf tags: kbk-nre
Changes

Changes to codegen/build.tcl.

562
563
564
565
566
567
568


569
570
571
572
573
574
575

576
577
578
579
580
581
582
583
584
585
...
945
946
947
948
949
950
951
952
953
954

955
956
957
958
959
960
961
    #	argv -	The STRING* LLVM value reference (or equivalent type) for the
    #		array of arguments, allocated on the function stack.
    #	proc -	The LLVM value reference to the procedure's metadata.
    #	localcache -
    #		The LLVM value reference to the procedure's local variable
    #		metadata.
    #	callframe - The LLVM pointer reference to the callframe to construct


    #
    # Results:
    #	A Tcl list of the LLVM CALLFRAME value reference and the mapping
    #	dictionary from string variable names to the corresponding LLVM Var*
    #	value references.

    method frame.create {varlist argc argv proc localcache callframe} {

	# Construct the call frame itself
	set length [Const [llength $varlist]]
	set locals [my arrayAlloc Var $length]
	my Call tcl.callframe.init $callframe $length \
	    $argc [my cast(ptr) $argv STRING] $proc $localcache $locals
	# Initialise the information about the local variables
	set idx -1
	set varmap {}
	foreach varinfo $varlist {
	    lassign $varinfo flags var
................................................................................
    #		The CALLFRAME LLVM value reference.
    #	ec -	An int* LLVM reference for where to write error codes into.
    #	name (optional) -
    #		The LLVM name of the result value.
    #
    # Results:
    #	An LLVM bool? value reference.

    method frame.bind.upvar(STRING,STRING,STRING) {
	    localName level otherName localVar callframe ec {name ""}} {

	set otherVar [my call ${tcl.callframe.lookup.upvar} [list \
		$callframe $level $otherName] "otherVar"]
	set val [my call ${tcl.callframe.bindvar} [list \
		$callframe $otherVar $localVar $localName $ec] $name]
	return [my frame.pack $callframe $val $name]
    }
 







>
>






|
>


|







 







|

|
>







562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
...
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
    #	argv -	The STRING* LLVM value reference (or equivalent type) for the
    #		array of arguments, allocated on the function stack.
    #	proc -	The LLVM value reference to the procedure's metadata.
    #	localcache -
    #		The LLVM value reference to the procedure's local variable
    #		metadata.
    #	callframe - The LLVM pointer reference to the callframe to construct
    #	entryBlock - The entry block of the function, needed for allocating
    #	             the array of local variables.
    #
    # Results:
    #	A Tcl list of the LLVM CALLFRAME value reference and the mapping
    #	dictionary from string variable names to the corresponding LLVM Var*
    #	value references.

    method frame.create {varlist argc argv proc localcache callframe
			 entryBlock} {
	# Construct the call frame itself
	set length [Const [llength $varlist]]
	set locals [my arrayAllocInBlock $entryBlock Var $length]
	my Call tcl.callframe.init $callframe $length \
	    $argc [my cast(ptr) $argv STRING] $proc $localcache $locals
	# Initialise the information about the local variables
	set idx -1
	set varmap {}
	foreach varinfo $varlist {
	    lassign $varinfo flags var
................................................................................
    #		The CALLFRAME LLVM value reference.
    #	ec -	An int* LLVM reference for where to write error codes into.
    #	name (optional) -
    #		The LLVM name of the result value.
    #
    # Results:
    #	An LLVM bool? value reference.
    
    method frame.bind.upvar(STRING,STRING,STRING) {
	localName level otherName localVar callframe ec {name ""}
    } {
	set otherVar [my call ${tcl.callframe.lookup.upvar} [list \
		$callframe $level $otherName] "otherVar"]
	set val [my call ${tcl.callframe.bindvar} [list \
		$callframe $otherVar $localVar $localName $ec] $name]
	return [my frame.pack $callframe $val $name]
    }
 

Changes to codegen/compile.tcl.

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
....
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
		      [Type array{Tcl_Obj*,[llength $arguments]}] argv]

	# Store the arguments in the argument list
	set cell [$b gep $argv 0 0]
	$b store [Const $cmd STRING] $cell
	set idx -1
	set drop 0
	puts "arguments: $arguments argtypes: $argtypes"
	foreach v $arguments t $argtypes {
	    if {[incr idx]} {
		puts "transfer param $idx (type $t) to $v"
		set val [$b stringify($t) [$func param [expr {$idx-1}]]]
		$b store $val [$b gep $argv 0 $idx]
		lappend drop [expr {!refType($t)}]
	    }
	}

	# Create the stack frame
................................................................................
	set procmeta [dict get $bytecode procmeta]
	set localcache [dict get $bytecode localcache]
	set callframe [$b allocInBlock $entryBlock CallFrame "callframe"]

	lassign [$b frame.create $varmeta $argc $argv \
		     [$b load $procmeta "proc.metadata"] \
		     [$b load $localcache "proc.localcache"] \
		    $callframe] \
	    theframe thevarmap
	my StoreResult $tgt $theframe
	return [list $theframe $thevarmap $drop]
    }
 
    # TclCompiler:IssueInvoke --
    #
................................................................................
	set ts [lmap t $BASETYPES {Type $t?}]
	set tgttype [my ValueTypes $tgt]

	# Emit the sequence that destroys the LLVM coroutine and returns the
	# result as 'retval'
	lassign [my returnedFromCoro $rettype $tgttype $corohandle] \
	    callframe retcode retval
	if 0 {
	    puts "returned from coro:"
	    if {$callframe ne ""} {
		puts " callframe=[PrintValueToString $callframe]"
	    }
	    puts "retcode=[PrintValueToString $retcode]\n\
	          retval=[PrintValueToString $retval]\n"
	}

	# Handle the return

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







<


<







 







|







 







<
<
<
<
<
<
<
<







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
....
1450
1451
1452
1453
1454
1455
1456








1457
1458
1459
1460
1461
1462
1463
		      [Type array{Tcl_Obj*,[llength $arguments]}] argv]

	# Store the arguments in the argument list
	set cell [$b gep $argv 0 0]
	$b store [Const $cmd STRING] $cell
	set idx -1
	set drop 0

	foreach v $arguments t $argtypes {
	    if {[incr idx]} {

		set val [$b stringify($t) [$func param [expr {$idx-1}]]]
		$b store $val [$b gep $argv 0 $idx]
		lappend drop [expr {!refType($t)}]
	    }
	}

	# Create the stack frame
................................................................................
	set procmeta [dict get $bytecode procmeta]
	set localcache [dict get $bytecode localcache]
	set callframe [$b allocInBlock $entryBlock CallFrame "callframe"]

	lassign [$b frame.create $varmeta $argc $argv \
		     [$b load $procmeta "proc.metadata"] \
		     [$b load $localcache "proc.localcache"] \
		    $callframe $entryBlock] \
	    theframe thevarmap
	my StoreResult $tgt $theframe
	return [list $theframe $thevarmap $drop]
    }
 
    # TclCompiler:IssueInvoke --
    #
................................................................................
	set ts [lmap t $BASETYPES {Type $t?}]
	set tgttype [my ValueTypes $tgt]

	# Emit the sequence that destroys the LLVM coroutine and returns the
	# result as 'retval'
	lassign [my returnedFromCoro $rettype $tgttype $corohandle] \
	    callframe retcode retval









	# Handle the return

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

Changes to codegen/llvmbuilder.tcl.

120
121
122
123
124
125
126

127
128
129
130
131
132
133
...
173
174
175
176
177
178
179




























180
181
182
183
184
185
186
    #
    # Results:
    #	Returns a LLVM value reference to the pointer to the allocated space

    method allocInBlock {block type name} {
	set here [my @cur]
	my @end $block

	set ref [my alloc $type $name]
	my @end $here
	return $ref
    }

    # Builder:and --
    #
................................................................................
    method arrayAlloc {type size {name ""}} {
	my @validToIssue
	if {[GetTypeKind [TypeOf $size]] ne "LLVMIntegerTypeKind"} {
	    return -code error "size must be integer"
	}
	my Locate [BuildArrayAlloca $b [Type $type] $size $name]
    }





























    # Builder:br --
    #
    #	Branch unconditionally to another basic block. Widely used, marks the
    #	end of the current basic block. Quadcode implementation ('jump').
    #
    # Parameters:







>







 







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







120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
...
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
    #
    # Results:
    #	Returns a LLVM value reference to the pointer to the allocated space

    method allocInBlock {block type name} {
	set here [my @cur]
	my @end $block
	my @validToIssue
	set ref [my alloc $type $name]
	my @end $here
	return $ref
    }

    # Builder:and --
    #
................................................................................
    method arrayAlloc {type size {name ""}} {
	my @validToIssue
	if {[GetTypeKind [TypeOf $size]] ne "LLVMIntegerTypeKind"} {
	    return -code error "size must be integer"
	}
	my Locate [BuildArrayAlloca $b [Type $type] $size $name]
    }

    # Builder:arrayAllocInBlock --
    #
    #	Generate code to allocate a contiguous array of memory cells on the
    #	stack, placing it in a block other than the current one.
    #
    # Parameters:
    #   block - The LLVM block reference of the block where the alloc should go
    #	type -	The type of each of the memory cells.
    #	size -	The number of cells to create as an int[X] LLVM value
    #		reference. (X is the same as for the 'left' parameter.)
    #	name (optional) -
    #		A name to give to the result value.
    #
    # Results:
    #	A pointer to the first cell in the array.

    method arrayAllocInBlock {block type size {name ""}} {
	if {[GetTypeKind [TypeOf $size]] ne "LLVMIntegerTypeKind"} {
	    return -code error "size must be integer"
	}
	set here [my @cur]
	my @end $block
	my @validToIssue
	set ref [my Locate [BuildArrayAlloca $b [Type $type] $size $name]]
	my @end $here
	return $ref
    }

    # Builder:br --
    #
    #	Branch unconditionally to another basic block. Widely used, marks the
    #	end of the current basic block. Quadcode implementation ('jump').
    #
    # Parameters:

Changes to codegen/thunk.tcl.

192
193
194
195
196
197
198


199
200

201
202
203
204
205
206
207
	}
	my buildInSection packageProvide {
	    set block [$metathunk block leave]
	    $metathunkblock build $b {
		$b br $block
	    }
	    $block build $b {


		set llvm.debugtrap [$m intrinsic debugtrap]
		$b call ${llvm.debugtrap} {}

		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







>
>
|
|
>







192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
	}
	my buildInSection packageProvide {
	    set block [$metathunk block leave]
	    $metathunkblock build $b {
		$b br $block
	    }
	    $block build $b {
		if 0 {
		    # ^^^ change to if 1 to stop right after loading the package
		    set llvm.debugtrap [$m intrinsic debugtrap]
		    $b call ${llvm.debugtrap} {}
		}
		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

Changes to demos/perftest/tester.tcl.

1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
	return -code error "Error thrown from recursive proc"
    } else {
	return .[rectest2 [expr {$n-1}]]
    }
}

proc rectest3 {nv} {
    upvar 1 $nv n
    if {[incr n -1] <= 0} {
	return |
    } else {
	return .[rectest3 n]
    }
}

proc treecollect {t} {
    set l {}
    treewalk l $t
    return $l







|
|


|







1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
	return -code error "Error thrown from recursive proc"
    } else {
	return .[rectest2 [expr {$n-1}]]
    }
}

proc rectest3 {nv} {
    upvar 1 $nv nn
    if {[incr nn -1] <= 0} {
	return |
    } else {
	return .[rectest3 nn]
    }
}

proc treecollect {t} {
    set l {}
    treewalk l $t
    return $l

Changes to quadcode/upvar.tcl.

266
267
268
269
270
271
272
273

274
275
276
277
278
279
280
		    foreach {localVar source} [lrange $q 3 end] {
			if {[lindex $localVar 0] ne "literal"} {
			    my diagnostic error $b $pc \
				"double dereference is not implemented"
			    set localVar [list literal \ufffderror]
			}
			set localVarName [lindex $localVar 1]
			if {![dict exists $resFrame $localVarName]} {

			    dict set resFrame $localVarName local
			}
		    }

		}
		nsupvar - variable {








|
>







266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
		    foreach {localVar source} [lrange $q 3 end] {
			if {[lindex $localVar 0] ne "literal"} {
			    my diagnostic error $b $pc \
				"double dereference is not implemented"
			    set localVar [list literal \ufffderror]
			}
			set localVarName [lindex $localVar 1]
			if {![dict exists $resFrame $localVarName]
			    && ($source ne "Nothing")} {
			    dict set resFrame $localVarName local
			}
		    }

		}
		nsupvar - variable {