Check-in [b9e2a13b96]

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: b9e2a13b963c8e9c62b2700baafaf4fadd9511e3810931622e802867b8ed0b0f
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
Unified Diff Ignore Whitespace Patch
Changes to codegen/build.tcl.
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
    # 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(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:

    #	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(STRING,STRING) {varname value ec {name ""}} {

	my call ${tcl.direct.append} [list $varname {} $value $ec] $name

    }

    # Builder:directArrayAppend(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:

    #	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(STRING,STRING,STRING) {varname elem value ec {name ""}} {

	my call ${tcl.direct.append} [list $varname $elem $value $ec] $name

    }

    # Builder:directExists(STRING) --
    #
    #	Test if a variable exists; the variable should be referred to by a
    #	fully-qualified name. Quadcode implementation ('directExists').
    #
    # Parameters:


    #	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(STRING) {varname {name ""}} {
	my call ${tcl.direct.exists} [list $varname {}] $name
    }

    # Builder:directArrayExists(STRING,STRING) --
    #
    #	Test if an array variable exists; the variable should be referred to
    #	by a fully-qualified name. Quadcode implementation
    #	('directArrayExists').
    #
    # Parameters:

    #	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(STRING,STRING) {varname elem {name ""}} {
	my call ${tcl.direct.exists} [list $varname $elem] $name
    }

    # Builder:directGet(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:

    #	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(STRING) {varname ec {name ""}} {
	my call ${tcl.direct.get} [list $varname {} $ec] $name

    }

    # 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:

    #	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(STRING,STRING) {varname elem ec {name ""}} {


	my call ${tcl.direct.get} [list $varname $elem $ec] $name

    }

    # Builder:directLappend(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:

    #	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(STRING,STRING) {varname value ec {name ""}} {

	my call ${tcl.direct.lappend} [list $varname {} $value $ec] $name

    }

    # Builder:directArrayLappend(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:

    #	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(STRING,STRING,STRING) {varname elem value ec {name ""}} {

	my call ${tcl.direct.lappend} [list $varname $elem $value $ec] $name

    }

    # Builder:directLappendList(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:

    #	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(STRING,STRING) {varname value ec {name ""}} {

	my call ${tcl.direct.lappendList} [list $varname {} $value $ec] $name

    }

    # Builder:directLappendList(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:

    #	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(STRING,STRING,STRING) {varname elem value ec {name ""}} {

	my call ${tcl.direct.lappendList} [list $varname $elem $value $ec] $name

    }

    # Builder:directSet(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:

    #	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(STRING,STRING) {varname value ec {name ""}} {

	my call ${tcl.direct.set} [list $varname {} $value $ec] $name

    }

    # Builder:directArraySet(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 STRING FAIL. Quadcode implementation
    #	('directArraySet').
    #
    # Parameters:

    #	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(STRING,STRING,STRING) {varname elem value ec {name ""}} {


	my call ${tcl.direct.set} [list $varname $elem $value $ec] $name

    }

    # Builder:directUnset(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:

    #	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(STRING,INT) {varname flag ec {name ""}} {

	my call ${tcl.direct.unset} [list $varname {} $flag $ec] $name

    }

    # Builder:directArrayUnset(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:

    #	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(STRING,STRING,INT) {varname elem flag ec {name ""}} {

	my call ${tcl.direct.unset} [list $varname $elem $flag $ec] $name

    }

    # 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').
    #







|







>










>
|
>
|
>


|







>











>
|
>
|
>
|







>
>








|



|






>









>
|



|






>









|
|
>










>










>
|
>
>
|
>
|

|







>










>
|
>
|
>
|

|







>











>
|
>
|
>


|







>










>
|
>
|
>
|

|







>











>
|
>
|
>
|

|






>










|
>
|
>


|



|



>











>
|
>
>
|
>
|

|







>










|
>
|
>


|







>











>
|
>
|
>
|







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
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
		    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
		}
		"directGet" - "directSet" - "directAppend" - "directLappend" -
		"directLappendList" - "directUnset" -
		"directArrayGet" - "directArraySet" - "directArrayAppend" -
		"directArrayLappend" - "directArrayLappendList" -
		"directArrayUnset" - "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
		}

















		"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)} {







<
<
<
<
|















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







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
2663
2664
2665
2666
2667
2668
2669
2670
#		deleted).
#
# Public properties:
#	none (but see LLVMBuilder class).

oo::class create Builder {
    superclass LLVMBuilder
    variable TypeConversions

    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.







|







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
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
		    [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]
		    }]]
	}

	# 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 {
		set key [list $type $type]
		if {![dict exists $TypeConversions $key]} {
		    dict set TypeConversions $key \
			{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







<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
|
<
<
<







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
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
3011
3012
3013
3014
3015
3016
3017
	# 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 ,]


	# The order of this determines the order we check them in



	# Search the space of possible conversions for ones that are legal,
	# and compute the cost of each.
	set clist [dict keys $TypeConversions]
	set mapped {}


	for {set i 0} {$i < [llength $clist]**[llength $types]} {incr i} {


	    set types2 {}
	    set cvts {}

	    set j $i



	    set thiscost 0
	    set legal true
	    foreach t $types {


		set c [lindex $clist [expr {$j % [llength $clist]}]]


		set j [expr {$j / [llength $clist]}]
		if {$t ne [lindex $c 0]} {
		    set legal false

		    break
		}
		lappend types2 [lindex $c 1]
		set c [dict get $TypeConversions $c]


		lappend cvts $c
		incr thiscost [string length $c]

	    }
	    if {!$legal} {
		continue
	    }
	    set n ${name}([join $types2 ,])
	    if {$n eq $signature} continue
	    if {$n in [info class methods [self class]]} {
		lappend mapped $thiscost $n $cvts
	    }
	}

	# Select the cheapest conversion and generate the method that uses it.
	set num [llength $types]
	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
	    }







|
>

<
>
>



<

>
>
|
>
>
|
|
>
|
>
>
>


|
>
>
|
>
>
|
|
|
>
|
|
<
|
>
>
|

>
|
|
<
<
<
<
<
|




<







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

2756




2757
2758
2759
2760
2761
2762
2763
    linesearch::colinear
    linesearch::sameline
    linesearch::getAllLines1
    linesearch::getAllLines2
    regexptest::*
    vartest::*
    nsvartest::*

    directtest::*




    upvar0
    upvar0a
    upvartest0::*
    upvartest1::*
    upvartest2::*
    flightawarebench::*
    hash::*







>
|
>
>
>
>







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
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
		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]]







|




>
|






|




>
|







|




|







|




|





|






>
|






|






>
|







>
|







|





|





|




|





|





>
|






>
|





>
|






>
|







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
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 | $BOOL | $FAIL}]
	}
	retrieveResult {
	    # Pull from the callframe of the earlier 'invoke'
	    return [expr {[typeOfOperand $types [lindex $q 2]] & ~$CALLFRAME}]
	}
	extractCallFrame {
	    # Trim the non-callframe part







|







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
765
766
767
768
769






770
771
772
773
774
775
776
777
778
779
780
781
782
	}
	resolveCmd {
	    return $STRING
	}
	originCmd - frameArgs {
	    return [expr {$STRING | $FAIL}]
	}
	directGet - directSet - directAppend - directLappend -
	directLappendList - directArrayGet - directArraySet -
	directArrayAppend - directArrayLappend - directArrayLappendList {
	    # Can't assume more; these may be touching traced variables
	    return [expr {$STRING | $FAIL}]






	}
	directExists - directArrayExists {
	    return $BOOL
	}
	directUnset - directArrayUnset - directIsArray - directMakeArray {
	    return [expr {$BOOL | $FAIL}]
	}
	procLeave {
	    # Produces a pure FAIL
	    return $FAIL
	}
	default {
	    error "Cannot infer type of result of $q"







|
|


|
>
>
>
>
>
>




|
|







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"