Tcl Source Code

Check-in [7d7672c1eb]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2018 Conference, Houston/TX, US, Oct 15-19
Send your abstracts to tclconference@googlegroups.com
or submit via the online form by Aug 20.

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 Side-by-Side Diffs Ignore Whitespace Patch

Changes to generic/tclBasic.c.

   507    507       iPtr->stubTable = &tclStubs;
   508    508       iPtr->objResultPtr = Tcl_NewObj();
   509    509       Tcl_IncrRefCount(iPtr->objResultPtr);
   510    510       iPtr->handle = TclHandleCreate(iPtr);
   511    511       iPtr->globalNsPtr = NULL;
   512    512       iPtr->hiddenCmdTablePtr = NULL;
   513    513       iPtr->interpInfo = NULL;
          514  +
          515  +    iPtr->optimizer = TclOptimizeBytecode;
   514    516   
   515    517       iPtr->numLevels = 0;
   516    518       iPtr->maxNestingDepth = MAX_NESTING_DEPTH;
   517    519       iPtr->framePtr = NULL;	/* Initialise as soon as :: is available */
   518    520       iPtr->varFramePtr = NULL;	/* Initialise as soon as :: is available */
   519    521   
   520    522       /*

Changes to generic/tclCmdIL.c.

  1143   1143   InfoFrameCmd(
  1144   1144       ClientData dummy,		/* Not used. */
  1145   1145       Tcl_Interp *interp,		/* Current interpreter. */
  1146   1146       int objc,			/* Number of arguments. */
  1147   1147       Tcl_Obj *const objv[])	/* Argument objects. */
  1148   1148   {
  1149   1149       Interp *iPtr = (Interp *) interp;
  1150         -    int level, topLevel, code = TCL_OK;
  1151         -    CmdFrame *runPtr, *framePtr;
         1150  +    int level, code = TCL_OK;
         1151  +    CmdFrame *framePtr, **cmdFramePtrPtr = &iPtr->cmdFramePtr;
  1152   1152       CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;
         1153  +    int topLevel = 0;
  1153   1154   
  1154   1155       if (objc > 2) {
  1155   1156   	Tcl_WrongNumArgs(interp, 1, objv, "?number?");
  1156   1157   	return TCL_ERROR;
  1157   1158       }
  1158   1159   
  1159         -    topLevel = ((iPtr->cmdFramePtr == NULL)
  1160         -	    ? 0
  1161         -	    : iPtr->cmdFramePtr->level);
  1162         -
  1163         -    if (corPtr) {
  1164         -	/*
  1165         -	 * A coroutine: must fix the level computations AND the cmdFrame chain,
  1166         -	 * which is interrupted at the base.
  1167         -	 */
  1168         -
  1169         -	CmdFrame *lastPtr = NULL;
  1170         -
  1171         -	runPtr = iPtr->cmdFramePtr;
  1172         -
  1173         -	/* TODO - deal with overflow */
  1174         -	topLevel += corPtr->caller.cmdFramePtr->level;
  1175         -	while (runPtr) {
  1176         -	    runPtr->level += corPtr->caller.cmdFramePtr->level;
  1177         -	    lastPtr = runPtr;
  1178         -	    runPtr = runPtr->nextPtr;
  1179         -	}
  1180         -	if (lastPtr) {
  1181         -	    lastPtr->nextPtr = corPtr->caller.cmdFramePtr;
  1182         -	} else {
  1183         -	    iPtr->cmdFramePtr = corPtr->caller.cmdFramePtr;
  1184         -	}
         1160  +    while (corPtr) {
         1161  +	while (*cmdFramePtrPtr) {
         1162  +	    topLevel++;
         1163  +	    cmdFramePtrPtr = &((*cmdFramePtrPtr)->nextPtr);
         1164  +	}
         1165  +	if (corPtr->caller.cmdFramePtr) {
         1166  +	    *cmdFramePtrPtr = corPtr->caller.cmdFramePtr;
         1167  +	}
         1168  +	corPtr = corPtr->callerEEPtr->corPtr;
         1169  +    }
         1170  +    topLevel += (*cmdFramePtrPtr)->level;
         1171  +
         1172  +    if (topLevel != iPtr->cmdFramePtr->level) {
         1173  +	framePtr = iPtr->cmdFramePtr;
         1174  +	while (framePtr) {
         1175  +	    framePtr->level = topLevel--;
         1176  +	    framePtr = framePtr->nextPtr;
         1177  +	}
         1178  +	if (topLevel) {
         1179  +	    Tcl_Panic("Broken frame level calculation");
         1180  +	}
         1181  +	topLevel = iPtr->cmdFramePtr->level;
  1185   1182       }
  1186   1183   
  1187   1184       if (objc == 1) {
  1188   1185   	/*
  1189   1186   	 * Just "info frame".
  1190   1187   	 */
  1191   1188   
................................................................................
  1227   1224   	    goto levelError;
  1228   1225   	}
  1229   1226       }
  1230   1227   
  1231   1228       Tcl_SetObjResult(interp, TclInfoFrame(interp, framePtr));
  1232   1229   
  1233   1230     done:
  1234         -    if (corPtr) {
         1231  +    cmdFramePtrPtr = &iPtr->cmdFramePtr;
         1232  +    corPtr = iPtr->execEnvPtr->corPtr;
         1233  +    while (corPtr) {
         1234  +	CmdFrame *endPtr = corPtr->caller.cmdFramePtr;
  1235   1235   
  1236         -	if (iPtr->cmdFramePtr == corPtr->caller.cmdFramePtr) {
  1237         -	    iPtr->cmdFramePtr = NULL;
  1238         -	} else {
  1239         -	    runPtr = iPtr->cmdFramePtr;
  1240         -	    while (runPtr->nextPtr != corPtr->caller.cmdFramePtr) {
  1241         -	    	runPtr->level -= corPtr->caller.cmdFramePtr->level;
  1242         -		runPtr = runPtr->nextPtr;
         1236  +	if (endPtr) {
         1237  +	    if (*cmdFramePtrPtr == endPtr) {
         1238  +		*cmdFramePtrPtr = NULL;
         1239  +	    } else {
         1240  +		CmdFrame *runPtr = *cmdFramePtrPtr;
         1241  +
         1242  +		while (runPtr->nextPtr != endPtr) {
         1243  +		    runPtr->level -= endPtr->level;
         1244  +		    runPtr = runPtr->nextPtr;
         1245  +		}
         1246  +		runPtr->level = 1;
         1247  +		runPtr->nextPtr = NULL;
  1243   1248   	    }
  1244         -	    runPtr->level = 1;
  1245         -	    runPtr->nextPtr = NULL;
         1249  +	    cmdFramePtrPtr = &corPtr->caller.cmdFramePtr;
  1246   1250   	}
  1247         -
         1251  +	corPtr = corPtr->callerEEPtr->corPtr;
  1248   1252       }
  1249   1253       return code;
  1250   1254   }
  1251   1255   
  1252   1256   /*
  1253   1257    *----------------------------------------------------------------------
  1254   1258    *

Changes to generic/tclCompile.c.

   761    761       }
   762    762   
   763    763       /*
   764    764        * Apply some peephole optimizations that can cross specific/generic
   765    765        * instruction generator boundaries.
   766    766        */
   767    767   
   768         -    TclOptimizeBytecode(&compEnv);
          768  +    if (iPtr->optimizer) {
          769  +	(iPtr->optimizer)(&compEnv);
          770  +    }
   769    771   
   770    772       /*
   771    773        * Invoke the compilation hook procedure if one exists.
   772    774        */
   773    775   
   774    776       if (hookProc) {
   775    777   	result = hookProc(interp, &compEnv, clientData);

Changes to generic/tclCompile.h.

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

Changes to generic/tclInt.h.

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

Changes to generic/tclOptimize.c.

   423    423    *	A very simple peephole optimizer for bytecode.
   424    424    *
   425    425    * ----------------------------------------------------------------------
   426    426    */
   427    427   
   428    428   void
   429    429   TclOptimizeBytecode(
   430         -    CompileEnv *envPtr)
          430  +    void *envPtr)
   431    431   {
   432    432       ConvertZeroEffectToNOP(envPtr);
   433    433       AdvanceJumps(envPtr);
   434    434       TrimUnreachable(envPtr);
   435    435   }
   436    436   
   437    437   /*

Changes to tests/coroutine.test.

   338    338       proc a {} stack
   339    339   } -body {
   340    340       coroutine aa a
   341    341   } -cleanup {
   342    342       rename stack {}
   343    343       rename a {}
   344    344   } -result {}
          345  +test coroutine-3.7 {bug 0b874c344d} {
          346  +    dict get [coroutine X coroutine Y info frame 0] cmd
          347  +} {coroutine X coroutine Y info frame 0}
   345    348   
   346    349   test coroutine-4.1 {bug #2093188} -setup {
   347    350       proc foo {} {
   348    351   	set v 1
   349    352   	trace add variable v {write unset} bar
   350    353   	yield
   351    354   	set v 2