Check-in [fba0ec7241]

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

Overview
Comment:Fix more trivial errors in 'translate' and missing cases in code gen
Timelines: family | ancestors | descendants | both | notworking | kbk-refactor-callframe
Files: files | file ages | folders
SHA3-256:fba0ec724167bad96bc77a7f70800d67f535a090877f8a5e95cdcf50ba7eb121
User & Date: kbk 2019-01-08 04:17:45
Context
2019-01-09
01:52
Add support for compiled procs that alter the callframe, then fail. check-in: 30d6a54fdb user: kbk tags: notworking, kbk-refactor-callframe
2019-01-08
04:17
Fix more trivial errors in 'translate' and missing cases in code gen check-in: fba0ec7241 user: kbk tags: notworking, kbk-refactor-callframe
2019-01-05
22:48
Generate only one moveFromCallFrame per bytecode instruction check-in: 9dbaca7922 user: kbk tags: notworking, kbk-refactor-callframe
Changes

Changes to codegen/struct.tcl.

2848
2849
2850
2851
2852
2853
2854

2855
2856
2857
2858
2859
2860
2861
2862
		    }]]
	}

	# Insert the do-nothing conversions; these are generated to ensure
	# that they always exist
	set typepairs [dict keys $TypeConversions]
	set SpecialTypes {

	    ARRAY {ARRAY STRING} {NEXIST ARRAY} {NEXIST ARRAY STRING}
	    DICTFOR FOREACH
	}
	foreach type $SpecialTypes {
	    lappend typepairs [list $type $type]
	}
	foreach pair $typepairs {
	    foreach type $pair {







>
|







2848
2849
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
		    }]]
	}

	# Insert the do-nothing conversions; these are generated to ensure
	# that they always exist
	set typepairs [dict keys $TypeConversions]
	set SpecialTypes {
	    ARRAY {ARRAY STRING}
	    NEXIST {NEXIST STRING} {NEXIST ARRAY} {NEXIST ARRAY STRING}
	    DICTFOR FOREACH
	}
	foreach type $SpecialTypes {
	    lappend typepairs [list $type $type]
	}
	foreach pair $typepairs {
	    foreach type $pair {

Changes to codegen/varframe.tcl.

49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
....
2850
2851
2852
2853
2854
2855
2856





















2857
2858
2859
2860
2861
2862
2863
    variable tcl.arraystring.addRef tcl.arraystring.addRef.nexist
    variable tcl.array.dropRef tcl.array.dropRef.nexist tcl.array.dropRef.fail
    variable tcl.arraystring.dropRef tcl.arraystring.dropRef.nexist
    variable tcl.array.init tcl.arraystring.init
    variable tcl.arraystring.extractarray tcl.arraystring.extractarray.nexist
    variable tcl.arraystring.extractscalar tcl.arraystring.extractscalar.nexist
    variable tcl.array.elemexists tcl.arraystring.elemexists
    variable tcl.array.get tcl.array.set tcl.array.unset
    variable tcl.arraystring.isarray
 
    method VariableHelperFunctions {api} {
	set 0 [Const 0]
	set 1 [Const 1]

	# Various flag bits
................................................................................
	    # TODO: What sort of flags should we watch out for?
	    my addReference(STRING) $val
	    my ret [my just $val]
	label unfound:
	    my ret [my nothing STRING]
	}






















	##### Function tcl.array.set #####
	#
	# Type signature: array:ARRAY * key:STRING * value:STRING -> ARRAY
	#
	# Sets the contents of an element in an array, returning the updated
	# array (which is actually the same as the input array; it is an
	# in-place modification).







|







 







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







49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
....
2850
2851
2852
2853
2854
2855
2856
2857
2858
2859
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
    variable tcl.arraystring.addRef tcl.arraystring.addRef.nexist
    variable tcl.array.dropRef tcl.array.dropRef.nexist tcl.array.dropRef.fail
    variable tcl.arraystring.dropRef tcl.arraystring.dropRef.nexist
    variable tcl.array.init tcl.arraystring.init
    variable tcl.arraystring.extractarray tcl.arraystring.extractarray.nexist
    variable tcl.arraystring.extractscalar tcl.arraystring.extractscalar.nexist
    variable tcl.array.elemexists tcl.arraystring.elemexists
    variable tcl.array.get tcl.array.get.nexist tcl.array.set tcl.array.unset
    variable tcl.arraystring.isarray
 
    method VariableHelperFunctions {api} {
	set 0 [Const 0]
	set 1 [Const 1]

	# Various flag bits
................................................................................
	    # TODO: What sort of flags should we watch out for?
	    my addReference(STRING) $val
	    my ret [my just $val]
	label unfound:
	    my ret [my nothing STRING]
	}

	##### Function tcl.array.get.nexist #####
	#
	# Type signature: array:ARRAY! * key:STRING -> STRING!
	#
	# Retrieves the contents of an element from an array. Retrives
	# Nothing if the array does not exist
	#
	# TRICKY POINT: Does not handle traces or aliased elements. (Is the
	# latter even possible in Tcl?)

	set f [$m local tcl.array.get.nexist STRING!<-ARRAY!,STRING]
	params array key
	build {
	    nonnull $key
	    my condBr [my maybe $array] $nothing $realArray
	label nothing:
	    my ret [my nothing STRING]
	label realArray:
	    my ret [my Call tcl.array.get [my unmaybe $array] $key]
	}
	
	##### Function tcl.array.set #####
	#
	# Type signature: array:ARRAY * key:STRING * value:STRING -> ARRAY
	#
	# Sets the contents of an element in an array, returning the updated
	# array (which is actually the same as the input array; it is an
	# in-place modification).

Changes to quadcode/translate.tcl.

113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
...
451
452
453
454
455
456
457

458
459
460
461
462
463
464
465
466
467
468
469
470

471
472
473

474
475
476
477
478
479
480
...
515
516
517
518
519
520
521

522
523
524
525
526
527
528
529
530
531
532

533
534
535
536
537
538
539
...
546
547
548
549
550
551
552

553
554
555
556
557
558
559
....
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
....
1592
1593
1594
1595
1596
1597
1598

1599
1600
1601
1602
1603
1604
1605
....
1899
1900
1901
1902
1903
1904
1905
1906
1907









1908
1909
1910
1911
1912
1913
1914
	}

	# Fix up any quads that jump to the current quad
	dict set quadindex $pc [llength $quads]
	if {[dict exists $fixup $pc]} {
	    foreach qi [dict get $fixup $pc] {
		my debug-translate {
		    puts "    fixup $qi to proceed to $pc"
		}
		lset quads $qi 1 [list pc [llength $quads]]
	    }
	    dict unset fixup $pc
	}

	# Determine if the current source line has changed
................................................................................
		set res [list temp $depth]
		my quads foreachIter $res $pair
		set n [expr {$depth - [llength $assign] - 3}]
		set lists [lmap group $assign {
		    list temp [incr n]
		}]
		set idx [list temp [expr {$depth + 1}]]

		foreach varGroup $assign list $lists {
		    if {[llength $varGroup] == 1} {
			my quads copy $idx $res
		    } else {
			my quads mult $idx $res [list literal [llength $varGroup]]
		    }
		    foreach varIndex $varGroup {
			set var [my index-to-var $varIndex]
			my generate-move-from-callframe $var
			my generate-scalar-check $pc $var {TCL WRITE VARNAME} \
			    "can't set \"%s\": variable is array"
			my quads listIndex $var $list $idx
			my quads extractMaybe $var $var

			my quads add $idx $idx [list literal 1]
		    }
		}

		my quads foreachMayStep $res $pair
		my quads foreachAdvance $pair $pair
		set target [expr {$pc + $jumpOffset}]
		my generate-jump $target true $res
	    }
	    foreach_end {
		# No special action needed; just a fancy pop, and that's
................................................................................
		my quads dictIterKey $key $var
		my quads dictIterValue $value $var
		my quads dictIterDone $done $var
	    }
	    dictUpdateStart {
		set var [my index-to-var [lindex $insn 1]]
		my generate-move-from-callframe $var

		my generate-scalar-check $pc $var {TCL READ VARNAME} \
		    "can't read \"%s\": variable is array"
		set auxNum [string range [lindex $insn 2] 1 end]
		set aux [lindex [dict get $bytecode auxiliary] $auxNum]
		set mid [list temp opnd0]
		set val [list temp [incr depth -1]]
		set idx 0
		set toUpdate {}
		foreach v [dict get $aux variables] {
		    set r [my index-to-var $v]
		    my generate-move-from-callframe $r

		    my generate-scalar-check $pc $r {TCL WRITE VARNAME} \
			"can't set \"%s\": variable is array"
		    my error-quads $pc listIndex $mid $val [list literal $idx]
		    my error-quads $pc dictGetOrNexist $r $var $mid
		    lappend toUpdate [list literal [lindex $r 1]] $r
		    incr idx
		}
................................................................................
		set key [list temp opnd1]
		set isary [list temp opnd2]
		set mid [list temp opnd3]
		set updating [list temp opnd4]
		set val [list temp [incr depth -1]]
		set idx 0
		my generate-move-from-callframe $var

		my generate-scalar-check $pc $var {TCL WRITE VARNAME} \
		    "can't write \"%s\": variable is array"
		my quads copy $updating $var
		foreach v [dict get $aux variables] {
		    set r [my index-to-var $v]
		    my generate-move-from-callframe $r
		    my error-quads $pc listIndex $key $val [list literal $idx]
................................................................................
		set idx [list temp [incr depth -1]]
		set ary [my index-to-var [lindex $insn 1]]
		set res [list temp $depth]
		set inval {temp opd0}
		my generate-move-from-callframe $ary
		my generate-array-check $pc $ary $idx {TCL LOOKUP VARNAME} \
		    "can't set \"%s(%s)\": variable isn't array"
		my quads initArrayIfNotExists $var $var
		my quads arrayGet $inval $ary $idx
		my quads initIfNotExists $inval $inval {literal {}}
		my error-quads $pc listAppend $inval $inval $val
		my quads arraySet $ary $ary $idx $inval
		my quads copy $res $inval
		my update-in-callframe [list literal [lindex $ary 1]] $ary
	    }
................................................................................
# Results:
#	None.
#
# Side effects:
#	Emits the quad

oo::define quadcode::transformer method generate-move-from-callframe {var} {

    my quads moveFromCallFrame $var {temp @callframe} \
	[list literal [lindex $var 1]]
}

# generate-existence-check --
#
#	Generates a check to make sure that a variable exists, and
................................................................................
# Results:
#	None.
#
# Side effects:
#	Emits `moveToCallFrame`.

oo::define quadcode::transformer method update-in-callframe {args} {
    if {[llength $args] > 0} {
	my quads moveToCallFrame {temp @callframe} {temp @callframe} {*}$args









    }
    return
}

# quads --
#
#	Generate the given quadcode.







|







 







>













>



>







 







>











>







 







>







 







|







 







>







 







<
|
>
>
>
>
>
>
>
>
>







113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
...
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
...
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
...
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
....
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
....
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
....
1906
1907
1908
1909
1910
1911
1912

1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
	}

	# Fix up any quads that jump to the current quad
	dict set quadindex $pc [llength $quads]
	if {[dict exists $fixup $pc]} {
	    foreach qi [dict get $fixup $pc] {
		my debug-translate {
		    puts "    fixup $qi to proceed to [llength $quads]"
		}
		lset quads $qi 1 [list pc [llength $quads]]
	    }
	    dict unset fixup $pc
	}

	# Determine if the current source line has changed
................................................................................
		set res [list temp $depth]
		my quads foreachIter $res $pair
		set n [expr {$depth - [llength $assign] - 3}]
		set lists [lmap group $assign {
		    list temp [incr n]
		}]
		set idx [list temp [expr {$depth + 1}]]
		set toUpdate {}
		foreach varGroup $assign list $lists {
		    if {[llength $varGroup] == 1} {
			my quads copy $idx $res
		    } else {
			my quads mult $idx $res [list literal [llength $varGroup]]
		    }
		    foreach varIndex $varGroup {
			set var [my index-to-var $varIndex]
			my generate-move-from-callframe $var
			my generate-scalar-check $pc $var {TCL WRITE VARNAME} \
			    "can't set \"%s\": variable is array"
			my quads listIndex $var $list $idx
			my quads extractMaybe $var $var
			lappend toUpdate [lreplace $var 0 0 literal] $var
			my quads add $idx $idx [list literal 1]
		    }
		}
		my update-in-callframe {*}$toUpdate
		my quads foreachMayStep $res $pair
		my quads foreachAdvance $pair $pair
		set target [expr {$pc + $jumpOffset}]
		my generate-jump $target true $res
	    }
	    foreach_end {
		# No special action needed; just a fancy pop, and that's
................................................................................
		my quads dictIterKey $key $var
		my quads dictIterValue $value $var
		my quads dictIterDone $done $var
	    }
	    dictUpdateStart {
		set var [my index-to-var [lindex $insn 1]]
		my generate-move-from-callframe $var
		my generate-existence-check $pc $var
		my generate-scalar-check $pc $var {TCL READ VARNAME} \
		    "can't read \"%s\": variable is array"
		set auxNum [string range [lindex $insn 2] 1 end]
		set aux [lindex [dict get $bytecode auxiliary] $auxNum]
		set mid [list temp opnd0]
		set val [list temp [incr depth -1]]
		set idx 0
		set toUpdate {}
		foreach v [dict get $aux variables] {
		    set r [my index-to-var $v]
		    my generate-move-from-callframe $r
		    my generate-existence-check $pc $r
		    my generate-scalar-check $pc $r {TCL WRITE VARNAME} \
			"can't set \"%s\": variable is array"
		    my error-quads $pc listIndex $mid $val [list literal $idx]
		    my error-quads $pc dictGetOrNexist $r $var $mid
		    lappend toUpdate [list literal [lindex $r 1]] $r
		    incr idx
		}
................................................................................
		set key [list temp opnd1]
		set isary [list temp opnd2]
		set mid [list temp opnd3]
		set updating [list temp opnd4]
		set val [list temp [incr depth -1]]
		set idx 0
		my generate-move-from-callframe $var
		my generate-existence-check $pc $var
		my generate-scalar-check $pc $var {TCL WRITE VARNAME} \
		    "can't write \"%s\": variable is array"
		my quads copy $updating $var
		foreach v [dict get $aux variables] {
		    set r [my index-to-var $v]
		    my generate-move-from-callframe $r
		    my error-quads $pc listIndex $key $val [list literal $idx]
................................................................................
		set idx [list temp [incr depth -1]]
		set ary [my index-to-var [lindex $insn 1]]
		set res [list temp $depth]
		set inval {temp opd0}
		my generate-move-from-callframe $ary
		my generate-array-check $pc $ary $idx {TCL LOOKUP VARNAME} \
		    "can't set \"%s(%s)\": variable isn't array"
		my quads initArrayIfNotExists $ary $ary
		my quads arrayGet $inval $ary $idx
		my quads initIfNotExists $inval $inval {literal {}}
		my error-quads $pc listAppend $inval $inval $val
		my quads arraySet $ary $ary $idx $inval
		my quads copy $res $inval
		my update-in-callframe [list literal [lindex $ary 1]] $ary
	    }
................................................................................
# Results:
#	None.
#
# Side effects:
#	Emits the quad

oo::define quadcode::transformer method generate-move-from-callframe {var} {
    if {[lindex $var 0] ne "var"} return
    my quads moveFromCallFrame $var {temp @callframe} \
	[list literal [lindex $var 1]]
}

# generate-existence-check --
#
#	Generates a check to make sure that a variable exists, and
................................................................................
# Results:
#	None.
#
# Side effects:
#	Emits `moveToCallFrame`.

oo::define quadcode::transformer method update-in-callframe {args} {

    set q {moveToCallFrame {temp @callframe} {temp @callframe}}
    set need 0
    foreach {name value} $args {
	if {[lindex $value 0] eq "var"} {
	    lappend q $name $value
	    set need 1
	}
    }
    if {$need} {
	my quads {*}$q
    }
    return
}

# quads --
#
#	Generate the given quadcode.