Tcl Source Code

Check-in [7e41c534a9]
Login

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

Overview
Comment:Fix handling of 'invokeExpanded' and start to do 'returnStk'.
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | descendants | both | dkf-loop-exception-range-work
Files: files | file ages | folders
SHA1: 7e41c534a99aa9fa76905fd5e0b2ec935d38650f
User & Date: dkf 2013-10-19 14:11:28.040
Context
2013-10-20
18:11
And the last bits that need fixing; the code is still less efficient than desired but should now not... Closed-Leaf check-in: bd1fb54305 user: dkf tags: dkf-loop-exception-range-work
2013-10-19
14:11
Fix handling of 'invokeExpanded' and start to do 'returnStk'. check-in: 7e41c534a9 user: dkf tags: dkf-loop-exception-range-work
12:29
Added missing exception range finalize. check-in: 9a368b1f23 user: dkf tags: dkf-loop-exception-range-work
Changes
Unified Diff Ignore Whitespace Patch
Changes to generic/tclCompCmdsGR.c.
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
	    && (wordTokenPtr[1].size == 8)
	    && (strncmp(wordTokenPtr[1].start, "-options", 8) == 0)) {
	Tcl_Token *optsTokenPtr = TokenAfter(wordTokenPtr);
	Tcl_Token *msgTokenPtr = TokenAfter(optsTokenPtr);

	CompileWord(envPtr, optsTokenPtr, interp, 2);
	CompileWord(envPtr, msgTokenPtr,  interp, 3);
	TclEmitOpcode(INST_RETURN_STK, envPtr);
	return TCL_OK;
    }

    /*
     * Allocate some working space.
     */








|







2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
	    && (wordTokenPtr[1].size == 8)
	    && (strncmp(wordTokenPtr[1].start, "-options", 8) == 0)) {
	Tcl_Token *optsTokenPtr = TokenAfter(wordTokenPtr);
	Tcl_Token *msgTokenPtr = TokenAfter(optsTokenPtr);

	CompileWord(envPtr, optsTokenPtr, interp, 2);
	CompileWord(envPtr, msgTokenPtr,  interp, 3);
	TclEmitInvoke(envPtr, INST_RETURN_STK);
	return TCL_OK;
    }

    /*
     * Allocate some working space.
     */

2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
	PushStringLiteral(envPtr, "");
    }

    /*
     * Issue the RETURN itself.
     */

    TclEmitOpcode(INST_RETURN_STK, envPtr);
    return TCL_OK;
}

static void
CompileReturnInternal(
    CompileEnv *envPtr,
    unsigned char op,







|







2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
	PushStringLiteral(envPtr, "");
    }

    /*
     * Issue the RETURN itself.
     */

    TclEmitInvoke(envPtr, INST_RETURN_STK);
    return TCL_OK;
}

static void
CompileReturnInternal(
    CompileEnv *envPtr,
    unsigned char op,
Changes to generic/tclCompile.c.
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
     * result is pushed: the stack top changes by (1-wordIdx).
     *
     * Note that the estimates are not correct while the command
     * is being prepared and run, INST_EXPAND_STKTOP is not
     * stack-neutral in general.
     */

    TclEmitInvoke(envPtr, INST_INVOKE_EXPANDED);
    envPtr->expandCount--;
    TclAdjustStackDepth(1 - wordIdx, envPtr);
}

static int 
CompileCmdCompileProc(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    Command *cmdPtr,







|
<
<







1798
1799
1800
1801
1802
1803
1804
1805


1806
1807
1808
1809
1810
1811
1812
     * result is pushed: the stack top changes by (1-wordIdx).
     *
     * Note that the estimates are not correct while the command
     * is being prepared and run, INST_EXPAND_STKTOP is not
     * stack-neutral in general.
     */

    TclEmitInvoke(envPtr, INST_INVOKE_EXPANDED, wordIdx);


}

static int 
CompileCmdCompileProc(
    Tcl_Interp *interp,
    Tcl_Parse *parsePtr,
    Command *cmdPtr,
3927
3928
3929
3930
3931
3932
3933
3934

3935
3936
3937
3938
3939
3940
3941
    CompileEnv *envPtr,
    int opcode,
    ...)
{
    va_list argList;
    ExceptionRange *rangePtr;
    ExceptionAux *auxBreakPtr, *auxContinuePtr;
    int arg1, arg2, wordCount = 0, loopRange, breakRange, continueRange;


    /*
     * Parse the arguments.
     */

    va_start(argList, opcode);
    switch (opcode) {







|
>







3925
3926
3927
3928
3929
3930
3931
3932
3933
3934
3935
3936
3937
3938
3939
3940
    CompileEnv *envPtr,
    int opcode,
    ...)
{
    va_list argList;
    ExceptionRange *rangePtr;
    ExceptionAux *auxBreakPtr, *auxContinuePtr;
    int arg1, arg2, wordCount = 0, expandCount = 0;
    int loopRange, breakRange, continueRange;

    /*
     * Parse the arguments.
     */

    va_start(argList, opcode);
    switch (opcode) {
3951
3952
3953
3954
3955
3956
3957







3958
3959


3960
3961
3962
3963
3964
3965
3966
3967
3968
3969
3970
3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
3995
	arg1 = va_arg(argList, int);
	arg2 = va_arg(argList, int);
	wordCount = arg1 + arg2 - 1;
	break;
    default:
	Tcl_Panic("unexpected opcode");
    case INST_EVAL_STK:







    case INST_INVOKE_EXPANDED:
	wordCount = arg1 = arg2 = 0;


	break;
    }
    va_end(argList);

    /*
     * Determine if we need to handle break and continue exceptions with a
     * special handling exception range (so that we can correctly unwind the
     * stack).
     *
     * These must be done separately; they can be different (especially for
     * calls from inside a [for] increment clause).
     */

    rangePtr = TclGetInnermostExceptionRange(envPtr, TCL_BREAK, &auxBreakPtr);
    if (rangePtr == NULL || rangePtr->type != LOOP_EXCEPTION_RANGE) {
	auxBreakPtr = NULL;
    } else if (auxBreakPtr->stackDepth == envPtr->currStackDepth-wordCount
	    && auxBreakPtr->expandTarget == envPtr->expandCount) {
	auxBreakPtr = NULL;
    } else {
	breakRange = auxBreakPtr - envPtr->exceptAuxArrayPtr;
    }

    rangePtr = TclGetInnermostExceptionRange(envPtr, TCL_CONTINUE,
	    &auxContinuePtr);
    if (rangePtr == NULL || rangePtr->type != LOOP_EXCEPTION_RANGE) {
	auxContinuePtr = NULL;
    } else if (auxContinuePtr->stackDepth == envPtr->currStackDepth-wordCount
	    && auxContinuePtr->expandTarget == envPtr->expandCount) {
	auxContinuePtr = NULL;
    } else {
	continueRange = auxBreakPtr - envPtr->exceptAuxArrayPtr;
    }

    if (auxBreakPtr != NULL || auxContinuePtr != NULL) {
	loopRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);







>
>
>
>
>
>
>

|
>
>

















|










|







3950
3951
3952
3953
3954
3955
3956
3957
3958
3959
3960
3961
3962
3963
3964
3965
3966
3967
3968
3969
3970
3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
3990
3991
3992
3993
3994
3995
3996
3997
3998
3999
4000
4001
4002
4003
	arg1 = va_arg(argList, int);
	arg2 = va_arg(argList, int);
	wordCount = arg1 + arg2 - 1;
	break;
    default:
	Tcl_Panic("unexpected opcode");
    case INST_EVAL_STK:
	wordCount = 1;
	arg1 = arg2 = 0;
	break;
    case INST_RETURN_STK:
	wordCount = 2;
	arg1 = arg2 = 0;
	break;
    case INST_INVOKE_EXPANDED:
	wordCount = arg1 = va_arg(argList, int);
	arg2 = 0;
	expandCount = 1;
	break;
    }
    va_end(argList);

    /*
     * Determine if we need to handle break and continue exceptions with a
     * special handling exception range (so that we can correctly unwind the
     * stack).
     *
     * These must be done separately; they can be different (especially for
     * calls from inside a [for] increment clause).
     */

    rangePtr = TclGetInnermostExceptionRange(envPtr, TCL_BREAK, &auxBreakPtr);
    if (rangePtr == NULL || rangePtr->type != LOOP_EXCEPTION_RANGE) {
	auxBreakPtr = NULL;
    } else if (auxBreakPtr->stackDepth == envPtr->currStackDepth-wordCount
	    && auxBreakPtr->expandTarget == envPtr->expandCount-expandCount) {
	auxBreakPtr = NULL;
    } else {
	breakRange = auxBreakPtr - envPtr->exceptAuxArrayPtr;
    }

    rangePtr = TclGetInnermostExceptionRange(envPtr, TCL_CONTINUE,
	    &auxContinuePtr);
    if (rangePtr == NULL || rangePtr->type != LOOP_EXCEPTION_RANGE) {
	auxContinuePtr = NULL;
    } else if (auxContinuePtr->stackDepth == envPtr->currStackDepth-wordCount
	    && auxContinuePtr->expandTarget == envPtr->expandCount-expandCount) {
	auxContinuePtr = NULL;
    } else {
	continueRange = auxBreakPtr - envPtr->exceptAuxArrayPtr;
    }

    if (auxBreakPtr != NULL || auxContinuePtr != NULL) {
	loopRange = TclCreateExceptRange(LOOP_EXCEPTION_RANGE, envPtr);
4005
4006
4007
4008
4009
4010
4011


4012
4013
4014
4015



4016
4017
4018
4019
4020
4021
4022
	TclEmitInstInt1(INST_INVOKE_STK1, arg1, envPtr);
	break;
    case INST_INVOKE_STK4:
	TclEmitInstInt4(INST_INVOKE_STK4, arg1, envPtr);
	break;
    case INST_INVOKE_EXPANDED:
	TclEmitOpcode(INST_INVOKE_EXPANDED, envPtr);


	break;
    case INST_EVAL_STK:
	TclEmitOpcode(INST_EVAL_STK, envPtr);
	break;



    case INST_INVOKE_REPLACE:
	TclEmitInstInt4(INST_INVOKE_REPLACE, arg1, envPtr);
	TclEmitInt1(arg2, envPtr);
	TclAdjustStackDepth(-1, envPtr); /* Correction to stack depth calcs */
	break;
    }








>
>




>
>
>







4013
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
4024
4025
4026
4027
4028
4029
4030
4031
4032
4033
4034
4035
	TclEmitInstInt1(INST_INVOKE_STK1, arg1, envPtr);
	break;
    case INST_INVOKE_STK4:
	TclEmitInstInt4(INST_INVOKE_STK4, arg1, envPtr);
	break;
    case INST_INVOKE_EXPANDED:
	TclEmitOpcode(INST_INVOKE_EXPANDED, envPtr);
	envPtr->expandCount--;
	TclAdjustStackDepth(1 - arg1, envPtr);
	break;
    case INST_EVAL_STK:
	TclEmitOpcode(INST_EVAL_STK, envPtr);
	break;
    case INST_RETURN_STK:
	TclEmitOpcode(INST_RETURN_STK, envPtr);
	break;
    case INST_INVOKE_REPLACE:
	TclEmitInstInt4(INST_INVOKE_REPLACE, arg1, envPtr);
	TclEmitInt1(arg2, envPtr);
	TclAdjustStackDepth(-1, envPtr); /* Correction to stack depth calcs */
	break;
    }

Changes to tests/for.test.
1063
1064
1065
1066
1067
1068
1069




















































































































1070
1071
1072
1073
1074
1075
1076
		}}] d e f]]
	    }]
	    set tmp $end
	    set end [meminfo]
	}
	expr {$end - $tmp}
    }}




















































































































} 0

# cleanup
::tcltest::cleanupTests
return

# Local Variables:







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







1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
		}}] d e f]]
	    }]
	    set tmp $end
	    set end [meminfo]
	}
	expr {$end - $tmp}
    }}
} 0
test for-7.17 {Bug 3614226: ensure that break from expanded command cleans up the stack} memory {
    apply {op {
	# Can't use [memtest]; must be careful when we change stack frames
	set end [meminfo]
	for {set i 0} {$i < 5} {incr i} {
	    for {set x 0} {$x < 5} {incr x} {
		list a b c [{*}$op] d e f
	    }
	    set tmp $end
	    set end [meminfo]
	}
	expr {$end - $tmp}
    }} {return -level 0 -code break}
} 0
test for-7.18 {Bug 3614226: ensure that continue from expanded command cleans up the stack} memory {
    apply {op {
	# Can't use [memtest]; must be careful when we change stack frames
	set end [meminfo]
	for {set i 0} {$i < 5} {incr i} {
	    for {set x 0} {$x < 5} {incr x} {
		list a b c [{*}$op] d e f
	    }
	    set tmp $end
	    set end [meminfo]
	}
	expr {$end - $tmp}
    }} {return -level 0 -code continue}
} 0
test for-7.19 {Bug 3614226: ensure that break from expanded command cleans up the expansion stack} memory {
    apply {op {
	# Can't use [memtest]; must be careful when we change stack frames
	set end [meminfo]
	for {set i 0} {$i < 5} {incr i} {
	    for {set x 0} {[incr x]<50} {} {
		puts {*}[puts a b c {*}[{*}$op] d e f]
	    }
	    set tmp $end
	    set end [meminfo]
	}
	expr {$end - $tmp}
    }} {return -level 0 -code break}
} 0
test for-7.20 {Bug 3614226: ensure that continue from expanded command cleans up the expansion stack} memory {
    apply {op {
	# Can't use [memtest]; must be careful when we change stack frames
	set end [meminfo]
	for {set i 0} {$i < 5} {incr i} {
	    for {set x 0} {[incr x]<50} {} {
		puts {*}[puts a b c {*}[{*}$op] d e f]
	    }
	    set tmp $end
	    set end [meminfo]
	}
	expr {$end - $tmp}
    }} {return -level 0 -code continue}
} 0
test for-7.21 {Bug 3614226: ensure that break from expanded command cleans up the combination of main and expansion stack} memory {
    apply {op {
	set l [lrepeat 50 p q r]
	# Can't use [memtest]; must be careful when we change stack frames
	set end [meminfo]
	for {set i 0} {$i < 5} {incr i} {
	    for {set x 0} {[incr x]<50} {} {
		puts [puts {*}$l {*}[puts a b c {*}$l {*}[{*}$op] d e f]]
	    }
	    set tmp $end
	    set end [meminfo]
	}
	expr {$end - $tmp}
    }} {return -level 0 -code break}
} 0
test for-7.22 {Bug 3614226: ensure that continue from expanded command cleans up the combination of main and expansion stack} memory {
    apply {op {
	set l [lrepeat 50 p q r]
	# Can't use [memtest]; must be careful when we change stack frames
	set end [meminfo]
	for {set i 0} {$i < 5} {incr i} {
	    for {set x 0} {[incr x]<50} {} {
		puts [puts {*}$l {*}[puts a b c {*}$l {*}[{*}$op] d e f]]
	    }
	    set tmp $end
	    set end [meminfo]
	}
	expr {$end - $tmp}
    }} {return -level 0 -code continue}
} 0
test for-7.23 {Bug 3614226: ensure that break from expanded command only cleans up the right amount} memory {
    apply {op {
	set l [lrepeat 50 p q r]
	# Can't use [memtest]; must be careful when we change stack frames
	set end [meminfo]
	for {set i 0} {$i < 5} {incr i} {
	    unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} {
		puts [puts {*}$l {*}[puts a b c {*}$l {*}[{*}$op] d e f]]
	    }]
	    set tmp $end
	    set end [meminfo]
	}
	expr {$end - $tmp}
    }} {return -level 0 -code break}
} 0
test for-7.24 {Bug 3614226: ensure that continue from expanded command only cleans up the right amount} memory {
    apply {op {
	set l [lrepeat 50 p q r]
	# Can't use [memtest]; must be careful when we change stack frames
	set end [meminfo]
	for {set i 0} {$i < 5} {incr i} {
	    unset -nocomplain {*}[for {set x 0} {[incr x]<50} {} {
		puts [puts {*}$l {*}[puts a b c {*}$l {*}[{*}$op] d e f]]
	    }]
	    set tmp $end
	    set end [meminfo]
	}
	expr {$end - $tmp}
    }} {return -level 0 -code continue}
} 0

# cleanup
::tcltest::cleanupTests
return

# Local Variables: