Tcl Source Code

Check-in [7d7672c1eb]
Login

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

Overview
Comment:merge trunk
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | novem
Files: files | file ages | folders
SHA1: 7d7672c1ebef77d6222eeab0cb1bc7ed12570c5c
User & Date: jan.nijtmans 2013-12-19 12:21:25
Context
2013-12-20
08:18
merge trunk check-in: 9b7c42180e user: jan.nijtmans tags: novem
2013-12-19
12:21
merge trunk check-in: 7d7672c1eb user: jan.nijtmans tags: novem
2013-12-18
18:23
[0b874c344d] Fix for nested coroutines ability to stitch together multiple parts of the CmdFrame cha... check-in: 955265f9a0 user: dgp tags: trunk
2013-12-15
21:28
merge trunk check-in: 9940ea9d74 user: jan.nijtmans tags: novem
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tclBasic.c.

507
508
509
510
511
512
513


514
515
516
517
518
519
520
    iPtr->stubTable = &tclStubs;
    iPtr->objResultPtr = Tcl_NewObj();
    Tcl_IncrRefCount(iPtr->objResultPtr);
    iPtr->handle = TclHandleCreate(iPtr);
    iPtr->globalNsPtr = NULL;
    iPtr->hiddenCmdTablePtr = NULL;
    iPtr->interpInfo = NULL;



    iPtr->numLevels = 0;
    iPtr->maxNestingDepth = MAX_NESTING_DEPTH;
    iPtr->framePtr = NULL;	/* Initialise as soon as :: is available */
    iPtr->varFramePtr = NULL;	/* Initialise as soon as :: is available */

    /*







>
>







507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
    iPtr->stubTable = &tclStubs;
    iPtr->objResultPtr = Tcl_NewObj();
    Tcl_IncrRefCount(iPtr->objResultPtr);
    iPtr->handle = TclHandleCreate(iPtr);
    iPtr->globalNsPtr = NULL;
    iPtr->hiddenCmdTablePtr = NULL;
    iPtr->interpInfo = NULL;

    iPtr->optimizer = TclOptimizeBytecode;

    iPtr->numLevels = 0;
    iPtr->maxNestingDepth = MAX_NESTING_DEPTH;
    iPtr->framePtr = NULL;	/* Initialise as soon as :: is available */
    iPtr->varFramePtr = NULL;	/* Initialise as soon as :: is available */

    /*

Changes to generic/tclCmdIL.c.

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
InfoFrameCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Interp *iPtr = (Interp *) interp;
    int level, topLevel, code = TCL_OK;
    CmdFrame *runPtr, *framePtr;
    CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;


    if (objc > 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?number?");
	return TCL_ERROR;
    }



    topLevel = ((iPtr->cmdFramePtr == NULL)
	    ? 0
	    : iPtr->cmdFramePtr->level);

    if (corPtr) {
	/*
	 * A coroutine: must fix the level computations AND the cmdFrame chain,
	 * which is interrupted at the base.
	 */

	CmdFrame *lastPtr = NULL;

	runPtr = iPtr->cmdFramePtr;

	/* TODO - deal with overflow */
	topLevel += corPtr->caller.cmdFramePtr->level;

	while (runPtr) {
	    runPtr->level += corPtr->caller.cmdFramePtr->level;
	    lastPtr = runPtr;
	    runPtr = runPtr->nextPtr;
	}
	if (lastPtr) {
	    lastPtr->nextPtr = corPtr->caller.cmdFramePtr;
	} else {
	    iPtr->cmdFramePtr = corPtr->caller.cmdFramePtr;

	}

    }

    if (objc == 1) {
	/*
	 * Just "info frame".
	 */








|
|

>






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

<
|
>
|
|
<
|

|
<
<
<
>

>







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
InfoFrameCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Interp *iPtr = (Interp *) interp;
    int level, code = TCL_OK;
    CmdFrame *framePtr, **cmdFramePtrPtr = &iPtr->cmdFramePtr;
    CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
    int topLevel = 0;

    if (objc > 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?number?");
	return TCL_ERROR;
    }

    while (corPtr) {
	while (*cmdFramePtrPtr) {
	    topLevel++;

	    cmdFramePtrPtr = &((*cmdFramePtrPtr)->nextPtr);
	}
	if (corPtr->caller.cmdFramePtr) {

	    *cmdFramePtrPtr = corPtr->caller.cmdFramePtr;


	}
	corPtr = corPtr->callerEEPtr->corPtr;
    }
    topLevel += (*cmdFramePtrPtr)->level;


    if (topLevel != iPtr->cmdFramePtr->level) {
	framePtr = iPtr->cmdFramePtr;
	while (framePtr) {
	    framePtr->level = topLevel--;

	    framePtr = framePtr->nextPtr;
	}
	if (topLevel) {



	    Tcl_Panic("Broken frame level calculation");
	}
	topLevel = iPtr->cmdFramePtr->level;
    }

    if (objc == 1) {
	/*
	 * Just "info frame".
	 */

1227
1228
1229
1230
1231
1232
1233


1234

1235

1236
1237
1238
1239

1240
1241
1242
1243
1244
1245
1246

1247

1248
1249
1250
1251
1252
1253
1254
	    goto levelError;
	}
    }

    Tcl_SetObjResult(interp, TclInfoFrame(interp, framePtr));

  done:


    if (corPtr) {



	if (iPtr->cmdFramePtr == corPtr->caller.cmdFramePtr) {
	    iPtr->cmdFramePtr = NULL;
	} else {
	    runPtr = iPtr->cmdFramePtr;

	    while (runPtr->nextPtr != corPtr->caller.cmdFramePtr) {
	    	runPtr->level -= corPtr->caller.cmdFramePtr->level;
		runPtr = runPtr->nextPtr;
	    }
	    runPtr->level = 1;
	    runPtr->nextPtr = NULL;
	}



    }
    return code;
}

/*
 *----------------------------------------------------------------------
 *







>
>
|
>

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







1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
	    goto levelError;
	}
    }

    Tcl_SetObjResult(interp, TclInfoFrame(interp, framePtr));

  done:
    cmdFramePtrPtr = &iPtr->cmdFramePtr;
    corPtr = iPtr->execEnvPtr->corPtr;
    while (corPtr) {
	CmdFrame *endPtr = corPtr->caller.cmdFramePtr;

	if (endPtr) {
	    if (*cmdFramePtrPtr == endPtr) {
		*cmdFramePtrPtr = NULL;
	    } else {
		CmdFrame *runPtr = *cmdFramePtrPtr;

		while (runPtr->nextPtr != endPtr) {
		    runPtr->level -= endPtr->level;
		    runPtr = runPtr->nextPtr;
		}
		runPtr->level = 1;
		runPtr->nextPtr = NULL;
	    }
	    cmdFramePtrPtr = &corPtr->caller.cmdFramePtr;
	}
	corPtr = corPtr->callerEEPtr->corPtr;
    }
    return code;
}

/*
 *----------------------------------------------------------------------
 *

Changes to generic/tclCompile.c.

761
762
763
764
765
766
767

768

769
770
771
772
773
774
775
    }

    /*
     * Apply some peephole optimizations that can cross specific/generic
     * instruction generator boundaries.
     */


    TclOptimizeBytecode(&compEnv);


    /*
     * Invoke the compilation hook procedure if one exists.
     */

    if (hookProc) {
	result = hookProc(interp, &compEnv, clientData);







>
|
>







761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
    }

    /*
     * Apply some peephole optimizations that can cross specific/generic
     * instruction generator boundaries.
     */

    if (iPtr->optimizer) {
	(iPtr->optimizer)(&compEnv);
    }

    /*
     * Invoke the compilation hook procedure if one exists.
     */

    if (hookProc) {
	result = hookProc(interp, &compEnv, clientData);

Changes to generic/tclCompile.h.

1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
			    ExceptionAux *auxPtr);
MODULE_SCOPE void	TclFinalizeLoopExceptionRange(CompileEnv *envPtr,
			    int range);
#ifdef TCL_COMPILE_STATS
MODULE_SCOPE char *	TclLiteralStats(LiteralTable *tablePtr);
MODULE_SCOPE int	TclLog2(int value);
#endif
MODULE_SCOPE void	TclOptimizeBytecode(CompileEnv *envPtr);
#ifdef TCL_COMPILE_DEBUG
MODULE_SCOPE void	TclPrintByteCodeObj(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);
#endif
MODULE_SCOPE int	TclPrintInstruction(ByteCode *codePtr,
			    const unsigned char *pc);
MODULE_SCOPE void	TclPrintObject(FILE *outFile,







|







1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
			    ExceptionAux *auxPtr);
MODULE_SCOPE void	TclFinalizeLoopExceptionRange(CompileEnv *envPtr,
			    int range);
#ifdef TCL_COMPILE_STATS
MODULE_SCOPE char *	TclLiteralStats(LiteralTable *tablePtr);
MODULE_SCOPE int	TclLog2(int value);
#endif
MODULE_SCOPE void	TclOptimizeBytecode(void *envPtr);
#ifdef TCL_COMPILE_DEBUG
MODULE_SCOPE void	TclPrintByteCodeObj(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);
#endif
MODULE_SCOPE int	TclPrintInstruction(ByteCode *codePtr,
			    const unsigned char *pc);
MODULE_SCOPE void	TclPrintObject(FILE *outFile,

Changes to generic/tclInt.h.

1796
1797
1798
1799
1800
1801
1802

1803
1804
1805
1806
1807
1808
1809
    Tcl_HashTable *hiddenCmdTablePtr;
				/* Hash table used by tclBasic.c to keep track
				 * of hidden commands on a per-interp
				 * basis. */
    ClientData interpInfo;	/* Information used by tclInterp.c to keep
				 * track of master/slave interps on a
				 * per-interp basis. */

    /*
     * Information related to procedures and variables. See tclProc.c and
     * tclVar.c for usage.
     */

    int numLevels;		/* Keeps track of how many nested calls to
				 * Tcl_Eval are in progress for this







>







1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
    Tcl_HashTable *hiddenCmdTablePtr;
				/* Hash table used by tclBasic.c to keep track
				 * of hidden commands on a per-interp
				 * basis. */
    ClientData interpInfo;	/* Information used by tclInterp.c to keep
				 * track of master/slave interps on a
				 * per-interp basis. */
    void (*optimizer)(void *envPtr);
    /*
     * Information related to procedures and variables. See tclProc.c and
     * tclVar.c for usage.
     */

    int numLevels;		/* Keeps track of how many nested calls to
				 * Tcl_Eval are in progress for this

Changes to generic/tclOptimize.c.

423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
 *	A very simple peephole optimizer for bytecode.
 *
 * ----------------------------------------------------------------------
 */

void
TclOptimizeBytecode(
    CompileEnv *envPtr)
{
    ConvertZeroEffectToNOP(envPtr);
    AdvanceJumps(envPtr);
    TrimUnreachable(envPtr);
}

/*







|







423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
 *	A very simple peephole optimizer for bytecode.
 *
 * ----------------------------------------------------------------------
 */

void
TclOptimizeBytecode(
    void *envPtr)
{
    ConvertZeroEffectToNOP(envPtr);
    AdvanceJumps(envPtr);
    TrimUnreachable(envPtr);
}

/*

Changes to tests/coroutine.test.

338
339
340
341
342
343
344



345
346
347
348
349
350
351
    proc a {} stack
} -body {
    coroutine aa a
} -cleanup {
    rename stack {}
    rename a {}
} -result {}




test coroutine-4.1 {bug #2093188} -setup {
    proc foo {} {
	set v 1
	trace add variable v {write unset} bar
	yield
	set v 2







>
>
>







338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
    proc a {} stack
} -body {
    coroutine aa a
} -cleanup {
    rename stack {}
    rename a {}
} -result {}
test coroutine-3.7 {bug 0b874c344d} {
    dict get [coroutine X coroutine Y info frame 0] cmd
} {coroutine X coroutine Y info frame 0}

test coroutine-4.1 {bug #2093188} -setup {
    proc foo {} {
	set v 1
	trace add variable v {write unset} bar
	yield
	set v 2