Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | Update quadcode generation and documentation so that 'direct' operations refer to the callframe (which is necessary in the event that they are emitted to deal with double-dereference). CODE ISSUER IS NOT YET UPDATED TO COPE WITH THE CHANGE. |
|---|---|
| Timelines: | family | ancestors | descendants | both | notworking | kbk-refactor-callframe |
| Files: | files | file ages | folders |
| SHA3-256: |
104debc7340b879bd5409d978e729313 |
| User & Date: | kbk 2019-01-01 23:06:11 |
Context
|
2019-01-02
| ||
| 02:20 | Oops, one extra callframe ref in 'callframe-error-quads' check-in: cdc4d10e86 user: kbk tags: notworking, kbk-refactor-callframe | |
|
2019-01-01
| ||
| 23:06 | Update quadcode generation and documentation so that 'direct' operations refer to the callframe (which is necessary in the event that they are emitted to deal with double-dereference). CODE ISSUER IS NOT YET UPDATED TO COPE WITH THE CHANGE. check-in: 104debc734 user: kbk tags: notworking, kbk-refactor-callframe | |
| 21:57 | Move callframe moves to the actual points where callframe values are moved. They can then be optimized by avaiability and liveness analysis. check-in: dbd9571178 user: kbk tags: notworking, kbk-refactor-callframe | |
Changes
Changes to quadcode/translate.tcl.
42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 .. 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 ... 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 ... 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 ... 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 ... 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 .... 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 .... 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 .... 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 .... 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 .... 1906 1907 1908 1909 1910 1911 1912 1913 1914 1915 1916 1917 1918 1919 1920 1921 1922 1923 1924 |
set quads {}; # List of instructions under construction
set quadindex {}; # Dictionary mapping bytecode PC to
; # quadcode PC in the initial translation
set fixup {}; # Dictionary whose keys are jump targets
; # and the values are lists of quad program
; # counters that jump to them, used to fix up
; # forward jumps.
my debug-translate {
puts "Translate bytecode: $originProc"
}
# Construct a header that sets parameters and provides a fake point
# to which live-on-entry variables can be attached.
set vlist {}
foreach v [dict get $bytecode variables] {
if {!("temp" in [lindex $v 0])} {
lappend vlist [lindex $v 1]
}
}
my quads entry {temp @callframe} [list literal $vlist]
my quads @debug-context {} [list literal [list proc $originProc]]
if {[dict exists $bytecode sourcefile]} {
my quads @debug-file {} [list literal [dict get $bytecode sourcefile]]
}
if {[dict exists $bytecode initiallinenumber]} {
my quads @debug-line {} \
[list literal [list [dict get $bytecode initiallinenumber] 0]]
................................................................................
if {{arg} in [lindex $v 0]} {
my quads param [list var [lindex $v 1]] [list arg $idx]
}
incr idx
}
# Make sure that the args are in the callframe.
set q [list moveToCallFrame {temp @callframe} {temp @callframe}]
foreach v [dict get $bytecode variables] {
if {{arg} in [lindex $v 0]} {
lappend q [list literal [lindex $v 1]] [list var [lindex $v 1]]
}
}
if {[llength $q] > 3} {
my quads {*}$q
................................................................................
set chars [list temp [incr depth -1]]
set v [list temp [incr depth -1]]
my quads strtrim $v $v $chars [list literal 1]
}
done { # End of bytecode
set v [list temp [incr depth -1]]
my quads return {} {temp @callframe} $v
}
returnStk {
# NOTE! Opposite order to 'returnImm'
set v [list temp [incr depth -1]]
set opt [list temp [incr depth -1]]
set resultVar [list temp $depth]
my error-quads $pc initException $resultVar $v $opt
................................................................................
my quads copy $res $inval
}
incrStkImm {
set var [list temp [incr depth -1]]
set delta [list literal [lindex $insn 1]]
# TODO: This assumes we're dealing with qualified names!
set val {temp opd2}
my error-quads $pc directGet $val $var
my generate-arith-domain-check $pc incr $val $delta
my quads purify {temp opd0} $val
my quads purify {temp opd1} $delta
my quads add $val {temp opd0} {temp opd1}
my error-quads $pc directSet $var $var $val
}
incrStk {
set delta [list temp [incr depth -1]]
set var [list temp [incr depth -1]]
# TODO: This assumes we're dealing with qualified names!
set val {temp opd2}
my error-quads $pc directGet $val $var
my generate-arith-domain-check $pc incr $val $delta
my quads purify {temp opd0} $val
my quads purify {temp opd1} $delta
my quads add $val {temp opd0} {temp opd1}
my error-quads $pc directSet $var $var $val
}
incrArrayStkImm {
set elem [list temp [incr depth -1]]
set var [list temp [incr depth -1]]
set delta [list literal [lindex $insn 1]]
# TODO: This assumes we're dealing with qualified names!
set val {temp opd2}
my error-quads $pc directArrayGet $val $var $elem
my generate-arith-domain-check $pc incr $val $delta
my quads purify {temp opd0} $val
my quads purify {temp opd1} $delta
my quads add $val {temp opd0} {temp opd1}
my error-quads $pc directArraySet $var $var $elem $val
}
incrArrayStk {
set delta [list temp [incr depth -1]]
set elem [list temp [incr depth -1]]
set var [list temp [incr depth -1]]
# TODO: This assumes we're dealing with qualified names!
set val {temp opd2}
my error-quads $pc directArrayGet $val $var $elem
my generate-arith-domain-check $pc incr $val $delta
my quads purify {temp opd0} $val
my quads purify {temp opd1} $delta
my quads add $val {temp opd0} {temp opd1}
my error-quads $pc directArraySet $var $var $elem $val
}
appendStk {
set value [list temp [incr depth -1]]
set var [list temp [incr depth -1]]
# TODO: This assumes we're dealing with qualified names!
my error-quads $pc directAppend $var $var $value
}
appendArrayStk {
set value [list temp [incr depth -1]]
set elem [list temp [incr depth -1]]
set var [list temp [incr depth -1]]
# TODO: This assumes we're dealing with qualified names!
my error-quads $pc directArrayAppend $var $var $elem $value
}
lappendStk {
set value [list temp [incr depth -1]]
set var [list temp [incr depth -1]]
# TODO: This assumes we're dealing with qualified names!
# TODO: Typecheck: need list in $var
my error-quads $pc directLappend $var $var $value
}
lappendListStk {
set listvalue [list temp [incr depth -1]]
set var [list temp [incr depth -1]]
# TODO: This assumes we're dealing with qualified names!
# TODO: Typecheck: need lists in $var and $listvalue
my error-quads $pc directLappendList $var $var $listvalue
}
lappendArrayStk {
set value [list temp [incr depth -1]]
set elem [list temp [incr depth -1]]
set var [list temp [incr depth -1]]
# TODO: This assumes we're dealing with qualified names!
# TODO: Typecheck: need list in $var
my error-quads $pc directArrayLappend $var $var $elem $value
}
lappendListArrayStk {
set listvalue [list temp [incr depth -1]]
set elem [list temp [incr depth -1]]
set var [list temp [incr depth -1]]
# TODO: This assumes we're dealing with qualified names!
# TODO: Typecheck: need lists in $var and $listvalue
my error-quads $pc \
directArrayLappendList $var $var $elem $listvalue
}
existStk {
set var [list temp [incr depth -1]]
# TODO: This assumes we're dealing with qualified names!
my quads directExists $var $var
}
existArrayStk {
set elem [list temp [incr depth -1]]
set var [list temp [incr depth -1]]
# TODO: This assumes we're dealing with qualified names!
my quads directArrayExists $var $var $elem
}
loadStk {
set var [list temp [incr depth -1]]
# TODO: This assumes we're dealing with qualified names!
my error-quads $pc directGet $var $var
}
loadArrayStk {
set elem [list temp [incr depth -1]]
set var [list temp [incr depth -1]]
# TODO: This assumes we're dealing with qualified names!
my error-quads $pc directArrayGet $var $var $elem
}
storeStk {
set value [list temp [incr depth -1]]
set var [list temp [incr depth -1]]
# TODO: This assumes we're dealing with qualified names!
my error-quads $pc directSet $var $var $value
}
storeArrayStk {
set value [list temp [incr depth -1]]
set elem [list temp [incr depth -1]]
set var [list temp [incr depth -1]]
# TODO: This assumes we're dealing with qualified names!
my error-quads $pc directArraySet $var $var $elem $value
}
unsetStk {
set flags [list literal [lindex $insn 1]]
set var [list temp [incr depth -1]]
# TODO: This assumes we're dealing with qualified names!
my error-quads $pc directUnset {temp opd0} $var $flags
}
unsetArrayStk {
set flags [list literal [lindex $insn 1]]
set elem [list temp [incr depth -1]]
set var [list temp [incr depth -1]]
# TODO: This assumes we're dealing with qualified names!
my error-quads $pc directArrayUnset {temp opd0} $var $elem $flags
}
dictGet {
set idxNum [lindex $insn 1]
set q {}
for {set i 0} {$i < $idxNum} {incr i} {
# NOTE: Reversed
lappend q [list temp [incr depth -1]]
................................................................................
# the invoked procedure raises an error
set qd [list [list temp [expr {$depth + $acount}]]]
for {set i $rcount} {$i < $acount} {incr i} {
lappend qd [list temp [expr {$depth + $i}]]
}
my generate-function-param-check $pc $qd
# generate the call itself
my quads invoke {temp @callframe} {temp @callframe} {*}$qd
my quads retrieveResult {temp @exception} {temp @callframe}
my quads extractCallFrame {temp @callframe} {temp @callframe}
my generate-jump [my exception-target $pc catch] maybe \
{temp @exception}
my quads extractMaybe $result {temp @exception}
}
invokeStk1 - invokeStk4 {
set acount [lindex $insn 1]
set depth [expr {$depth - $acount}]
................................................................................
set result [list temp $depth]
set qd {}
for {set i 0} {$i < $acount} {incr i} {
lappend qd [list temp [expr {$depth + $i}]]
}
my generate-function-param-check $pc $qd
# generate the call itself
my quads invoke {temp @callframe} {temp @callframe} {*}$qd
my quads retrieveResult {temp @exception} {temp @callframe}
my quads extractCallFrame {temp @callframe} {temp @callframe}
my generate-jump [my exception-target $pc catch] maybe \
{temp @exception}
my quads extractMaybe $result {temp @exception}
}
jump1 - jump4 {
switch -exact -- [lindex $insn 1 0] {
pc {
................................................................................
my generate-jump $to_pc true $test
}
}
existScalar {
set result [list temp $depth]
set var [my index-to-var [lindex $insn 1]]
my quads moveFromCallFrame \
$var {temp @callframe} [list literal [lindex $var 1]]
my quads exists $result $var
}
existArray {
set tmp [list temp $depth]
set idx [list temp [incr depth -1]]
set ary [my index-to-var [lindex $insn 1]]
set result $idx
my quads moveFromCallFrame \
$var {temp @callframe} [list literal [lindex $var 1]]
my quads initArrayIfNotExists $tmp $ary
my quads arrayElementExists $result $tmp $idx
}
loadScalar1 -
loadScalar4 { # Load a variable
set result [list temp $depth]
................................................................................
set res [list temp $depth]
# TODO: Typecheck: need lists in $list1 and $list2
my error-quads $pc listConcat $res $list1 $list2
}
arrayExistsImm {
set ary [my index-to-var [lindex $insn 1]]
my quads moveFromCallFrame \
$ary {temp @callframe} [list literal [lindex $ary 1]]
set res [list temp $depth]
my quads arrayExists $res $ary
}
arrayMakeImm {
set ary [my index-to-var [lindex $insn 1]]
my generate-array-check $pc $ary {} {TCL WRITE ARRAY} \
"can't array set \"%s\": variable isn't array"
my quads initArrayIfNotExists $ary $ary
my update-in-callframe [list literal [lindex $var 1]] $var
}
arrayExistsStk {
set ary [list temp [incr depth -1]]
set res [list temp $depth]
my error-quads $pc directIsArray $res $ary
}
arrayMakeStk {
set ary [list temp [incr depth -1]]
set res [list temp $depth]
my error-quads $pc directMakeArray $res $ary
}
variable {
set var [my index-to-var [lindex $insn 1]]
set name [list temp [incr depth -1]]
my quads [lindex $insn 0] {temp @callframe} {temp @callframe} \
[list literal [lindex $var 1]] $name
my quads retrieveResult {temp @exception} {temp @callframe}
my quads extractCallFrame {temp @callframe} {temp @callframe}
my generate-jump [my exception-target $pc catch] \
maybe {temp @exception}
}
nsupvar - upvar {
set var [my index-to-var [lindex $insn 1]]
set name [list temp [incr depth -1]]
set context [list temp [incr depth -1]]
my quads [lindex $insn 0] {temp @callframe} {temp @callframe} \
[list literal [lindex $var 1]] $context $name
my quads retrieveResult {temp @exception} {temp @callframe}
my quads extractCallFrame {temp @callframe} {temp @callframe}
my generate-jump [my exception-target $pc catch] \
maybe {temp @exception}
}
currentNamespace {
my quads copy [list temp $depth] \
[list literal [dict get $bytecode namespace]]
}
infoLevelArgs {
set value [list temp [incr depth -1]]
set r [list temp $depth]
my generate-arith-domain-check $pc [lindex $insn 0] $value
my quads purify {temp opd0} $value
my error-quads $pc frameArgs $r {temp opd0} {temp @callframe}
}
infoLevelNumber {
set r [list temp $depth]
my quads frameDepth $r {temp @callframe}
}
expandStart {
# do nothing
}
expandStkTop {
set r [list temp [incr depth -1]]
my error-quads $pc verifyList $r $r
................................................................................
lassign [dict get $bytecode stackState $state] headWas depthWas
set result [list temp $depthWas]
set qd {}
for {set i $depthWas} {$i < $depth} {incr i} {
lappend qd [list temp $i]
}
my quads \
invokeExpanded {temp @callframe} {temp @callframe} {*}$qd
my quads retrieveResult {temp @exception} {temp @callframe}
my quads extractCallFrame {temp @callframe} {temp @callframe}
my generate-jump [my exception-target $pc catch] maybe \
{temp @exception}
my quads extractMaybe $result {temp @exception}
}
default {
# TODO - Many more instructions
lappend errors $sourcefile $currentline $currentscript \
................................................................................
lset quads $q 1 [list pc [llength $quads]]
}
# let the flow analysis figure out whether this is confluent!
# lappend quads confluence
my quads returnCode [set code [list temp 0]] {temp @exception}
my quads procLeave $code $code \
[list literal [namespace tail $originProc]]
my quads return {} {temp @callframe} $code
dict unset fixup -1
}
if {[dict size $fixup] > 0} {
error "Failed to fix jumps at [join [dict keys $fixup] ,]"
}
if {[llength $errors] > 1} {
set result {}
................................................................................
# Results:
# None.
oo::define quadcode::transformer method error-quads {pc opcode result args} {
my quads $opcode {temp @exception} {*}$args
set target [my exception-target $pc catch]
my generate-jump $target maybe {temp @exception}
my quads extractMaybe {temp @exception} {temp @exception}
my quads copy $result {temp @exception}
return
}
# interp alias {} tcl::mathfunc::istype {} ::dataType::isa
# Local Variables:
# mode: tcl
# fill-column: 78
# auto-fill-function: nil
# End:
|
> > > | | | | | | | | | | > | > | > | > | > | | | | | | | > | > | > | | | | | | | | | | | | | | | | | | | | | | | | < | > > > > > > > > > > > > > > > > > > > > > > > > > > |
42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 .. 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 ... 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 ... 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 ... 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 ... 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 .... 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 .... 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 .... 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 .... 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 .... 1917 1918 1919 1920 1921 1922 1923 1924 1925 1926 1927 1928 1929 1930 1931 1932 1933 1934 1935 1936 1937 1938 1939 1940 1941 1942 1943 1944 1945 1946 1947 1948 1949 1950 1951 1952 1953 1954 1955 1956 1957 1958 1959 1960 |
set quads {}; # List of instructions under construction
set quadindex {}; # Dictionary mapping bytecode PC to
; # quadcode PC in the initial translation
set fixup {}; # Dictionary whose keys are jump targets
; # and the values are lists of quad program
; # counters that jump to them, used to fix up
; # forward jumps.
set cf [list temp @callframe]
; # Callframe is used in many places, so
; # allow it to be abbreviated
my debug-translate {
puts "Translate bytecode: $originProc"
}
# Construct a header that sets parameters and provides a fake point
# to which live-on-entry variables can be attached.
set vlist {}
foreach v [dict get $bytecode variables] {
if {!("temp" in [lindex $v 0])} {
lappend vlist [lindex $v 1]
}
}
my quads entry $cf [list literal $vlist]
my quads @debug-context {} [list literal [list proc $originProc]]
if {[dict exists $bytecode sourcefile]} {
my quads @debug-file {} [list literal [dict get $bytecode sourcefile]]
}
if {[dict exists $bytecode initiallinenumber]} {
my quads @debug-line {} \
[list literal [list [dict get $bytecode initiallinenumber] 0]]
................................................................................
if {{arg} in [lindex $v 0]} {
my quads param [list var [lindex $v 1]] [list arg $idx]
}
incr idx
}
# Make sure that the args are in the callframe.
set q [list moveToCallFrame $cf $cf]
foreach v [dict get $bytecode variables] {
if {{arg} in [lindex $v 0]} {
lappend q [list literal [lindex $v 1]] [list var [lindex $v 1]]
}
}
if {[llength $q] > 3} {
my quads {*}$q
................................................................................
set chars [list temp [incr depth -1]]
set v [list temp [incr depth -1]]
my quads strtrim $v $v $chars [list literal 1]
}
done { # End of bytecode
set v [list temp [incr depth -1]]
my quads return {} $cf $v
}
returnStk {
# NOTE! Opposite order to 'returnImm'
set v [list temp [incr depth -1]]
set opt [list temp [incr depth -1]]
set resultVar [list temp $depth]
my error-quads $pc initException $resultVar $v $opt
................................................................................
my quads copy $res $inval
}
incrStkImm {
set var [list temp [incr depth -1]]
set delta [list literal [lindex $insn 1]]
# TODO: This assumes we're dealing with qualified names!
set val {temp opd2}
my error-quads $pc directGet $val $cf $var
my generate-arith-domain-check $pc incr $val $delta
my quads purify {temp opd0} $val
my quads purify {temp opd1} $delta
my quads add $val {temp opd0} {temp opd1}
my callframe-error-quads $pc directSet $var $var $val
}
incrStk {
set delta [list temp [incr depth -1]]
set var [list temp [incr depth -1]]
# TODO: This assumes we're dealing with qualified names!
set val {temp opd2}
my error-quads $pc directGet $val $cf $var
my generate-arith-domain-check $pc incr $val $delta
my quads purify {temp opd0} $val
my quads purify {temp opd1} $delta
my quads add $val {temp opd0} {temp opd1}
my callframe-error-quads $pc directSet $var $var $val
}
incrArrayStkImm {
set elem [list temp [incr depth -1]]
set var [list temp [incr depth -1]]
set delta [list literal [lindex $insn 1]]
# TODO: This assumes we're dealing with qualified names!
set val {temp opd2}
my error-quads $pc directArrayGet $val $cf $var $elem
my generate-arith-domain-check $pc incr $val $delta
my quads purify {temp opd0} $val
my quads purify {temp opd1} $delta
my quads add $val {temp opd0} {temp opd1}
my callframe-error-quads $pc directArraySet $var $var $elem $val
}
incrArrayStk {
set delta [list temp [incr depth -1]]
set elem [list temp [incr depth -1]]
set var [list temp [incr depth -1]]
# TODO: This assumes we're dealing with qualified names!
set val {temp opd2}
my error-quads $pc directArrayGet $val $cf $var $elem
my generate-arith-domain-check $pc incr $val $delta
my quads purify {temp opd0} $val
my quads purify {temp opd1} $delta
my quads add $val {temp opd0} {temp opd1}
my callframe-error-quads\
$pc directArraySet $var $var $elem $val
}
appendStk {
set value [list temp [incr depth -1]]
set var [list temp [incr depth -1]]
# TODO: This assumes we're dealing with qualified names!
my error-quads $pc directAppend $var $var $value
}
appendArrayStk {
set value [list temp [incr depth -1]]
set elem [list temp [incr depth -1]]
set var [list temp [incr depth -1]]
# TODO: This assumes we're dealing with qualified names!
my callframe-error-quads \
$pc directArrayAppend $var $var $elem $value
}
lappendStk {
set value [list temp [incr depth -1]]
set var [list temp [incr depth -1]]
# TODO: This assumes we're dealing with qualified names!
# TODO: Typecheck: need list in $var
my callframe-error-quads \
$pc directLappend $var $var $value
}
lappendListStk {
set listvalue [list temp [incr depth -1]]
set var [list temp [incr depth -1]]
# TODO: This assumes we're dealing with qualified names!
# TODO: Typecheck: need lists in $var and $listvalue
my callframe-error-quads \
$pc directLappendList $var $var $listvalue
}
lappendArrayStk {
set value [list temp [incr depth -1]]
set elem [list temp [incr depth -1]]
set var [list temp [incr depth -1]]
# TODO: This assumes we're dealing with qualified names!
# TODO: Typecheck: need list in $var
my callframe-error-quads \
$pc directArrayLappend $var $var $elem $value
}
lappendListArrayStk {
set listvalue [list temp [incr depth -1]]
set elem [list temp [incr depth -1]]
set var [list temp [incr depth -1]]
# TODO: This assumes we're dealing with qualified names!
# TODO: Typecheck: need lists in $var and $listvalue
my callframe-error-quads $pc \
directArrayLappendList $var $var $elem $listvalue
}
existStk {
set var [list temp [incr depth -1]]
# TODO: This assumes we're dealing with qualified names!
my quads directExists $var $cf $var
}
existArrayStk {
set elem [list temp [incr depth -1]]
set var [list temp [incr depth -1]]
# TODO: This assumes we're dealing with qualified names!
my quads directArrayExists $var $cf $var $elem
}
loadStk {
set var [list temp [incr depth -1]]
# TODO: This assumes we're dealing with qualified names!
my error-quads $pc directGet $var $cf $var
}
loadArrayStk {
set elem [list temp [incr depth -1]]
set var [list temp [incr depth -1]]
# TODO: This assumes we're dealing with qualified names!
my error-quads $pc directArrayGet $var $cf $var $elem
}
storeStk {
set value [list temp [incr depth -1]]
set var [list temp [incr depth -1]]
# TODO: This assumes we're dealing with qualified names!
my callframe-error-quads $pc directSet $var $var $value
}
storeArrayStk {
set value [list temp [incr depth -1]]
set elem [list temp [incr depth -1]]
set var [list temp [incr depth -1]]
# TODO: This assumes we're dealing with qualified names!
my callframe-error-quads $pc \
directArraySet $var $var $elem $value
}
unsetStk {
set flags [list literal [lindex $insn 1]]
set var [list temp [incr depth -1]]
# TODO: This assumes we're dealing with qualified names!
my callframe-error-quads $pc \
directUnset {temp opd0} $var $flags
}
unsetArrayStk {
set flags [list literal [lindex $insn 1]]
set elem [list temp [incr depth -1]]
set var [list temp [incr depth -1]]
# TODO: This assumes we're dealing with qualified names!
my callframe-error-quads $pc \
directArrayUnset {temp opd0} $var $elem $flags
}
dictGet {
set idxNum [lindex $insn 1]
set q {}
for {set i 0} {$i < $idxNum} {incr i} {
# NOTE: Reversed
lappend q [list temp [incr depth -1]]
................................................................................
# the invoked procedure raises an error
set qd [list [list temp [expr {$depth + $acount}]]]
for {set i $rcount} {$i < $acount} {incr i} {
lappend qd [list temp [expr {$depth + $i}]]
}
my generate-function-param-check $pc $qd
# generate the call itself
my quads invoke $cf $cf {*}$qd
my quads retrieveResult {temp @exception} $cf
my quads extractCallFrame $cf $cf
my generate-jump [my exception-target $pc catch] maybe \
{temp @exception}
my quads extractMaybe $result {temp @exception}
}
invokeStk1 - invokeStk4 {
set acount [lindex $insn 1]
set depth [expr {$depth - $acount}]
................................................................................
set result [list temp $depth]
set qd {}
for {set i 0} {$i < $acount} {incr i} {
lappend qd [list temp [expr {$depth + $i}]]
}
my generate-function-param-check $pc $qd
# generate the call itself
my quads invoke $cf $cf {*}$qd
my quads retrieveResult {temp @exception} $cf
my quads extractCallFrame $cf $cf
my generate-jump [my exception-target $pc catch] maybe \
{temp @exception}
my quads extractMaybe $result {temp @exception}
}
jump1 - jump4 {
switch -exact -- [lindex $insn 1 0] {
pc {
................................................................................
my generate-jump $to_pc true $test
}
}
existScalar {
set result [list temp $depth]
set var [my index-to-var [lindex $insn 1]]
my quads moveFromCallFrame \
$var $cf [list literal [lindex $var 1]]
my quads exists $result $var
}
existArray {
set tmp [list temp $depth]
set idx [list temp [incr depth -1]]
set ary [my index-to-var [lindex $insn 1]]
set result $idx
my quads moveFromCallFrame \
$var $cf [list literal [lindex $var 1]]
my quads initArrayIfNotExists $tmp $ary
my quads arrayElementExists $result $tmp $idx
}
loadScalar1 -
loadScalar4 { # Load a variable
set result [list temp $depth]
................................................................................
set res [list temp $depth]
# TODO: Typecheck: need lists in $list1 and $list2
my error-quads $pc listConcat $res $list1 $list2
}
arrayExistsImm {
set ary [my index-to-var [lindex $insn 1]]
my quads moveFromCallFrame \
$ary $cf [list literal [lindex $ary 1]]
set res [list temp $depth]
my quads arrayExists $res $ary
}
arrayMakeImm {
set ary [my index-to-var [lindex $insn 1]]
my generate-array-check $pc $ary {} {TCL WRITE ARRAY} \
"can't array set \"%s\": variable isn't array"
my quads initArrayIfNotExists $ary $ary
my update-in-callframe [list literal [lindex $var 1]] $var
}
arrayExistsStk {
set ary [list temp [incr depth -1]]
set res [list temp $depth]
my error-quads $pc directIsArray $res $cf $ary
}
arrayMakeStk {
set ary [list temp [incr depth -1]]
set res [list temp $depth]
my callframe-error-quads $pc directMakeArray $res $ary
}
variable {
set var [my index-to-var [lindex $insn 1]]
set name [list temp [incr depth -1]]
my quads [lindex $insn 0] $cf $cf \
[list literal [lindex $var 1]] $name
my quads retrieveResult {temp @exception} $cf
my quads extractCallFrame $cf $cf
my generate-jump [my exception-target $pc catch] \
maybe {temp @exception}
}
nsupvar - upvar {
set var [my index-to-var [lindex $insn 1]]
set name [list temp [incr depth -1]]
set context [list temp [incr depth -1]]
my quads [lindex $insn 0] $cf $cf \
[list literal [lindex $var 1]] $context $name
my quads retrieveResult {temp @exception} $cf
my quads extractCallFrame $cf $cf
my generate-jump [my exception-target $pc catch] \
maybe {temp @exception}
}
currentNamespace {
my quads copy [list temp $depth] \
[list literal [dict get $bytecode namespace]]
}
infoLevelArgs {
set value [list temp [incr depth -1]]
set r [list temp $depth]
my generate-arith-domain-check $pc [lindex $insn 0] $value
my quads purify {temp opd0} $value
my error-quads $pc frameArgs $r {temp opd0} $cf
}
infoLevelNumber {
set r [list temp $depth]
my quads frameDepth $r $cf
}
expandStart {
# do nothing
}
expandStkTop {
set r [list temp [incr depth -1]]
my error-quads $pc verifyList $r $r
................................................................................
lassign [dict get $bytecode stackState $state] headWas depthWas
set result [list temp $depthWas]
set qd {}
for {set i $depthWas} {$i < $depth} {incr i} {
lappend qd [list temp $i]
}
my quads \
invokeExpanded $cf $cf {*}$qd
my quads retrieveResult {temp @exception} $cf
my quads extractCallFrame $cf $cf
my generate-jump [my exception-target $pc catch] maybe \
{temp @exception}
my quads extractMaybe $result {temp @exception}
}
default {
# TODO - Many more instructions
lappend errors $sourcefile $currentline $currentscript \
................................................................................
lset quads $q 1 [list pc [llength $quads]]
}
# let the flow analysis figure out whether this is confluent!
# lappend quads confluence
my quads returnCode [set code [list temp 0]] {temp @exception}
my quads procLeave $code $code \
[list literal [namespace tail $originProc]]
my quads return {} $cf $code
dict unset fixup -1
}
if {[dict size $fixup] > 0} {
error "Failed to fix jumps at [join [dict keys $fixup] ,]"
}
if {[llength $errors] > 1} {
set result {}
................................................................................
# Results:
# None.
oo::define quadcode::transformer method error-quads {pc opcode result args} {
my quads $opcode {temp @exception} {*}$args
set target [my exception-target $pc catch]
my generate-jump $target maybe {temp @exception}
my quads extractMaybe $result {temp @exception}
return
}
# callframe-error-quads --
#
# Generate the given quadcode, and the sequence that intercepts
# its errors and unpacks its (callframe, maybe result} tuple.
#
# Parameters:
# pc - Program counter from the original bytecode
# opcode - Opcode being emitted
# result - Result of the operation, which must be CALLFRAME FAIL SOMETHING
# args - Inputs to the operation.
#
# Results:
# None
oo::define quadcode::transformer method callframe-error-quads {pc opcode result
args} {
my quads $opcode {temp @tuple} {temp @callframe} {temp @callframe} $args
my quads extractCallFrame {temp @callframe} {temp @tuple}
my quads retrieveResult {temp @exception} {temp @tuple}
set target [my exception-target $pc catch]
my generate-jump $target maybe {temp @exception}
my quads extractMaybe $result {temp @exception}
}
# interp alias {} tcl::mathfunc::istype {} ::dataType::isa
# Local Variables:
# mode: tcl
# fill-column: 78
# auto-fill-function: nil
# End:
|
Changes to quadcode/upvar.tcl.
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
...
499
500
501
502
503
504
505
506
507
508
509
510
511
512
|
set did 0
switch -exact -- [lindex $q 0] {
"directArrayExists" -
"directArrayGet" -
"directExists" -
"directGet" {
dict set result readsGlobal {}
dict unset result pure
}
"directAppend" -
"directArrayAppend" -
"directArrayLappend" -
................................................................................
"directUnset" {
dict set result readsGlobal {}
dict set result writesGlobal {}
dict unset result pure
dict unset result killable
}
"directSet" {
dict set result writesGlobal {}
dict unset result pure
dict unset result killable
}
"moveFromCallFrame" {
|
|
>
>
|
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
...
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
|
set did 0
switch -exact -- [lindex $q 0] {
"directArrayExists" -
"directArrayGet" -
"directExists" -
"directGet" -
"directIsArray" {
dict set result readsGlobal {}
dict unset result pure
}
"directAppend" -
"directArrayAppend" -
"directArrayLappend" -
................................................................................
"directUnset" {
dict set result readsGlobal {}
dict set result writesGlobal {}
dict unset result pure
dict unset result killable
}
"directMakeArray" -
"directSet" {
dict set result writesGlobal {}
dict unset result pure
dict unset result killable
}
"moveFromCallFrame" {
|
Changes to quadcodes.txt.
252 253 254 255 256 257 258 259 260 261 |
{{purifyParam N} TGT SRC FUNC}
Sets TGT to SRC, with any IMPURE indication removed, if FUNC is a built-in
math function requiring a pure value as argument #N.
Otherwise, simply sets TGT to SRC. This operation is
replaced with 'purify' or removed during optimization. It is there to
purify the operands of built-in mathfuncs.
For these operations, the data types that must be implemented are INT32,
INT, ENTIER, DOUBLE; the same four data types unioned with EMPTY; and the
complements of these eight types, so there are sixteen variants in all.
|
> > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > |
252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 |
{{purifyParam N} TGT SRC FUNC}
Sets TGT to SRC, with any IMPURE indication removed, if FUNC is a built-in
math function requiring a pure value as argument #N.
Otherwise, simply sets TGT to SRC. This operation is
replaced with 'purify' or removed during optimization. It is there to
purify the operands of built-in mathfuncs.
# Direct variable manipulation instructions
directExists VAL CF VAR
Tests whether variable VAR exists (in callframe CF, if the value is
not fully qualified). Returns ZEROONE.
directGet VAL CF VAR
Gets the value of VAR from callframe CF and puts the result in VAL.
Result is of type {FAIL NEXIST STRING}.
directSet TUPLE CF VAR VAL
Sets variable VAR in callframe CF (or in a namespace) to the value VAL.
Returns the result of the set, or an error if the value cannot be set.
TUPLE is of type {CALLFRAME FAIL T} where T is the type of VAL.
directAppend TUPLE CF VAR VAL
Appends value VAL to variable VAR in callframe CF (or in a namespace).
Returns the result of the set, or an error if the value cannot be set.
TUPLE is of type {CALLFRAME FAIL STRING}.
directLappend TUPLE CF VAR VAL
Appends value VAL to variable VAR in callframe CF (or in a namespace).
Returns the result of the set, or an error if the value cannot be set.
TUPLE is of type {CALLFRAME FAIL STRING}.
directLappendList TUPLE CF VAR LISTVAL
Appends the list of values LISTVAL to variable VAR in callframe CF
(or in a namespace). Returns the result of the append, or an error if
the value could not be apppended. TUPLE is of type {CALLFRAME FAIL STRING}
directIsArray VAL CF ARY
Tests [array exists ARY] (in callframe CF, if ARY is not fully qualified).
Returns a Boolean indicating the existence, or an error in the event of
an error in traces. (Note that traces are not implemented in quadcode yet!)
Result is of type {FAIL ZEROONE}.
directMakeArray TUPLE CF ARY
Creates an array ARY (in callframe CF if ARY is not fully qualified).
Returns an ignored result or throws an error. Return type is {ZEROONE FAIL}.
directArrayExists VAL CF ARY ELT
Tests whether element ELT of array ARY exists (in callframe CF, if the
value is not fully qualified). Returns ZEROONE.
directArrayGet VAL CF ARY ELT
Gets the value of element ELT of array ARY in callframe CF and puts
the result in VAL. Result is of type {FAIL NEXIST STRING}.
directArraySet TUPLE CF ARY ELT VAL
Sets element ELT of array ARY in callframe CF (or in a namespace) to the
value VAL. Returns the result of the set, or an error if the value cannot
be set. TUPLE is of type {CALLFRAME FAIL T} where T is the type of VAL.
directArrayAppend TUPLE CF ARY ELT VAL
Appends value VAL to element ELT of array ARY (in callframe CF if ARY
is not fully qualified).
Returns the result of the set, or an error if the value cannot be set.
TUPLE is of type {CALLFRAME FAIL STRING}.
directArrayLappend TUPLE CF ARY ELT VAL
Appends value VAL to element ELT of array ARY (in callframe CF, if
ARY is not fully qualified). Returns the result of the operation,
or an error if the value cannot be set. TUPLE is of type
{CALLFRAME FAIL STRING}.
directArrayLappendList TUPLE CF ARY ELT LISTVAL
Appends the list of values LISTVAL to element ELT of array ARY
(in callframe CF, if ARY is not fully qualified).
Returns the result of the append, or an error if
the value could not be apppended. TUPLE is of type {CALLFRAME FAIL STRING}
For these operations, the data types that must be implemented are INT32,
INT, ENTIER, DOUBLE; the same four data types unioned with EMPTY; and the
complements of these eight types, so there are sixteen variants in all.
|