Check-in [1ff2a97784]
Bounty program for improvements to Tcl and certain Tcl packages.

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

Overview
Comment:directArraySet interacts with the callframe
Timelines: family | ancestors | descendants | both | kbk-refactor-directops
Files: files | file ages | folders
SHA3-256: 1ff2a9778495b17c2f466ecc3f3e552c23d0a22cbd0f04fb4aaec86da70f1213
User & Date: kbk 2019-11-12 02:48:10
Context
2019-11-12
03:13
direct append operations interact with the callframe check-in: 9837744239 user: kbk tags: kbk-refactor-directops
02:48
directArraySet interacts with the callframe check-in: 1ff2a97784 user: kbk tags: kbk-refactor-directops
02:36
directArrayGet interacts with the callframe check-in: 9d33782061 user: kbk tags: kbk-refactor-directops
Changes

Changes to codegen/build.tcl.

2682
2683
2684
2685
2686
2687
2688
2689


2690

2691
2692
2693
2694
2695
2696
2697
2698
2699
....
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
    #	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(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').
................................................................................

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






|
>
>
|
>
|
|







 







|



|



>











>
|
>
>
|
>
|







2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
....
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
    #	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(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').
................................................................................

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

Changes to codegen/compile.tcl.

519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
...
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
		    if {"FAIL" in [my ValueTypes $tgt]} {
			my SetErrorLine $errorCode [$b maybe $res]
		    }
		    my StoreResult $tgt $res
		}
		"directAppend" - "directLappend" -
		"directLappendList" - "directUnset" -
		"directArraySet" - "directArrayAppend" -
		"directArrayLappend" - "directArrayLappendList" -
		"directArrayUnset" - "directIsArray" - "directMakeArray" -
		"regexp" - "listLength" -
		"listIn" - "listNotIn" - "dictIterStart" -
		"dictAppend" - "dictIncr" - "dictLappend" - "dictSize" -
		"div" - "expon" - "mod" - "verifyList" -
		"dictGetOrNexist" - "dictSetOrUnset" {
................................................................................
		    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" {
		    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]






|







 







|







519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
...
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
		    if {"FAIL" in [my ValueTypes $tgt]} {
			my SetErrorLine $errorCode [$b maybe $res]
		    }
		    my StoreResult $tgt $res
		}
		"directAppend" - "directLappend" -
		"directLappendList" - "directUnset" -
		"directArrayAppend" -
		"directArrayLappend" - "directArrayLappendList" -
		"directArrayUnset" - "directIsArray" - "directMakeArray" -
		"regexp" - "listLength" -
		"listIn" - "listNotIn" - "dictIterStart" -
		"dictAppend" - "dictIncr" - "dictLappend" - "dictSize" -
		"div" - "expon" - "mod" - "verifyList" -
		"dictGetOrNexist" - "dictSetOrUnset" {
................................................................................
		    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" {
		    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]

Changes to quadcode/translate.tcl.

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
...
757
758
759
760
761
762
763

764
765
766
767
768
769
770
771
		# 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 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 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 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
	    }
................................................................................
		# 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 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
	    }






|












|







 







>
|







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
...
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
		# 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 error-quads $pc directAppend $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 error-quads $pc directUnset {temp opd0} $var $flags
	    }

Changes to quadcode/types.tcl.

759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
	resolveCmd {
	    return $STRING
	}
	originCmd - frameArgs {
	    return [expr {$STRING | $FAIL}]
	}
	directAppend - directLappend -
	directLappendList - directArraySet -
	directArrayAppend - directArrayLappend - directArrayLappendList {
	    # Can't assume more; these may be touching traced variables
	    return [expr {$STRING | $FAIL}]
	}
	directGet - directSet - directArrayGet {
	    return [expr {$CALLFRAME | $STRING | $FAIL}]
	}
	directExists - directArrayExists {
	    return $BOOL
	}
	directUnset - directArrayUnset - directIsArray - directMakeArray {
	    return [expr {$BOOL | $FAIL}]






|




|







759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
	resolveCmd {
	    return $STRING
	}
	originCmd - frameArgs {
	    return [expr {$STRING | $FAIL}]
	}
	directAppend - directLappend -
	directLappendList -
	directArrayAppend - directArrayLappend - directArrayLappendList {
	    # Can't assume more; these may be touching traced variables
	    return [expr {$STRING | $FAIL}]
	}
	directGet - directSet - directArrayGet - directArraySet {
	    return [expr {$CALLFRAME | $STRING | $FAIL}]
	}
	directExists - directArrayExists {
	    return $BOOL
	}
	directUnset - directArrayUnset - directIsArray - directMakeArray {
	    return [expr {$BOOL | $FAIL}]