From a41520cafc3a8bda98fb4c37256ad2b7c56f0b6a Mon Sep 17 00:00:00 2001 From: dkf Date: Fri, 5 Oct 2012 13:05:55 +0000 Subject: compilation code adjusted --- generic/tclCmdAH.c | 73 ++++++++++++++++---------- generic/tclCompCmds.c | 142 ++++++++++++++++++++++++++------------------------ generic/tclInt.h | 18 +++---- 3 files changed, 126 insertions(+), 107 deletions(-) diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index d7872ef..14951e4 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -32,7 +32,9 @@ struct ForeachState { int *argcList; /* Array of value list sizes. */ Tcl_Obj ***argvList; /* Array of value lists. */ Tcl_Obj **aCopyList; /* Copies of value list arguments. */ - Tcl_Obj *resultList; /* List of result values from the loop body. */ + Tcl_Obj *resultList; /* List of result values from the loop body, + * or NULL if we're not collecting them + * ([lmap] vs [foreach]). */ }; /* @@ -53,8 +55,8 @@ static int GetStatBuf(Tcl_Interp *interp, Tcl_Obj *pathPtr, static const char * GetTypeFromMode(int mode); static int StoreStatData(Tcl_Interp *interp, Tcl_Obj *varName, Tcl_StatBuf *statPtr); -static int TclNREachloopCmd(ClientData dummy, Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[], int collect); +static inline int EachloopCmd(Tcl_Interp *interp, int collect, + int objc, Tcl_Obj *const objv[]); static Tcl_NRPostProc CatchObjCmdCallback; static Tcl_NRPostProc ExprCallback; static Tcl_NRPostProc ForSetupCallback; @@ -2568,7 +2570,7 @@ ForPostNextCallback( /* *---------------------------------------------------------------------- * - * Tcl_ForeachObjCmd, TclNRForeachCmd, TclNREachloopCmd -- + * Tcl_ForeachObjCmd, TclNRForeachCmd, EachloopCmd -- * * This object-based procedure is invoked to process the "foreach" Tcl * command. See the user documentation for details on what it does. @@ -2600,7 +2602,7 @@ TclNRForeachCmd( int objc, Tcl_Obj *const objv[]) { - return TclNREachloopCmd(dummy, interp, objc, objv, TCL_EACH_KEEP_NONE); + return EachloopCmd(interp, TCL_EACH_KEEP_NONE, objc, objv); } int @@ -2620,18 +2622,18 @@ TclNRLmapCmd( int objc, Tcl_Obj *const objv[]) { - return TclNREachloopCmd(dummy, interp, objc, objv, TCL_EACH_COLLECT); + return EachloopCmd(interp, TCL_EACH_COLLECT, objc, objv); } -int -TclNREachloopCmd( - ClientData dummy, - Tcl_Interp *interp, - int objc, - Tcl_Obj *const objv[], - int collect) /* Select collecting or accumulating mode (TCL_EACH_*) */ +static inline int +EachloopCmd( + Tcl_Interp *interp, /* Our context for variables and script + * evaluation. */ + int collect, /* Select collecting or accumulating mode + * (TCL_EACH_*) */ + int objc, /* The arguments being passed in... */ + Tcl_Obj *const objv[]) { - int numLists = (objc-2) / 2; register struct ForeachState *statePtr; int i, j, result; @@ -2675,7 +2677,11 @@ TclNREachloopCmd( statePtr->bodyPtr = objv[objc - 1]; statePtr->bodyIdx = objc - 1; - statePtr->resultList = Tcl_NewListObj(0, NULL); + if (collect == TCL_EACH_COLLECT) { + statePtr->resultList = Tcl_NewListObj(0, NULL); + } else { + statePtr->resultList = NULL; + } /* * Break up the value lists and variable lists into elements. @@ -2690,9 +2696,11 @@ TclNREachloopCmd( TclListObjGetElements(NULL, statePtr->vCopyList[i], &statePtr->varcList[i], &statePtr->varvList[i]); if (statePtr->varcList[i] < 1) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "foreach varlist is empty", -1)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "FOREACH", + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "%s varlist is empty", + (statePtr->resultList != NULL ? "lmap" : "foreach"))); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", + (statePtr->resultList != NULL ? "LMAP" : "FOREACH"), "NEEDVARS", NULL); result = TCL_ERROR; goto done; @@ -2726,7 +2734,7 @@ TclNREachloopCmd( goto done; } - TclNRAddCallback(interp, ForeachLoopStep, statePtr, collect, NULL, NULL); + TclNRAddCallback(interp, ForeachLoopStep, statePtr, NULL, NULL, NULL); return TclNREvalObjEx(interp, objv[objc-1], 0, ((Interp *) interp)->cmdFramePtr, objc-1); } @@ -2753,7 +2761,6 @@ ForeachLoopStep( int result) { register struct ForeachState *statePtr = data[0]; - int collect = (int)data[1]; /* Selected collecting or accumulating mode. */ /* * Process the result code from this run of the [foreach] body. Note that @@ -2765,8 +2772,9 @@ ForeachLoopStep( result = TCL_OK; break; case TCL_OK: - if (collect == TCL_EACH_COLLECT) { - Tcl_ListObjAppendElement(interp, statePtr->resultList, Tcl_GetObjResult(interp)); + if (statePtr->resultList != NULL) { + Tcl_ListObjAppendElement(interp, statePtr->resultList, + Tcl_GetObjResult(interp)); } break; case TCL_BREAK: @@ -2774,7 +2782,9 @@ ForeachLoopStep( goto finish; case TCL_ERROR: Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( - "\n (\"foreach\" body line %d)", Tcl_GetErrorLine(interp))); + "\n (\"%s\" body line %d)", + (statePtr->resultList != NULL ? "lmap" : "foreach"), + Tcl_GetErrorLine(interp))); default: goto done; } @@ -2790,7 +2800,7 @@ ForeachLoopStep( goto done; } - TclNRAddCallback(interp, ForeachLoopStep, statePtr, collect, NULL, NULL); + TclNRAddCallback(interp, ForeachLoopStep, statePtr, NULL, NULL, NULL); return TclNREvalObjEx(interp, statePtr->bodyPtr, 0, ((Interp *) interp)->cmdFramePtr, statePtr->bodyIdx); } @@ -2798,9 +2808,15 @@ ForeachLoopStep( /* * We're done. Tidy up our work space and finish off. */ + finish: - Tcl_SetObjResult(interp, statePtr->resultList); - statePtr->resultList = NULL; /* Don't clean it up */ + if (statePtr->resultList == NULL) { + Tcl_ResetResult(interp); + } else { + Tcl_SetObjResult(interp, statePtr->resultList); + statePtr->resultList = NULL; /* Don't clean it up */ + } + done: ForeachCleanup(interp, statePtr); return result; @@ -2833,7 +2849,8 @@ ForeachAssignments( if (varValuePtr == NULL) { Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf( - "\n (setting foreach loop variable \"%s\")", + "\n (setting %s loop variable \"%s\")", + (statePtr->resultList != NULL ? "lmap" : "foreach"), TclGetString(statePtr->varvList[i][v]))); return TCL_ERROR; } @@ -2862,7 +2879,7 @@ ForeachCleanup( TclDecrRefCount(statePtr->aCopyList[i]); } } - if (statePtr->resultList) { + if (statePtr->resultList != NULL) { TclDecrRefCount(statePtr->resultList); } TclStackFree(interp, statePtr); diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 4d015ec..13f479d 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -40,10 +40,10 @@ static int PushVarName(Tcl_Interp *interp, int flags, int *localIndexPtr, int *simpleVarNamePtr, int *isScalarPtr, int line, int *clNext); -static int TclCompileEachloopCmd(Tcl_Interp *interp, - Tcl_Parse *parsePtr, Command *cmdPtr, CompileEnv *envPtr, - int collect); -static int TclCompileDictEachCmd(Tcl_Interp *interp, +static int CompileEachloopCmd(Tcl_Interp *interp, + Tcl_Parse *parsePtr, Command *cmdPtr, + CompileEnv *envPtr, int collect); +static int CompileDictEachCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, Command *cmdPtr, struct CompileEnv *envPtr, int collect); @@ -795,37 +795,42 @@ TclCompileDictForCmd( * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { - return TclCompileDictEachCmd(interp, parsePtr, cmdPtr, envPtr, 0); + return CompileDictEachCmd(interp, parsePtr, cmdPtr, envPtr, + TCL_EACH_KEEP_NONE); } int TclCompileDictMapCmd( - Tcl_Interp *interp, /* Used for looking up stuff. */ - Tcl_Parse *parsePtr, /* Points to a parse structure for the command - * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ - CompileEnv *envPtr) /* Holds resulting instructions. */ + Tcl_Interp *interp, /* Used for looking up stuff. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr) /* Holds resulting instructions. */ { - return TclCompileDictEachCmd(interp, parsePtr, cmdPtr, envPtr, 1); + return CompileDictEachCmd(interp, parsePtr, cmdPtr, envPtr, + TCL_EACH_COLLECT); } int -TclCompileDictEachCmd( - Tcl_Interp *interp, /* Used for looking up stuff. */ - Tcl_Parse *parsePtr, /* Points to a parse structure for the command - * created by Tcl_ParseCommand. */ - Command *cmdPtr, /* Points to defintion of command being - * compiled. */ - CompileEnv *envPtr, /* Holds resulting instructions. */ - int collect) /* Flag == 1 to collect and return loop body result. */ +CompileDictEachCmd( + Tcl_Interp *interp, /* Used for looking up stuff. */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the command + * created by Tcl_ParseCommand. */ + Command *cmdPtr, /* Points to defintion of command being + * compiled. */ + CompileEnv *envPtr, /* Holds resulting instructions. */ + int collect) /* Flag == TCL_EACH_COLLECT to collect and + * construct a new dictionary with the loop + * body result. */ { DefineLineInformation; /* TIP #280 */ Tcl_Token *varsTokenPtr, *dictTokenPtr, *bodyTokenPtr; int keyVarIndex, valueVarIndex, nameChars, loopRange, catchRange; int infoIndex, jumpDisplacement, bodyTargetOffset, emptyTargetOffset; int numVars, endTargetOffset; - int collectTemp; /* Index of temp var holding the result list. */ + int collectVar = -1; /* Index of temp var holding the result + * dict. */ int savedStackDepth = envPtr->currStackDepth; /* Needed because jumps confuse the stack * space calculator. */ @@ -901,16 +906,12 @@ TclCompileDictEachCmd( * Create temporary variable to capture return values from loop body. */ - if (collect == 1) { - collectTemp = TclFindCompiledLocal(NULL, /*nameChars*/ 0, /*create*/ 1, envPtr); - - PushLiteral(envPtr, "", 0); - if (collectTemp <= 255) { - TclEmitInstInt1(INST_STORE_SCALAR1, collectTemp, envPtr); - } else { - TclEmitInstInt4(INST_STORE_SCALAR4, collectTemp, envPtr); + if (collect == TCL_EACH_COLLECT) { + collectVar = TclFindCompiledLocal(NULL, /*nameChars*/ 0, /*create*/ 1, + envPtr); + if (collectVar < 0) { + return TCL_ERROR; } - TclEmitOpcode(INST_POP, envPtr); } /* @@ -927,6 +928,16 @@ TclCompileDictEachCmd( TclEmitInstInt4( INST_JUMP_TRUE4, 0, envPtr); /* + * Initialize the accumulator dictionary, if needed. + */ + + if (collect == TCL_EACH_COLLECT) { + PushLiteral(envPtr, "", 0); + Emit14Inst( INST_STORE_SCALAR, collectVar, envPtr); + TclEmitOpcode( INST_POP, envPtr); + } + + /* * Now we catch errors from here on so that we can finalize the search * started by Tcl_DictObjFirst above. */ @@ -958,12 +969,12 @@ TclCompileDictEachCmd( SetLineInformation(3); CompileBody(envPtr, bodyTokenPtr, interp); - if (collect == 1) { - if (collectTemp <= 255) { - TclEmitInstInt1(INST_LAPPEND_SCALAR1, collectTemp, envPtr); - } else { - TclEmitInstInt4(INST_LAPPEND_SCALAR4, collectTemp, envPtr); - } + if (collect == TCL_EACH_COLLECT) { + Emit14Inst( INST_LOAD_SCALAR, keyVarIndex, envPtr); + TclEmitInstInt4(INST_OVER, 1, envPtr); + TclEmitInstInt4(INST_DICT_SET, 1, envPtr); + TclEmitInt4( collectVar, envPtr); + TclEmitOpcode( INST_POP, envPtr); } TclEmitOpcode( INST_POP, envPtr); @@ -1039,12 +1050,8 @@ TclCompileDictEachCmd( jumpDisplacement = CurrentOffset(envPtr) - endTargetOffset; TclUpdateInstInt4AtPc(INST_JUMP4, jumpDisplacement, envPtr->codeStart + endTargetOffset); - if (collect == 1) { - if (collectTemp <= 255) { - TclEmitInstInt1(INST_LOAD_SCALAR1, collectTemp, envPtr); - } else { - TclEmitInstInt4(INST_LOAD_SCALAR4, collectTemp, envPtr); - } + if (collect == TCL_EACH_COLLECT) { + Emit14Inst( INST_LOAD_SCALAR, collectVar, envPtr); } else { PushLiteral(envPtr, "", 0); } @@ -1935,13 +1942,14 @@ TclCompileForeachCmd( * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { - return TclCompileEachloopCmd(interp, parsePtr, cmdPtr, envPtr, 0); + return CompileEachloopCmd(interp, parsePtr, cmdPtr, envPtr, + TCL_EACH_KEEP_NONE); } /* *---------------------------------------------------------------------- * - * TclCompileEachloopCmd -- + * CompileEachloopCmd -- * * Procedure called to compile the "foreach" and "lmap" commands. * @@ -1957,14 +1965,15 @@ TclCompileForeachCmd( */ static int -TclCompileEachloopCmd( +CompileEachloopCmd( Tcl_Interp *interp, /* Used for error reporting. */ Tcl_Parse *parsePtr, /* Points to a parse structure for the command * created by Tcl_ParseCommand. */ Command *cmdPtr, /* Points to defintion of command being * compiled. */ CompileEnv *envPtr, /* Holds resulting instructions. */ - int collect) /* Select collecting or accumulating mode (TCL_EACH_*) */ + int collect) /* Select collecting or accumulating mode + * (TCL_EACH_*) */ { Proc *procPtr = envPtr->procPtr; ForeachInfo *infoPtr; /* Points to the structure describing this @@ -1974,7 +1983,8 @@ TclCompileEachloopCmd( * used to point to a value list. */ int loopCtTemp; /* Index of temp var holding the loop's * iteration count. */ - int collectTemp = -1; /* Index of temp var holding the result var index. */ + int collectVar = -1; /* Index of temp var holding the result var + * index. */ Tcl_Token *tokenPtr, *bodyTokenPtr; unsigned char *jumpPc; @@ -2091,6 +2101,14 @@ TclCompileEachloopCmd( loopIndex++; } + if (collect == TCL_EACH_COLLECT) { + collectVar = TclFindCompiledLocal(NULL, /*nameChars*/ 0, /*create*/ 1, + envPtr); + if (collectVar < 0) { + return TCL_ERROR; + } + } + /* * We will compile the foreach command. Reserve (numLists + 1) temporary * variables: @@ -2171,15 +2189,9 @@ TclCompileEachloopCmd( */ if (collect == TCL_EACH_COLLECT) { - collectTemp = TclFindCompiledLocal(NULL, /*nameChars*/ 0, /*create*/ 1, envPtr); - PushLiteral(envPtr, "", 0); - if (collectTemp <= 255) { - TclEmitInstInt1( INST_STORE_SCALAR1, collectTemp, envPtr); - } else { - TclEmitInstInt4( INST_STORE_SCALAR4, collectTemp, envPtr); - } - TclEmitOpcode( INST_POP, envPtr); + Emit14Inst( INST_STORE_SCALAR, collectVar, envPtr); + TclEmitOpcode( INST_POP, envPtr); } /* @@ -2208,14 +2220,9 @@ TclCompileEachloopCmd( envPtr->currStackDepth = savedStackDepth + 1; if (collect == TCL_EACH_COLLECT) { - if (collectTemp <= 255) { - TclEmitInstInt1( INST_LAPPEND_SCALAR1, collectTemp, envPtr); - } else { - TclEmitInstInt4( INST_LAPPEND_SCALAR4, collectTemp, envPtr); - } + Emit14Inst( INST_LAPPEND_SCALAR, collectVar,envPtr); } - TclEmitOpcode( INST_POP, envPtr); - + TclEmitOpcode( INST_POP, envPtr); /* * Jump back to the test at the top of the loop. Generate a 4 byte jump if @@ -2270,12 +2277,8 @@ TclCompileEachloopCmd( */ envPtr->currStackDepth = savedStackDepth; - if (collectTemp >= 0) { - if (collectTemp <= 255) { - TclEmitInstInt1( INST_LOAD_SCALAR1, collectTemp, envPtr); - } else { - TclEmitInstInt4( INST_LOAD_SCALAR4, collectTemp, envPtr); - } + if (collect == TCL_EACH_COLLECT) { + Emit14Inst( INST_LOAD_SCALAR, collectVar, envPtr); } else { PushLiteral(envPtr, "", 0); } @@ -3856,7 +3859,8 @@ TclCompileLmapCmd( * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { - return TclCompileEachloopCmd(interp, parsePtr, cmdPtr, envPtr, 1); + return CompileEachloopCmd(interp, parsePtr, cmdPtr, envPtr, + TCL_EACH_COLLECT); } /* diff --git a/generic/tclInt.h b/generic/tclInt.h index df1fa37..c716ed2 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2487,6 +2487,14 @@ typedef struct List { (((listPtr)->typePtr == &tclListType) ? ListObjIsCanonical((listPtr)) : 0) /* + * Modes for collecting (or not) in the implementations of TclNRForeachCmd, + * TclNRLmapCmd and their compilations. + */ + +#define TCL_EACH_KEEP_NONE 0 /* Discard iteration result like [foreach] */ +#define TCL_EACH_COLLECT 1 /* Collect iteration result like [lmap] */ + +/* * Macros providing a faster path to integers: Tcl_GetLongFromObj everywhere, * Tcl_GetIntFromObj and TclGetIntForIndex on platforms where longs are ints. * @@ -2859,16 +2867,6 @@ struct Tcl_LoadHandle_ { #define TCL_DD_SHORTEST0 0x0 /* 'Shortest possible' after masking */ -/* Modes for collecting or accumulating in TclNREachloopCmd, - * TclCompileEachloopCmd and INST_FOREACH_STEP4. */ - -#define TCL_EACH_KEEP_NONE 0 - /* Discard iteration result like [foreach] */ - -#define TCL_EACH_COLLECT 1 - /* Collect iteration result like [lmap] */ - - /* *---------------------------------------------------------------- * Procedures shared among Tcl modules but not used by the outside world: -- cgit v0.12