Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | Merge refactoring so that all direct operations interact correctly with the callframe. |
|---|---|
| Timelines: | family | ancestors | descendants | both | trunk |
| Files: | files | file ages | folders |
| SHA3-256: |
b9e2a13b963c8e9c62b2700baafaf4fa |
| User & Date: | kbk 2019-11-19 03:52:36.740 |
Context
|
2019-11-23
| ||
| 22:29 | Merge in refactoring of two operations, directIsArray and directMakeArray, that interact with the callframe and were missed on the first go. Leaf check-in: 7a21900824 user: kbk tags: trunk | |
|
2019-11-22
| ||
| 19:44 | Initial changes to support differences in the Tcl 8.7 ABI check-in: 668d4221ed user: kennykb tags: notworking, tcl_8_7_branch | |
|
2019-11-19
| ||
| 03:52 | Merge refactoring so that all direct operations interact correctly with the callframe. check-in: b9e2a13b96 user: kbk tags: trunk | |
| 03:48 | Merge dkf's fixes that make type coercion run in a reasonable amount of time check-in: bf9270cd5a user: kbk tags: kbk-refactor-directops | |
|
2018-12-27
| ||
| 04:12 | Eliminate the 'isBoolean' instruction in favour of using the type checking machinery check-in: 0718166269 user: kbk tags: trunk | |
Changes
Changes to codegen/build.tcl.
| ︙ | ︙ | |||
2554 2555 2556 2557 2558 2559 2560 |
# Results:
# The new dictionary value.
method dictUnset(STRING,STRING) {dict key ec {name ""}} {
my call ${tcl.dict.unset1} [list $dict $key $ec] $name
}
| | > > | > | > | > > | > | > | > > | | > > | | > | | > > > | > > | > | | > > | > | > | | > > | > | > | > > | > | > | | > > | > | > | | > | > | > | | > > | > > | > | | > | > | > | > > | > | > | | 2554 2555 2556 2557 2558 2559 2560 2561 2562 2563 2564 2565 2566 2567 2568 2569 2570 2571 2572 2573 2574 2575 2576 2577 2578 2579 2580 2581 2582 2583 2584 2585 2586 2587 2588 2589 2590 2591 2592 2593 2594 2595 2596 2597 2598 2599 2600 2601 2602 2603 2604 2605 2606 2607 2608 2609 2610 2611 2612 2613 2614 2615 2616 2617 2618 2619 2620 2621 2622 2623 2624 2625 2626 2627 2628 2629 2630 2631 2632 2633 2634 2635 2636 2637 2638 2639 2640 2641 2642 2643 2644 2645 2646 2647 2648 2649 2650 2651 2652 2653 2654 2655 2656 2657 2658 2659 2660 2661 2662 2663 2664 2665 2666 2667 2668 2669 2670 2671 2672 2673 2674 2675 2676 2677 2678 2679 2680 2681 2682 2683 2684 2685 2686 2687 2688 2689 2690 2691 2692 2693 2694 2695 2696 2697 2698 2699 2700 2701 2702 2703 2704 2705 2706 2707 2708 2709 2710 2711 2712 2713 2714 2715 2716 2717 2718 2719 2720 2721 2722 2723 2724 2725 2726 2727 2728 2729 2730 2731 2732 2733 2734 2735 2736 2737 2738 2739 2740 2741 2742 2743 2744 2745 2746 2747 2748 2749 2750 2751 2752 2753 2754 2755 2756 2757 2758 2759 2760 2761 2762 2763 2764 2765 2766 2767 2768 2769 2770 2771 2772 2773 2774 2775 2776 2777 2778 2779 2780 2781 2782 2783 2784 2785 2786 2787 2788 2789 2790 2791 2792 2793 2794 2795 2796 2797 2798 2799 2800 2801 2802 2803 2804 2805 2806 2807 2808 2809 2810 2811 2812 2813 2814 2815 2816 2817 2818 2819 2820 2821 2822 2823 2824 2825 2826 2827 2828 2829 2830 2831 2832 2833 2834 2835 2836 2837 2838 2839 2840 2841 2842 2843 2844 2845 2846 2847 2848 2849 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 2885 2886 2887 2888 2889 2890 2891 2892 2893 2894 2895 2896 2897 2898 2899 2900 2901 2902 2903 2904 2905 2906 2907 2908 2909 2910 2911 2912 2913 2914 2915 2916 2917 2918 2919 2920 |
# Results:
# The new dictionary value.
method dictUnset(STRING,STRING) {dict key ec {name ""}} {
my call ${tcl.dict.unset1} [list $dict $key $ec] $name
}
# Builder:directAppend(CALLFRAME,STRING,STRING) --
#
# Append a value to a variable, which should be referred to by a
# fully-qualified name. NOTE: this operation can fail because of traces
# so it produces a STRING FAIL. Quadcode implementation
# ('directAppend').
#
# Parameters:
# cf - The callframe where non-fully-qualified variable names resolve
# varname -
# The variable name as an LLVM value reference.
# value - The value to append as an LLVM value reference.
# ec - Where to write the error code if an error happens.
# name (optional) -
# A name to give to the result value.
#
# Results:
# The new contents of the variable.
method directAppend(CALLFRAME,STRING,STRING) \
{cf varname value ec {name ""}} {
set result [my call ${tcl.direct.append}
[list $varname {} $value $ec] $name]
return [my frame.pack $cf $result]
}
# Builder:directArrayAppend(CALLFRAME,STRING,STRING,STRING) --
#
# Append a value to an array variable, which should be referred to by a
# fully-qualified name. NOTE: this operation can fail because of traces
# so it produces a STRING FAIL. Quadcode implementation
# ('directArrayAppend').
#
# Parameters:
# cf - The callframe where non-fully-qualified names are resolved
# varname -
# The variable name as an LLVM value reference.
# elem - The element name as an LLVM value reference.
# value - The value to append as an LLVM value reference.
# ec - Where to write the error code if an error happens.
# name (optional) -
# A name to give to the result value.
#
# Results:
# The new contents of the variable.
method directArrayAppend(CALLFRAME,STRING,STRING,STRING) \
{cf varname elem value ec {name ""}} {
set result [my call ${tcl.direct.append} \
[list $varname $elem $value $ec] $name]
return [my frame.pack $cf $result]
}
# Builder:directExists(STRING) --
#
# Test if a variable exists; the variable should be referred to by a
# fully-qualified name. Quadcode implementation ('directExists').
#
# Parameters:
# cf - The callframe in which the variable is expected to appear, if
# the variable name is unqualified
# varname -
# The variable name as an LLVM value reference.
# name (optional) -
# A name to give to the result value.
#
# Results:
# A ZEROONE that indicates whether the variable is set.
method directExists(CALLFRAME,STRING) {cf varname {name ""}} {
my call ${tcl.direct.exists} [list $varname {}] $name
}
# Builder:directArrayExists(CALLFRAME,STRING,STRING) --
#
# Test if an array variable exists; the variable should be referred to
# by a fully-qualified name. Quadcode implementation
# ('directArrayExists').
#
# Parameters:
# cf - The callname where a non-fully-qualified varname is resolved
# varname -
# The variable name as an LLVM value reference.
# elem - The element name as an LLVM value reference.
# name (optional) -
# A name to give to the result value.
#
# Results:
# A ZEROONE that indicates whether the variable is set.
method directArrayExists(CALLFRAME,STRING,STRING) {cf varname
elem {name ""}} {
my call ${tcl.direct.exists} [list $varname $elem] $name
}
# Builder:directGet(CALLFRAME.STRING) --
#
# Read the value of a variable, which should be referred to by a
# fully-qualified name. NOTE: this operation can fail because of traces
# so it produces a STRING FAIL. Quadcode implementation ('directGet').
#
# Parameters:
# cf - The callframe to use for other than fully-qualified varnames
# varname -
# The variable name as an LLVM value reference.
# ec - Where to write the error code if an error happens.
# name (optional) -
# A name to give to the result value.
#
# Results:
# The contents of the variable.
method directGet(CALLFRAME,STRING) {cf varname ec {name ""}} {
set result [my call ${tcl.direct.get} [list $varname {} $ec] $name]
return [my frame.pack $cf $result]
}
# Builder:directArrayGet(STRING,STRING) --
#
# Read the value of an array variable, which should be referred to by a
# fully-qualified name. NOTE: this operation can fail because of traces
# so it produces a STRING FAIL. Quadcode implementation
# ('directArrayGet').
#
# Parameters:
# cf - Callframe in which non-fully-qualified names are resolved
# varname -
# The variable name as an LLVM value reference.
# elem - The element name as an LLVM value reference.
# ec - Where to write the error code if an error happens.
# name (optional) -
# A name to give to the result value.
#
# Results:
# The contents of the variable.
method directArrayGet(CALLFRAME,STRING,STRING) \
{cf varname elem ec {name ""}} \
{
set result [my call ${tcl.direct.get} \
[list $varname $elem $ec] $name]
return [my frame.pack $cf $result]
}
# Builder:directLappend(CALLFRAME,STRING,STRING) --
#
# Append a value to a list in a variable, which should be referred to by
# a fully-qualified name. NOTE: this operation can fail because of
# traces so it produces a STRING FAIL. Quadcode implementation
# ('directLappend').
#
# Parameters:
# cf - Callframe where non-fully-qualified variables resolve
# varname -
# The variable name as an LLVM value reference.
# value - The value to append as an LLVM value reference.
# ec - Where to write the error code if an error happens.
# name (optional) -
# A name to give to the result value.
#
# Results:
# The new contents of the variable.
method directLappend(CALLFRAME,STRING,STRING) \
{cf varname value ec {name ""}} {
set result [my call ${tcl.direct.lappend} \
[list $varname {} $value $ec] $name]
return [my frame.pack $cf $result]
}
# Builder:directArrayLappend(CALLFRAME,STRING,STRING,STRING) --
#
# Append a value to a list in an array variable, which should be
# referred to by a fully-qualified name. NOTE: this operation can fail
# because of traces so it produces a STRING FAIL. Quadcode
# implementation ('directArrayLappend').
#
# Parameters:
# cf - Callframe where non-fully-qualified variables resolve
# varname -
# The variable name as an LLVM value reference.
# elem - The element name as an LLVM value reference.
# value - The value to append as an LLVM value reference.
# ec - Where to write the error code if an error happens.
# name (optional) -
# A name to give to the result value.
#
# Results:
# The new contents of the variable.
method directArrayLappend(CALLFRAME,STRING,STRING,STRING) \
{cf varname elem value ec {name ""}} {
set result [my call ${tcl.direct.lappend} \
[list $varname $elem $value $ec] $name]
return [my frame.pack $cf $result]
}
# Builder:directLappendList(CALLFRAME,STRING,STRING) --
#
# Append the elements of a list to a list in a variable, which should be
# referred to by a fully-qualified name. NOTE: this operation can fail
# because of traces so it produces a STRING FAIL. Quadcode
# implementation ('directLappendList').
#
# Parameters:
# cf - Callframe where non-fully-qualified variables resolve
# varname -
# The variable name as an LLVM value reference.
# value - The list of values to append as an LLVM value reference.
# ec - Where to write the error code if an error happens.
# name (optional) -
# A name to give to the result value.
#
# Results:
# The new contents of the variable.
method directLappendList(CALLFRAME,STRING,STRING) \
{cf varname value ec {name ""}} {
set result [my call ${tcl.direct.lappendList} \
[list $varname {} $value $ec] $name]
return [my frame.pack $cf $result]
}
# Builder:directLappendList(CALLFRAME,STRING,STRING,STRING) --
#
# Append the elements of a list to a list in a variable, which should be
# referred to by a fully-qualified name. NOTE: this operation can fail
# because of traces so it produces a STRING FAIL. Quadcode
# implementation ('directLappendList').
#
# Parameters:
# cf - Callframe where non-fully-qualified names should resolve
# varname -
# The variable name as an LLVM value reference.
# elem - The element name as an LLVM value reference.
# value - The list of values to append as an LLVM value reference.
# ec - Where to write the error code if an error happens.
# name (optional) -
# A name to give to the result value.
#
# Results:
# The new contents of the variable.
method directArrayLappendList(CALLFRAME,STRING,STRING,STRING) \
{cf varname elem value ec {name ""}} {
set result [my call ${tcl.direct.lappendList} \
[list $varname $elem $value $ec] $name]
return [my frame.pack $cf $result]
}
# Builder:directSet(CALLFRAME,STRING,STRING) --
#
# Set the value of a variable, which should be referred to by a
# fully-qualified name. NOTE: this operation can fail because of traces
# so it produces a STRING FAIL. Quadcode implementation ('directSet').
#
# Parameters:
# cf - The callframe to use for other than fully-qualified varnames
# varname -
# The variable name as an LLVM value reference.
# value - The value to append as an LLVM value reference.
# ec - Where to write the error code if an error happens.
# name (optional) -
# A name to give to the result value.
#
# Results:
# The new contents of the variable.
method directSet(CALLFRAME,STRING,STRING) {cf varname value ec {name ""}} {
set result [my call ${tcl.direct.set} \
[list $varname {} $value $ec] $name]
return [my frame.pack $cf $result]
}
# Builder:directArraySet(CALLFRAME,STRING,STRING,STRING) --
#
# Set the value of an array variable, which should be referred to by a
# fully-qualified name. NOTE: this operation can fail because of traces
# so it produces a CALLFRAME STRING FAIL. Quadcode implementation
# ('directArraySet').
#
# Parameters:
# cf - The callframe in which non-fully-qualified names should resolve
# varname -
# The variable name as an LLVM value reference.
# elem - The element name as an LLVM value reference.
# value - The value to append as an LLVM value reference.
# ec - Where to write the error code if an error happens.
# name (optional) -
# A name to give to the result value.
#
# Results:
# The new contents of the variable.
method directArraySet(CALLFRAME,STRING,STRING,STRING) \
{cf varname elem value ec {name ""}} \
{
set result [my call ${tcl.direct.set} \
[list $varname $elem $value $ec] $name]
return [my frame.pack $cf $result]
}
# Builder:directUnset(CALLFRAME,STRING,INT) --
#
# Unset a variable, which should be referred to by a fully-qualified
# name. NOTE: this operation can fail because of traces so it produces a
# ZEROONE FAIL (with meaningless value when not failing). Quadcode
# implementation ('directUnset').
#
# Parameters:
# cf - Callframe in which non-fully-qualified names should resolve
# varname -
# The variable name as an LLVM value reference.
# flag - Whether failures are allowed, as an LLVM value reference.
# ec - Where to write the error code if an error happens.
# name (optional) -
# A name to give to the result value.
#
# Results:
# Whether the unset was successful.
method directUnset(CALLFRAME,STRING,INT) {cf varname flag ec {name ""}} {
set result [my call ${tcl.direct.unset} \
[list $varname {} $flag $ec] $name]
return [my frame.pack $cf $result]
}
# Builder:directArrayUnset(CALLFRAME,STRING,STRING,INT) --
#
# Unset an array variable, which should be referred to by a
# fully-qualified name. NOTE: this operation can fail because of traces
# so it produces a ZEROONE FAIL (with meaningless value when not
# failing). Quadcode implementation ('directArrayUnset').
#
# Parameters:
# cf - Callframe in which non-fully-qualified names should resolve
# varname -
# The variable name as an LLVM value reference.
# elem - The element name as an LLVM value reference.
# flag - Whether failures are allowed, as an LLVM value reference.
# ec - Where to write the error code if an error happens.
# name (optional) -
# A name to give to the result value.
#
# Results:
# Whether the unset was successful.
method directArrayUnset(CALLFRAME,STRING,STRING,INT) \
{cf varname elem flag ec {name ""}} {
set result [my call ${tcl.direct.unset} \
[list $varname $elem $flag $ec] $name]
return [my frame.pack $cf $result]
}
# Builder:directIsArray(STRING) --
#
# Tests if the variable whose name we are given is an array. NOTE: this
# operation can fail because of traces so it produces a BOOL FAIL.
# Quadcode implementation ('directIsArray').
#
|
| ︙ | ︙ |
Changes to codegen/compile.tcl.
| ︙ | ︙ | |||
517 518 519 520 521 522 523 |
set srcs [my ConvertIndices 0 strlen 1 2]
set res [$b $opcode {*}$srcs $errorCode $name]
if {"FAIL" in [my ValueTypes $tgt]} {
my SetErrorLine $errorCode [$b maybe $res]
}
my StoreResult $tgt $res
}
| < < < < | > > > > > > > > > > > > > > > > > | 517 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 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 |
set srcs [my ConvertIndices 0 strlen 1 2]
set res [$b $opcode {*}$srcs $errorCode $name]
if {"FAIL" in [my ValueTypes $tgt]} {
my SetErrorLine $errorCode [$b maybe $res]
}
my StoreResult $tgt $res
}
"directIsArray" - "directMakeArray" -
"regexp" - "listLength" -
"listIn" - "listNotIn" - "dictIterStart" -
"dictAppend" - "dictIncr" - "dictLappend" - "dictSize" -
"div" - "expon" - "mod" - "verifyList" -
"dictGetOrNexist" - "dictSetOrUnset" {
set srcs [lassign $l opcode tgt]
set name [my LocalVarName $tgt]
append opcode ( [my ValueTypes {*}$srcs] )
set srcs [lmap s $srcs {my LoadOrLiteral $s}]
set res [$b $opcode {*}$srcs $errorCode $name]
if {"FAIL" in [my ValueTypes $tgt]} {
my SetErrorLine $errorCode [$b maybe $res]
}
my StoreResult $tgt $res
}
"directGet" - "directSet" -
"directArrayGet" - "directArraySet" -
"directAppend" - "directLappend" -
"directLappendList" -
"directArrayAppend" - "directArrayLappend" -
"directArrayLappendList" -
"directUnset" - "directArrayUnset"
{
set srcs [lassign $l opcode tgt]
set name [my LocalVarName $tgt]
append opcode ( [my ValueTypes {*}$srcs] )
set srcs [lmap s $srcs {my LoadOrLiteral $s}]
set res [$b $opcode {*}$srcs $errorCode $name]
set resNoCF [$b frame.value $res]
my SetErrorLine $errorCode [$b maybe $resNoCF]
my StoreResult $tgt $res
}
"listAppend" - "listConcat" - "listRange" {
set srcs [lassign $l opcode tgt]
set src1 [lindex $srcs 0]
set name [my LocalVarName $tgt]
append opcode ( [my ValueTypes {*}$srcs] )
set srcs [lmap s $srcs {my LoadOrLiteral $s}]
if {consumed($src1, $pc + 1)} {
|
| ︙ | ︙ |
Changes to codegen/struct.tcl.
| ︙ | ︙ | |||
2656 2657 2658 2659 2660 2661 2662 |
# deleted).
#
# Public properties:
# none (but see LLVMBuilder class).
oo::class create Builder {
superclass LLVMBuilder
| | | 2656 2657 2658 2659 2660 2661 2662 2663 2664 2665 2666 2667 2668 2669 2670 |
# deleted).
#
# Public properties:
# none (but see LLVMBuilder class).
oo::class create Builder {
superclass LLVMBuilder
variable TypeConversions DefaultTypeConversion
constructor {module {builder ""}} {
next $module $builder
# The auto-widening type conversions. These are used to generate extra
# methods on the fly. Note that the values for each of these keys is a
# script that is evaluated in the MakeTypecastWrapper method.
|
| ︙ | ︙ | |||
2844 2845 2846 2847 2848 2849 2850 |
[string map [list @b1 [list $b1]] {
set v [lindex $f 0]
append body1 \; [string map [list @v [list $v]] @b1]
append body2 { } \$ [lindex $f 0]
}]]
}
| < < < < < < < < < < < < < < | | < < < | 2844 2845 2846 2847 2848 2849 2850 2851 2852 2853 2854 2855 2856 2857 2858 2859 |
[string map [list @b1 [list $b1]] {
set v [lindex $f 0]
append body1 \; [string map [list @v [list $v]] @b1]
append body2 { } \$ [lindex $f 0]
}]]
}
# The type "conversion" operation used as a no-op
set DefaultTypeConversion {append body2 { $} [lindex $f 0]}
}
# Builder:unknown --
#
# Interceptor for method calls that are not already present. Delegates
# the test for whether we want to take action on this to the
# 'MakeTypecastWrapper' method; if that returns true, we *replace* this
|
| ︙ | ︙ | |||
2966 2967 2968 2969 2970 2971 2972 |
# necessary, provided there is a way of generating the instruction
# with DOUBLE in the first place.
# First, extract the type signature that we're trying to generate.
if {![regexp {^([^()]+)\(([\w, ]+)\)$} $signature -> name types]} {
return 0
}
| | > < > > < > > | > > | | > | > > > | > > | > > | | | > | | < | > > | > | | < < < < < | < | 2949 2950 2951 2952 2953 2954 2955 2956 2957 2958 2959 2960 2961 2962 2963 2964 2965 2966 2967 2968 2969 2970 2971 2972 2973 2974 2975 2976 2977 2978 2979 2980 2981 2982 2983 2984 2985 2986 2987 2988 2989 2990 2991 2992 2993 2994 2995 2996 2997 2998 2999 3000 3001 3002 3003 3004 3005 3006 3007 3008 3009 3010 |
# necessary, provided there is a way of generating the instruction
# with DOUBLE in the first place.
# First, extract the type signature that we're trying to generate.
if {![regexp {^([^()]+)\(([\w, ]+)\)$} $signature -> name types]} {
return 0
}
set types [split $types ","]
set num [llength $types]
# Get the type signatures we could go to
set methods [info class methods [self class]]
# Search the space of possible conversions for ones that are legal,
# and compute the cost of each.
set mapped {}
foreach targetinfo $methods {
if {![regexp {^([^()]+)\(([\w, ]+)\)$} $targetinfo \
-> tname ttypes]} {
continue
}
if {$name ne $tname} {
continue
}
set ttypes [split $ttypes ","]
if {[llength $types] != [llength $ttypes]} {
continue
}
set thiscost 0
set legal true
set cvts [lmap st $types tt $ttypes {
if {$st eq $tt} {
# No-conversion is always legal and always very cheap
set c $DefaultTypeConversion
} else {
# Look up if we have a conversion
set typepair [list $st $tt]
if {![dict exists $TypeConversions $typepair]} {
set legal false
# Continue the outer loop
break
}
set c [dict get $TypeConversions $typepair]
}
# The cost of a conversion is just its length. That is WRONG,
# but approximates the real cost.
incr thiscost [string length $c]
string cat $c
}]
if {$legal} {
lappend mapped $thiscost $targetinfo $cvts
}
}
# Select the cheapest conversion and generate the method that uses it.
foreach {- n cvts} [lsort -stride 3 -integer -index 0 $mapped] {
set formals [lindex [info class definition [self class] $n] 0]
set body1 "set {string casts} {}"
set body2 ""
foreach c $cvts t $types f [lrange $formals 0 [expr {$num-1}]] {
eval $c
}
|
| ︙ | ︙ |
Changes to demos/perftest/tester.tcl.
| ︙ | ︙ | |||
2749 2750 2751 2752 2753 2754 2755 |
linesearch::colinear
linesearch::sameline
linesearch::getAllLines1
linesearch::getAllLines2
regexptest::*
vartest::*
nsvartest::*
| > | > > > > | 2749 2750 2751 2752 2753 2754 2755 2756 2757 2758 2759 2760 2761 2762 2763 2764 2765 2766 2767 2768 |
linesearch::colinear
linesearch::sameline
linesearch::getAllLines1
linesearch::getAllLines2
regexptest::*
vartest::*
nsvartest::*
directtest::init directtest::accum directtest::summarize
directtest::check
directtest::ary1
directtest::ary2 directtest::ary3
directtest::ary4 directtest::ary5
directtest::alias
upvar0
upvar0a
upvartest0::*
upvartest1::*
upvartest2::*
flightawarebench::*
hash::*
|
| ︙ | ︙ |
Changes to quadcode/translate.tcl.
| ︙ | ︙ | |||
632 633 634 635 636 637 638 |
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}
| | > | | > | | | | | | > | | > | > | | | | | | > | > | > | > | | 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 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 |
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 generate-callframe-op $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 generate-callframe-op $pc directSet $var $var $val
# WAS: 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 generate-callframe-op $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 generate-callframe-op $pc directSet $var $var $val
# WAS: 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 generate-callframe-op $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 generate-callframe-op $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 generate-callframe-op $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 generate-callframe-op $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 generate-callframe-op $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 generate-callframe-op \
$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 generate-callframe-op $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 generate-callframe-op \
$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 generate-callframe-op \
$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 generate-callframe-op $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 {temp @callframe} $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 {temp @callframe} $var $elem
}
loadStk {
set var [list temp [incr depth -1]]
# TODO: This assumes we're dealing with qualified names!
my generate-callframe-op $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 generate-callframe-op $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 generate-callframe-op $pc directSet $var $var $value
# WAS: 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 generate-callframe-op \
$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 generate-callframe-op $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 generate-callframe-op $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]]
|
| ︙ | ︙ | |||
1456 1457 1458 1459 1460 1461 1462 1463 1464 1465 1466 1467 1468 1469 |
? [set $exceptionField]
: $catch
}]
}
}
return $to_pc
}
# generate-jump --
#
# Generates a jump instruction and appends it to the list of quadcodes
# being built. Do not call from anywhere other than bytecode-to-quads!
#
# Example uses:
| > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > | 1465 1466 1467 1468 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511 1512 1513 1514 1515 |
? [set $exceptionField]
: $catch
}]
}
}
return $to_pc
}
# generate-callframe-op --
#
# Generates an operation such as 'directSet' that returns CALLFRAME
# FAIL STRING, and the necessary gubbins to extract the results.
#
# Parameters:
# pc - Program counter in the bytecode corresponding to the
# program location being compiler
# opcode - Opcode to be generated
# result - Result where the STRING operation is to be stored after
# callframe and failure status are extracted.
# args - Remaining arguments for the generated instruction. The callframe
# will be an implied first argument.
#
# Results:
# None.
#
# Side effects:
# Generates a seqquence like:
# directSet callframeTemp callframeIn varName value
# retrieveResult exceptionAndResult callframeTemp
# extractCallFrame callframeOut callframeTemp
# jumpMaybe catchBlock exceptionAndResult
# extractMaybe resultVar exceptionAndResult.
oo::define quadcode::transformer method generate-callframe-op {pc opcode
result args} {
my quads $opcode {temp @callframe} {temp @callframe} {*}$args
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}
return
}
# generate-jump --
#
# Generates a jump instruction and appends it to the list of quadcodes
# being built. Do not call from anywhere other than bytecode-to-quads!
#
# Example uses:
|
| ︙ | ︙ |
Changes to quadcode/types.tcl.
| ︙ | ︙ | |||
700 701 702 703 704 705 706 |
set inty [typeOfOperand $types [lindex $q 2]]
return [expr {($inty & $CALLFRAME) | $FAIL | $STRING}]
}
callFrameNop - startCatch {
return $CALLFRAME
}
nsupvar - upvar - variable {
| | | 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 |
set inty [typeOfOperand $types [lindex $q 2]]
return [expr {($inty & $CALLFRAME) | $FAIL | $STRING}]
}
callFrameNop - startCatch {
return $CALLFRAME
}
nsupvar - upvar - variable {
return [expr {$CALLFRAME | $ZEROONE | $FAIL}]
}
retrieveResult {
# Pull from the callframe of the earlier 'invoke'
return [expr {[typeOfOperand $types [lindex $q 2]] & ~$CALLFRAME}]
}
extractCallFrame {
# Trim the non-callframe part
|
| ︙ | ︙ | |||
758 759 760 761 762 763 764 |
}
resolveCmd {
return $STRING
}
originCmd - frameArgs {
return [expr {$STRING | $FAIL}]
}
| | | | > > > > > > | | | 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 |
}
resolveCmd {
return $STRING
}
originCmd - frameArgs {
return [expr {$STRING | $FAIL}]
}
directGet - directSet - directArrayGet - directArraySet -
directAppend - directLappend - directLappendList -
directArrayAppend - directArrayLappend - directArrayLappendList {
# Can't assume more; these may be touching traced variables
return [expr {$CALLFRAME | $STRING | $FAIL}]
}
directUnset - directArrayUnset {
# may be touching traced variables, and may fail but does not
# return a direct result. Say that they return a boolean because
# the code issuer wants everything to return a value.
return [expr {$CALLFRAME | $FAIL | $ZEROONE}]
}
directExists - directArrayExists {
return $BOOL
}
directIsArray - directMakeArray {
return [expr {$ZEROONE | $FAIL}]
}
procLeave {
# Produces a pure FAIL
return $FAIL
}
default {
error "Cannot infer type of result of $q"
|
| ︙ | ︙ |