diff options
Diffstat (limited to 'generic/tclCompile.c')
| -rw-r--r-- | generic/tclCompile.c | 760 |
1 files changed, 410 insertions, 350 deletions
diff --git a/generic/tclCompile.c b/generic/tclCompile.c index bffe7f8..c10145c 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -5,8 +5,8 @@ * commands (like quoted strings or nested sub-commands) into a sequence * of instructions ("bytecodes"). * - * Copyright (c) 1996-1998 Sun Microsystems, Inc. - * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved. + * Copyright © 1996-1998 Sun Microsystems, Inc. + * Copyright © 2001 Kevin B. Kenny. All rights reserved. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -659,6 +659,30 @@ InstructionDesc const tclInstructionTable[] = { * 0=clicks, 1=microseconds, 2=milliseconds, 3=seconds. * Stack: ... => ... time */ + {"dictGetDef", 5, INT_MIN, 1, {OPERAND_UINT4}}, + /* The top word is the default, the next op4 words (min 1) are a key + * path into the dictionary just below the keys on the stack, and all + * those values are replaced by the value read out of that key-path + * (like [dict get]) except if there is no such key, when instead the + * default is pushed instead. + * Stack: ... dict key1 ... keyN default => ... value */ + + {"strlt", 1, -1, 0, {OPERAND_NONE}}, + /* String Less: push (stknext < stktop) */ + {"strgt", 1, -1, 0, {OPERAND_NONE}}, + /* String Greater: push (stknext > stktop) */ + {"strle", 1, -1, 0, {OPERAND_NONE}}, + /* String Less or equal: push (stknext <= stktop) */ + {"strge", 1, -1, 0, {OPERAND_NONE}}, + /* String Greater or equal: push (stknext >= stktop) */ + {"lreplace4", 6, INT_MIN, 2, {OPERAND_UINT4, OPERAND_UINT1}}, + /* Operands: number of arguments, flags + * flags: Combination of TCL_LREPLACE4_* flags + * Stack: ... listobj index1 ?index2? new1 ... newN => ... newlistobj + * where index2 is present only if TCL_LREPLACE_SINGLE_INDEX is not + * set in flags. + */ + {NULL, 0, 0, 0, {OPERAND_NONE}} }; @@ -666,6 +690,7 @@ InstructionDesc const tclInstructionTable[] = { * Prototypes for procedures defined later in this file: */ +static void CleanupByteCode(ByteCode *codePtr); static ByteCode * CompileSubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); static void DupByteCodeInternalRep(Tcl_Obj *srcPtr, @@ -679,8 +704,8 @@ static void EnterCmdStartData(CompileEnv *envPtr, static void FreeByteCodeInternalRep(Tcl_Obj *objPtr); static void FreeSubstCodeInternalRep(Tcl_Obj *objPtr); static int GetCmdLocEncodingSize(CompileEnv *envPtr); -static int IsCompactibleCompileEnv(Tcl_Interp *interp, - CompileEnv *envPtr); +static int IsCompactibleCompileEnv(CompileEnv *envPtr); +static void PreventCycle(Tcl_Obj *objPtr, CompileEnv *envPtr); #ifdef TCL_COMPILE_STATS static void RecordByteCodeStats(ByteCode *codePtr); #endif /* TCL_COMPILE_STATS */ @@ -693,14 +718,14 @@ static void StartExpanding(CompileEnv *envPtr); * commands. */ static void EnterCmdWordData(ExtCmdLoc *eclPtr, int srcOffset, - Tcl_Token *tokenPtr, const char *cmd, int len, + Tcl_Token *tokenPtr, const char *cmd, int numWords, int line, int *clNext, int **lines, CompileEnv *envPtr); static void ReleaseCmdWordData(ExtCmdLoc *eclPtr); /* - * The structure below defines the bytecode Tcl object type by means of - * procedures that can be invoked by generic object code. + * tclByteCodeType provides the standard type management procedures for the + * bytecode type. */ const Tcl_ObjType tclByteCodeType = { @@ -712,8 +737,8 @@ const Tcl_ObjType tclByteCodeType = { }; /* - * The structure below defines a bytecode Tcl object type to hold the - * compiled bytecode for the [subst]itution of Tcl values. + * subtCodeType provides the standard type managemnt procedures for the + * substcode type, which represents substiution within a Tcl value. */ static const Tcl_ObjType substCodeType = { @@ -723,13 +748,14 @@ static const Tcl_ObjType substCodeType = { NULL, /* updateStringProc */ NULL, /* setFromAnyProc */ }; +#define SubstFlags(objPtr) (objPtr)->internalRep.twoPtrValue.ptr2 /* * Helper macros. */ #define TclIncrUInt4AtPtr(ptr, delta) \ - TclStoreInt4AtPtr(TclGetUInt4AtPtr(ptr)+(delta), (ptr)); + TclStoreInt4AtPtr(TclGetUInt4AtPtr(ptr)+(delta), (ptr)) /* *---------------------------------------------------------------------- @@ -737,16 +763,14 @@ static const Tcl_ObjType substCodeType = { * TclSetByteCodeFromAny -- * * Part of the bytecode Tcl object type implementation. Attempts to - * generate an byte code internal form for the Tcl object "objPtr" by - * compiling its string representation. This function also takes a hook - * procedure that will be invoked to perform any needed post processing - * on the compilation results before generating byte codes. interp is + * compile the string representation of the objPtr into bytecode. Accepts + * a hook routine that is invoked to perform any needed post-processing on + * the compilation results before generating byte codes. interp is the * compilation context and may not be NULL. * * Results: - * The return value is a standard Tcl object result. If an error occurs - * during compilation, an error message is left in the interpreter's - * result. + * A standard Tcl object result. If an error occurs during compilation, an + * error message is left in the interpreter's result. * * Side effects: * Frees the old internal representation. If no error occurs, then the @@ -763,12 +787,13 @@ TclSetByteCodeFromAny( * compiled. Must not be NULL. */ Tcl_Obj *objPtr, /* The object to make a ByteCode object. */ CompileHookProc *hookProc, /* Procedure to invoke after compilation. */ - ClientData clientData) /* Hook procedure private data. */ + void *clientData) /* Hook procedure private data. */ { Interp *iPtr = (Interp *) interp; CompileEnv compEnv; /* Compilation environment structure allocated * in frame. */ - int length, result = TCL_OK; + int length; + int result = TCL_OK; const char *stringPtr; Proc *procPtr = iPtr->compiledProcPtr; ContLineLoc *clLocPtr; @@ -776,7 +801,7 @@ TclSetByteCodeFromAny( #ifdef TCL_COMPILE_DEBUG if (!traceInitialized) { if (Tcl_LinkVar(interp, "tcl_traceCompile", - (char *) &tclTraceCompile, TCL_LINK_INT) != TCL_OK) { + &tclTraceCompile, TCL_LINK_INT) != TCL_OK) { Tcl_Panic("SetByteCodeFromAny: unable to create link for tcl_traceCompile variable"); } traceInitialized = 1; @@ -786,7 +811,7 @@ TclSetByteCodeFromAny( stringPtr = TclGetStringFromObj(objPtr, &length); /* - * TIP #280: Pick up the CmdFrame in which the BC compiler was invoked and + * TIP #280: Pick up the CmdFrame in which the BC compiler was invoked, and * use to initialize the tracking in the compiler. This information was * stored by TclCompEvalObj and ProcCompileProc. */ @@ -795,15 +820,14 @@ TclSetByteCodeFromAny( iPtr->invokeCmdFramePtr, iPtr->invokeWord); /* - * Now we check if we have data about invisible continuation lines for the - * script, and make it available to the compile environment, if so. + * Make available to the compilation environment any data about invisible + * continuation lines for the script. * * It is not clear if the script Tcl_Obj* can be free'd while the compiler * is using it, leading to the release of the associated ContLineLoc - * structure as well. To ensure that the latter doesn't happen we set a - * lock on it. We release this lock in the function TclFreeCompileEnv(), - * found in this file. The "lineCLPtr" hashtable is managed in the file - * "tclObj.c". + * structure as well. To ensure that the latter doesn't happen set a lock + * on it, which is released in TclFreeCompileEnv(). The "lineCLPtr" + * hashtable tclObj.c. */ clLocPtr = TclContinuationsGet(objPtr); @@ -814,7 +838,7 @@ TclSetByteCodeFromAny( TclCompileScript(interp, stringPtr, length, &compEnv); /* - * Successful compilation. Add a "done" instruction at the end. + * Compilation succeeded. Add a "done" instruction at the end. */ TclEmitOpcode(INST_DONE, &compEnv); @@ -822,14 +846,14 @@ TclSetByteCodeFromAny( /* * Check for optimizations! * - * Test if the generated code is free of most hazards; if so, recompile - * but with generation of INST_START_CMD disabled. This produces somewhat - * faster code in some cases, and more compact code in more. + * If the generated code is free of most hazards, recompile with generation + * of INST_START_CMD disabled to produce code that more compact in many + * cases, and also sometimes more performant. */ if (Tcl_GetParent(interp) == NULL && !Tcl_LimitTypeEnabled(interp, TCL_LIMIT_COMMANDS|TCL_LIMIT_TIME) - && IsCompactibleCompileEnv(interp, &compEnv)) { + && IsCompactibleCompileEnv(&compEnv)) { TclFreeCompileEnv(&compEnv); iPtr->compiledProcPtr = procPtr; TclInitCompileEnv(interp, &compEnv, stringPtr, length, @@ -854,7 +878,7 @@ TclSetByteCodeFromAny( } /* - * Invoke the compilation hook procedure if one exists. + * Invoke the compilation hook procedure if there is one. */ if (hookProc) { @@ -863,7 +887,7 @@ TclSetByteCodeFromAny( /* * Change the object into a ByteCode object. Ownership of the literal - * objects and aux data items is given to the ByteCode object. + * objects and aux data items passes to the ByteCode object. */ #ifdef TCL_COMPILE_DEBUG @@ -871,7 +895,7 @@ TclSetByteCodeFromAny( #endif /*TCL_COMPILE_DEBUG*/ if (result == TCL_OK) { - TclInitByteCodeObj(objPtr, &compEnv); + (void) TclInitByteCodeObj(objPtr, &tclByteCodeType, &compEnv); #ifdef TCL_COMPILE_DEBUG if (tclTraceCompile >= 2) { TclPrintByteCodeObj(interp, objPtr); @@ -894,12 +918,12 @@ TclSetByteCodeFromAny( * compiling its string representation. * * Results: - * The return value is a standard Tcl object result. If an error occurs - * during compilation, an error message is left in the interpreter's - * result unless "interp" is NULL. + * A standard Tcl object result. If an error occurs during compilation and + * "interp" is not null, an error message is left in the interpreter's + * result. * * Side effects: - * Frees the old internal representation. If no error occurs, then the + * Frees the old internal representation. If no error occurs then the * compiled code is stored as "objPtr"s bytecode representation. Also, if * debugging, initializes the "tcl_traceCompile" Tcl variable used to * trace compilations. @@ -911,7 +935,7 @@ static int SetByteCodeFromAny( Tcl_Interp *interp, /* The interpreter for which the code is being * compiled. Must not be NULL. */ - Tcl_Obj *objPtr) /* The object to make a ByteCode object. */ + Tcl_Obj *objPtr) /* The object to compile to bytecode */ { if (interp == NULL) { return TCL_ERROR; @@ -925,9 +949,9 @@ SetByteCodeFromAny( * DupByteCodeInternalRep -- * * Part of the bytecode Tcl object type implementation. However, it does - * not copy the internal representation of a bytecode Tcl_Obj, but - * instead leaves the new object untyped (with a NULL type pointer). - * Code will be compiled for the new object only if necessary. + * not copy the internal representation of a bytecode Tcl_Obj, instead + * assigning NULL to the type pointer of the new object. Code is compiled + * for the new object only if necessary. * * Results: * None. @@ -940,8 +964,8 @@ SetByteCodeFromAny( static void DupByteCodeInternalRep( - Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ - Tcl_Obj *copyPtr) /* Object with internal rep to set. */ + TCL_UNUSED(Tcl_Obj *) /*srcPtr*/, + TCL_UNUSED(Tcl_Obj *) /*copyPtr*/) { return; } @@ -959,9 +983,9 @@ DupByteCodeInternalRep( * None. * * Side effects: - * The bytecode object's internal rep is marked invalid and its code gets - * freed unless the code is actively being executed. In that case the - * cleanup is delayed until the last execution of the code completes. + * The bytecode object's internal rep is invalidated and its code is freed + * unless the code is actively being executed, in which case cleanup is + * delayed until the last execution of the code completes. * *---------------------------------------------------------------------- */ @@ -970,35 +994,54 @@ static void FreeByteCodeInternalRep( Tcl_Obj *objPtr) /* Object whose internal rep to free. */ { - ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1; + ByteCode *codePtr; - objPtr->typePtr = NULL; - if (codePtr->refCount-- <= 1) { - TclCleanupByteCode(codePtr); - } + ByteCodeGetInternalRep(objPtr, &tclByteCodeType, codePtr); + assert(codePtr != NULL); + + TclReleaseByteCode(codePtr); } /* *---------------------------------------------------------------------- * - * TclCleanupByteCode -- + * TclReleaseByteCode -- * - * This procedure does all the real work of freeing up a bytecode - * object's ByteCode structure. It's called only when the structure's - * reference count becomes zero. + * Does all the real work of freeing up a bytecode object's ByteCode + * structure. Called only when the structure's reference count + * is zero. * * Results: * None. * * Side effects: - * Frees objPtr's bytecode internal representation and sets its type NULL - * Also releases its literals and frees its auxiliary data items. + * Frees objPtr's bytecode internal representation and sets its type to + * NULL. Also releases its literals and frees its auxiliary data items. * *---------------------------------------------------------------------- */ void -TclCleanupByteCode( +TclPreserveByteCode( + ByteCode *codePtr) +{ + codePtr->refCount++; +} + +void +TclReleaseByteCode( + ByteCode *codePtr) +{ + if (codePtr->refCount-- > 1) { + return; + } + + /* Just dropped to refcount==0. Clean up. */ + CleanupByteCode(codePtr); +} + +static void +CleanupByteCode( ByteCode *codePtr) /* Points to the ByteCode to free. */ { Tcl_Interp *interp = (Tcl_Interp *) *codePtr->interpHandle; @@ -1018,7 +1061,7 @@ TclCleanupByteCode( statsPtr = &iPtr->stats; statsPtr->numByteCodesFreed++; - statsPtr->currentSrcBytes -= (double) codePtr->numSrcBytes; + statsPtr->currentSrcBytes -= (double)codePtr->numSrcBytes; statsPtr->currentByteCodeBytes -= (double) codePtr->structureSize; statsPtr->currentInstBytes -= (double) codePtr->numCodeBytes; @@ -1049,8 +1092,8 @@ TclCleanupByteCode( /* * A single heap object holds the ByteCode structure and its code, object, * command location, and auxiliary data arrays. This means we only need to - * 1) decrement the ref counts of the LiteralEntry's in its literal array, - * 2) call the free procs for the auxiliary data items, 3) free the + * 1) decrement the ref counts of each LiteralEntry in the literal array, + * 2) call the free procedures for the auxiliary data items, 3) free the * localCache if it is unused, and finally 4) free the ByteCode * structure's heap object. * @@ -1059,11 +1102,11 @@ TclCleanupByteCode( * the global literal table. They instead maintain private references to * their literals which must be decremented. * - * In order to insure a proper and efficient cleanup of the literal array - * when it contains non-shared literals [Bug 983660], we also distinguish - * the case of an interpreter being deleted (signaled by interp == NULL). + * In order to ensure proper and efficient cleanup of the literal array + * when it contains non-shared literals [Bug 983660], distinguish the case + * of an interpreter being deleted, which is signaled by interp == NULL. * Also, as the interp deletion will remove the global literal table - * anyway, we avoid the extra cost of updating it for each literal being + * anyway, avoid the extra cost of updating it for each literal being * released. */ @@ -1095,9 +1138,9 @@ TclCleanupByteCode( } /* - * TIP #280. Release the location data associated with this byte code - * structure, if any. NOTE: The interp we belong to may be gone already, - * and the data with it. + * TIP #280. Release the location data associated with this bytecode + * structure, if any. The associated interp may be gone already, and the + * data with it. * * See also tclBasic.c, DeleteInterpProc */ @@ -1107,12 +1150,12 @@ TclCleanupByteCode( (char *) codePtr); if (hePtr) { - ReleaseCmdWordData(Tcl_GetHashValue(hePtr)); + ReleaseCmdWordData((ExtCmdLoc *)Tcl_GetHashValue(hePtr)); Tcl_DeleteHashEntry(hePtr); } } - if (codePtr->localCachePtr && (--codePtr->localCachePtr->refCount == 0)) { + if (codePtr->localCachePtr && (codePtr->localCachePtr->refCount-- <= 1)) { TclFreeLocalCache(interp, codePtr->localCachePtr); } @@ -1125,15 +1168,14 @@ TclCleanupByteCode( * * IsCompactibleCompileEnv -- * - * Checks to see if we may apply some basic compaction optimizations to a - * piece of bytecode. Idempotent. + * Determines whether some basic compaction optimizations may be applied + * to a piece of bytecode. Idempotent. * * --------------------------------------------------------------------- */ static int IsCompactibleCompileEnv( - Tcl_Interp *interp, CompileEnv *envPtr) { unsigned char *pc; @@ -1141,7 +1183,7 @@ IsCompactibleCompileEnv( /* * Special: procedures in the '::tcl' namespace (or its children) are - * considered to be well-behaved and so can have compaction applied even + * considered to be well-behaved, so compaction can be applied to them even * if it would otherwise be invalid. */ @@ -1157,10 +1199,10 @@ IsCompactibleCompileEnv( /* * Go through and ensure that no operation involved can cause a desired - * change of bytecode sequence during running. This comes down to ensuring - * that there are no mapped variables (due to traces) or calls to external - * commands (traces, [uplevel] trickery). This is actually a very - * conservative check; it turns down a lot of code that is OK in practice. + * change of bytecode sequence during its execution. This comes down to + * ensuring that there are no mapped variables (due to traces) or calls to + * external commands (traces, [uplevel] trickery). This is actually a very + * conservative check. It turns down a lot of code that is OK in practice. */ for (pc = envPtr->codeStart ; pc < envPtr->codeNext ; pc += size) { @@ -1196,8 +1238,8 @@ IsCompactibleCompileEnv( * * Tcl_SubstObj -- * - * This function performs the substitutions specified on the given string - * as described in the user documentation for the "subst" Tcl command. + * Performs substitutions on the given string as described in the user + * documentation for "subst". * * Results: * A Tcl_Obj* containing the substituted string, or NULL to indicate that @@ -1229,14 +1271,14 @@ Tcl_SubstObj( * * Tcl_NRSubstObj -- * - * Request substitution of a Tcl value by the NR stack. + * Adds substitution within the value of objPtr to the NR execution stack. * * Results: - * Returns TCL_OK. + * TCL_OK. * * Side effects: * Compiles objPtr into bytecode that performs the substitutions as - * governed by flags and places callbacks on the NR stack to execute + * governed by flags, adds a callback to the NR execution stack to execute * the bytecode and store the result in the interp. * *---------------------------------------------------------------------- @@ -1260,13 +1302,11 @@ Tcl_NRSubstObj( * * CompileSubstObj -- * - * Compile a Tcl value into ByteCode implementing its substitution, as - * governed by flags. + * Compiles a value into bytecode that performs substitution within the + * value, as governed by flags. * * Results: - * A (ByteCode *) is returned pointing to the resulting ByteCode. - * The caller must manage its refCount and arrange for a call to - * TclCleanupByteCode() when the last reference disappears. + * A (ByteCode *) is pointing to the resulting ByteCode. * * Side effects: * The Tcl_ObjType of objPtr is changed to the "substcode" type, and the @@ -1286,24 +1326,26 @@ CompileSubstObj( Interp *iPtr = (Interp *) interp; ByteCode *codePtr = NULL; - if (objPtr->typePtr == &substCodeType) { + ByteCodeGetInternalRep(objPtr, &substCodeType, codePtr); + + if (codePtr != NULL) { Namespace *nsPtr = iPtr->varFramePtr->nsPtr; - codePtr = objPtr->internalRep.twoPtrValue.ptr1; - if (flags != PTR2INT(objPtr->internalRep.twoPtrValue.ptr2) + if (flags != PTR2INT(SubstFlags(objPtr)) || ((Interp *) *codePtr->interpHandle != iPtr) || (codePtr->compileEpoch != iPtr->compileEpoch) || (codePtr->nsPtr != nsPtr) || (codePtr->nsEpoch != nsPtr->resolverEpoch) || (codePtr->localCachePtr != iPtr->varFramePtr->localCachePtr)) { - FreeSubstCodeInternalRep(objPtr); + Tcl_StoreInternalRep(objPtr, &substCodeType, NULL); + codePtr = NULL; } } - if (objPtr->typePtr != &substCodeType) { + if (codePtr == NULL) { CompileEnv compEnv; int numBytes; - const char *bytes = Tcl_GetStringFromObj(objPtr, &numBytes); + const char *bytes = TclGetStringFromObj(objPtr, &numBytes); /* TODO: Check for more TIP 280 */ TclInitCompileEnv(interp, &compEnv, bytes, numBytes, NULL, 0); @@ -1311,13 +1353,10 @@ CompileSubstObj( TclSubstCompile(interp, bytes, numBytes, flags, 1, &compEnv); TclEmitOpcode(INST_DONE, &compEnv); - TclInitByteCodeObj(objPtr, &compEnv); - objPtr->typePtr = &substCodeType; + codePtr = TclInitByteCodeObj(objPtr, &substCodeType, &compEnv); TclFreeCompileEnv(&compEnv); - codePtr = objPtr->internalRep.twoPtrValue.ptr1; - objPtr->internalRep.twoPtrValue.ptr1 = codePtr; - objPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(flags); + SubstFlags(objPtr) = INT2PTR(flags); if (iPtr->varFramePtr->localCachePtr) { codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr; codePtr->localCachePtr->refCount++; @@ -1337,9 +1376,9 @@ CompileSubstObj( * * FreeSubstCodeInternalRep -- * - * Part of the substcode Tcl object type implementation. Frees the - * storage associated with a substcode object's internal representation - * unless its code is actively being executed. + * Part of the "substcode" Tcl object type implementation. Frees the + * storage associated with the substcode internal representation of a + * Tcl_Obj unless its code is actively being executed. * * Results: * None. @@ -1356,12 +1395,12 @@ static void FreeSubstCodeInternalRep( Tcl_Obj *objPtr) /* Object whose internal rep to free. */ { - ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1; + ByteCode *codePtr; - objPtr->typePtr = NULL; - if (codePtr->refCount-- <= 1) { - TclCleanupByteCode(codePtr); - } + ByteCodeGetInternalRep(objPtr, &substCodeType, codePtr); + assert(codePtr != NULL); + + TclReleaseByteCode(codePtr); } static void @@ -1374,14 +1413,14 @@ ReleaseCmdWordData( Tcl_DecrRefCount(eclPtr->path); } for (i=0 ; i<eclPtr->nuloc ; i++) { - ckfree((char *) eclPtr->loc[i].line); + ckfree(eclPtr->loc[i].line); } if (eclPtr->loc != NULL) { - ckfree((char *) eclPtr->loc); + ckfree(eclPtr->loc); } - ckfree((char *) eclPtr); + ckfree(eclPtr); } /* @@ -1460,7 +1499,7 @@ TclInitCompileEnv( * non-compiling evaluator */ - envPtr->extCmdMapPtr = ckalloc(sizeof(ExtCmdLoc)); + envPtr->extCmdMapPtr = (ExtCmdLoc *)ckalloc(sizeof(ExtCmdLoc)); envPtr->extCmdMapPtr->loc = NULL; envPtr->extCmdMapPtr->nloc = 0; envPtr->extCmdMapPtr->nuloc = 0; @@ -1516,7 +1555,7 @@ TclInitCompileEnv( * ...) which may make change the type as well. */ - CmdFrame *ctxPtr = TclStackAlloc(interp, sizeof(CmdFrame)); + CmdFrame *ctxPtr = (CmdFrame *)TclStackAlloc(interp, sizeof(CmdFrame)); int pc = 0; *ctxPtr = *invoker; @@ -1593,14 +1632,14 @@ TclInitCompileEnv( * * TclFreeCompileEnv -- * - * Free the storage allocated in a CompileEnv compilation environment + * Frees the storage allocated in a CompileEnv compilation environment * structure. * * Results: * None. * * Side effects: - * Allocated storage in the CompileEnv structure is freed. Note that its + * Allocated storage in the CompileEnv structure is freed, although its * local literal table is not deleted and its literal objects are not * released. In addition, storage referenced by its auxiliary data items * is not freed. This is done so that, when compilation is successful, @@ -1671,10 +1710,11 @@ TclFreeCompileEnv( * * TclWordKnownAtCompileTime -- * - * Test whether the value of a token is completely known at compile time. + * Determines whether the value of a token is completely known at compile + * time. * * Results: - * Returns true if the tokenPtr argument points to a word value that is + * True if the tokenPtr argument points to a word value that is * completely known at compile time. Generally, values that are known at * compile time can be compiled to their values, while values that cannot * be known until substitution at runtime must be compiled to bytecode @@ -1723,7 +1763,7 @@ TclWordKnownAtCompileTime( case TCL_TOKEN_BS: if (tempPtr != NULL) { - char utfBuf[TCL_UTF_MAX] = ""; + char utfBuf[4] = ""; int length = TclParseBackslash(tokenPtr->start, tokenPtr->size, NULL, utfBuf); @@ -1751,12 +1791,12 @@ TclWordKnownAtCompileTime( * * TclCompileScript -- * - * Compile a Tcl script in a string. + * Compiles a Tcl script in a string. * * Results: - * The return value is TCL_OK on a successful compilation and TCL_ERROR - * on failure. If TCL_ERROR is returned, then the interpreter's result - * contains an error message. + * + * A standard Tcl result. If an error occurs, an + * error message is left in the interpreter's result. * * Side effects: * Adds instructions to envPtr to evaluate the script at runtime. @@ -1785,20 +1825,20 @@ CompileCmdLiteral( Tcl_Obj *cmdObj, CompileEnv *envPtr) { - int numBytes; const char *bytes; Command *cmdPtr; int cmdLitIdx, extraLiteralFlags = LITERAL_CMD_NAME; + int numBytes; cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, cmdObj); if ((cmdPtr != NULL) && (cmdPtr->flags & CMD_VIA_RESOLVER)) { extraLiteralFlags |= LITERAL_UNSHARED; } - bytes = Tcl_GetStringFromObj(cmdObj, &numBytes); - cmdLitIdx = TclRegisterLiteral(envPtr, (char *)bytes, numBytes, extraLiteralFlags); + bytes = TclGetStringFromObj(cmdObj, &numBytes); + cmdLitIdx = TclRegisterLiteral(envPtr, bytes, numBytes, extraLiteralFlags); - if (cmdPtr) { + if (cmdPtr && TclRoutineHasName(cmdPtr)) { TclSetCmdNameObj(interp, TclFetchLiteral(envPtr, cmdLitIdx), cmdPtr); } TclEmitPush(cmdLitIdx, envPtr); @@ -1813,7 +1853,8 @@ TclCompileInvocation( CompileEnv *envPtr) { DefineLineInformation; - int wordIdx = 0, depth = TclGetStackDepth(envPtr); + int wordIdx = 0; + int depth = TclGetStackDepth(envPtr); if (cmdObj) { CompileCmdLiteral(interp, cmdObj, envPtr); @@ -1831,8 +1872,8 @@ TclCompileInvocation( continue; } - objIdx = TclRegisterNewLiteral(envPtr, - tokenPtr[1].start, tokenPtr[1].size); + objIdx = TclRegisterLiteral(envPtr, + tokenPtr[1].start, tokenPtr[1].size, 0); if (envPtr->clNext) { TclContinuationsEnterDerived(TclFetchLiteral(envPtr, objIdx), tokenPtr[1].start - envPtr->source, envPtr->clNext); @@ -1881,8 +1922,8 @@ CompileExpanded( continue; } - objIdx = TclRegisterNewLiteral(envPtr, - tokenPtr[1].start, tokenPtr[1].size); + objIdx = TclRegisterLiteral(envPtr, + tokenPtr[1].start, tokenPtr[1].size, 0); if (envPtr->clNext) { TclContinuationsEnterDerived(TclFetchLiteral(envPtr, objIdx), tokenPtr[1].start - envPtr->source, envPtr->clNext); @@ -1893,14 +1934,14 @@ CompileExpanded( /* * The stack depth during argument expansion can only be managed at * runtime, as the number of elements in the expanded lists is not known - * at compile time. We adjust here the stack depth estimate so that it is + * at compile time. Adjust the stack depth estimate here so that it is * correct after the command with expanded arguments returns. * * The end effect of this command's invocation is that all the words of - * the command are popped from the stack, and the result is pushed: the + * the command are popped from the stack and the result is pushed: The * stack top changes by (1-wordIdx). * - * Note that the estimates are not correct while the command is being + * The estimates are not correct while the command is being * prepared and run, INST_EXPAND_STKTOP is not stack-neutral in general. */ @@ -1920,16 +1961,16 @@ CompileCmdCompileProc( int depth = TclGetStackDepth(envPtr); /* - * Emit of the INST_START_CMD instruction is controlled by the value of + * Emission of the INST_START_CMD instruction is controlled by the value of * envPtr->atCmdStart: * - * atCmdStart == 2 : We are not using the INST_START_CMD instruction. - * atCmdStart == 1 : INST_START_CMD was the last instruction emitted. - * : We do not need to emit another. Instead we - * : increment the number of cmds started at it (except - * : for the special case at the start of a script.) - * atCmdStart == 0 : The last instruction was something else. We need - * : to emit INST_START_CMD here. + * atCmdStart == 2 : Don't use the INST_START_CMD instruction. + * atCmdStart == 1 : INST_START_CMD was the last instruction emitted, + * : so no need to emit another. Instead + * : increment the number of cmds started at it, except + * : for the special case at the start of a script. + * atCmdStart == 0 : The last instruction was something else. + * : Emit INST_START_CMD here. */ switch (envPtr->atCmdStart) { @@ -1952,7 +1993,7 @@ CompileCmdCompileProc( if (TCL_OK == TclAttemptCompileProc(interp, parsePtr, 1, cmdPtr, envPtr)) { if (incrOffset >= 0) { /* - * We successfully compiled a command. Increment the number of + * Command compiled succesfully. Increment the number of * commands that start at the currently active INST_START_CMD. */ @@ -2010,25 +2051,25 @@ CompileCommandTokens( int startCodeOffset = envPtr->codeNext - envPtr->codeStart; int depth = TclGetStackDepth(envPtr); - TclNewObj(cmdObj); assert (parsePtr->numWords > 0); /* Pre-Compile */ + TclNewObj(cmdObj); envPtr->numCommands++; EnterCmdStartData(envPtr, cmdIdx, parsePtr->commandStart - envPtr->source, startCodeOffset); /* * TIP #280. Scan the words and compute the extended location information. - * The map first contain full per-word line information for use by the + * At first the map first contains full per-word line information for use by the * compiler. This is later replaced by a reduced form which signals * non-literal words, stored in 'wlines'. */ EnterCmdWordData(eclPtr, parsePtr->commandStart - envPtr->source, parsePtr->tokenPtr, parsePtr->commandStart, - parsePtr->commandSize, parsePtr->numWords, cmdLine, + parsePtr->numWords, cmdLine, clNext, &wlines, envPtr); wlineat = eclPtr->nuloc - 1; @@ -2063,7 +2104,7 @@ CompileCommandTokens( } } - /* If cmdPtr != NULL, we will try to call cmdPtr->compileProc */ + /* If cmdPtr != NULL, try to call cmdPtr->compileProc */ if (cmdPtr) { code = CompileCmdCompileProc(interp, parsePtr, cmdPtr, envPtr); } @@ -2090,8 +2131,8 @@ CompileCommandTokens( (envPtr->codeNext-envPtr->codeStart) - startCodeOffset); /* - * TIP #280: Free full form of per-word line data and insert the reduced - * form now + * TIP #280: Free the full form of per-word line data and insert the + * reduced form now. */ envPtr->line = cmdLine; @@ -2129,10 +2170,10 @@ TclCompileScript( } /* * Check depth to avoid overflow of the C execution stack by too many - * nested calls of TclCompileScript (considering interp recursionlimit). - * Factor 5/4 (1.25) is used to avoid too mistaken limit recognition - * during "mixed" evaluation and compilation process (nested eval+compile) - * and is good enough for default recursionlimit (1000). + * nested calls of TclCompileScript, considering interp recursionlimit. + * Use factor 5/4 (1.25) to avoid being too mistaken when recognizing the + * limit during "mixed" evaluation and compilation process (nested + * eval+compile) and is good enough for default recursionlimit (1000). */ if (iPtr->numLevels / 5 > iPtr->maxNestingDepth / 4) { Tcl_SetObjResult(interp, Tcl_NewStringObj( @@ -2150,7 +2191,7 @@ TclCompileScript( * many nested compilations (body enclosed in body) can cause abnormal * program termination with a stack overflow exception, bug [fec0c17d39]. */ - Tcl_Parse *parsePtr = ckalloc(sizeof(Tcl_Parse)); + Tcl_Parse *parsePtr = (Tcl_Parse *)ckalloc(sizeof(Tcl_Parse)); do { const char *next; @@ -2275,8 +2316,8 @@ TclCompileScript( * * TclCompileTokens -- * - * Given an array of tokens parsed from a Tcl command (e.g., the tokens - * that make up a word) this procedure emits instructions to evaluate the + * Given an array of tokens parsed from a Tcl command, e.g. the tokens + * that make up a word, emits instructions to evaluate the * tokens and concatenate their values to form a single result value on * the interpreter's runtime evaluation stack. * @@ -2298,8 +2339,8 @@ TclCompileVarSubst( CompileEnv *envPtr) { const char *p, *name = tokenPtr[1].start; - int nameBytes = tokenPtr[1].size; - int i, localVar, localVarName = 1; + int i, localVar, nameBytes = tokenPtr[1].size; + int localVarName = 1; /* * Determine how the variable name should be handled: if it contains any @@ -2326,7 +2367,7 @@ TclCompileVarSubst( * of local variables in a procedure frame. */ - localVar = -1; + localVar = TCL_INDEX_NONE; if (localVarName != -1) { localVar = TclFindCompiledLocal(name, nameBytes, localVarName, envPtr); } @@ -2372,8 +2413,9 @@ TclCompileTokens( { Tcl_DString textBuffer; /* Holds concatenated chars from adjacent * TCL_TOKEN_TEXT, TCL_TOKEN_BS tokens. */ - char buffer[TCL_UTF_MAX] = ""; - int i, numObjsToConcat, length, adjust; + char buffer[4] = ""; + int i, numObjsToConcat, adjust; + int length; unsigned char *entryCodeNext = envPtr->codeNext; #define NUM_STATIC_POS 20 int isLiteral, maxNumCL, numCL; @@ -2381,18 +2423,16 @@ TclCompileTokens( int depth = TclGetStackDepth(envPtr); /* - * For the handling of continuation lines in literals we first check if - * this is actually a literal. For if not we can forego the additional - * processing. Otherwise we pre-allocate a small table to store the - * locations of all continuation lines we find in this literal, if any. - * The table is extended if needed. + * if this is actually a literal, handle continuation lines by + * preallocating a small table to store the locations of any continuation + * lines we find in this literal. The table is extended if needed. * - * Note: Different to the equivalent code in function 'TclSubstTokens()' - * (see file "tclParse.c") we do not seem to need the 'adjust' variable. - * We also do not seem to need code which merges continuation line - * information of multiple words which concat'd at runtime. Either that or - * I have not managed to find a test case for these two possibilities yet. - * It might be a difference between compile- versus run-time processing. + * Note: In contrast with the analagous code in 'TclSubstTokens()' the + * 'adjust' variable seems unneeded here. The code which merges + * continuation line information of multiple words which concat'd at + * runtime also seems unneeded. Either that or I have not managed to find a + * test case for these two possibilities yet. It might be a difference + * between compile- versus run-time processing. */ numCL = 0; @@ -2408,7 +2448,7 @@ TclCompileTokens( if (isLiteral) { maxNumCL = NUM_STATIC_POS; - clPosition = ckalloc(maxNumCL * sizeof(int)); + clPosition = (int *)ckalloc(maxNumCL * sizeof(int)); } adjust = 0; @@ -2428,18 +2468,17 @@ TclCompileTokens( Tcl_DStringAppend(&textBuffer, buffer, length); /* - * If the backslash sequence we found is in a literal, and - * represented a continuation line, we compute and store its + * If the identified backslash sequence is in a literal and + * represented a continuation line, compute and store its * location (as char offset to the beginning of the _result_ * script). We may have to extend the table of locations. * - * Note that the continuation line information is relevant even if - * the word we are processing is not a literal, as it can affect - * nested commands. See the branch for TCL_TOKEN_COMMAND below, - * where the adjustment we are tracking here is taken into - * account. The good thing is that we do not need a table of - * everything, just the number of lines we have to add as - * correction. + * The continuation line information is relevant even if the word + * being processed is not a literal, as it can affect nested + * commands. See the branch below for TCL_TOKEN_COMMAND, where the + * adjustment being tracked here is taken into account. The good + * thing is a table of everything is not needed, just the number of + * lines to to add as correction. */ if ((length == 1) && (buffer[0] == ' ') && @@ -2449,7 +2488,7 @@ TclCompileTokens( if (numCL >= maxNumCL) { maxNumCL *= 2; - clPosition = ckrealloc(clPosition, + clPosition = (int *)ckrealloc(clPosition, maxNumCL * sizeof(int)); } clPosition[numCL] = clPos; @@ -2565,13 +2604,13 @@ TclCompileTokens( * TclCompileCmdWord -- * * Given an array of parse tokens for a word containing one or more Tcl - * commands, emit inline instructions to execute them. This procedure - * differs from TclCompileTokens in that a simple word such as a loop - * body enclosed in braces is not just pushed as a string, but is itself - * parsed into tokens and compiled. + * commands, emits inline instructions to execute them. In contrast with + * TclCompileTokens, a simple word such as a loop body enclosed in braces + * is not just pushed as a string, but is itself parsed into tokens and + * compiled. * * Results: - * The return value is a standard Tcl result. If an error occurs, an + * A standard Tcl result. If an error occurs, an * error message is left in the interpreter's result. * * Side effects: @@ -2591,16 +2630,16 @@ TclCompileCmdWord( { if ((count == 1) && (tokenPtr->type == TCL_TOKEN_TEXT)) { /* - * Handle the common case: if there is a single text token, compile it + * The common case that there is a single text token. Compile it * into an inline sequence of instructions. */ TclCompileScript(interp, tokenPtr->start, tokenPtr->size, envPtr); } else { /* - * Multiple tokens or the single token involves substitutions. Emit - * instructions to invoke the eval command procedure at runtime on the - * result of evaluating the tokens. + * Either there are multiple tokens, or the single token involves + * substitutions. Emit instructions to invoke the eval command + * procedure at runtime on the result of evaluating the tokens. */ TclCompileTokens(interp, tokenPtr, count, envPtr); @@ -2614,13 +2653,12 @@ TclCompileCmdWord( * TclCompileExprWords -- * * Given an array of parse tokens representing one or more words that - * contain a Tcl expression, emit inline instructions to execute the - * expression. This procedure differs from TclCompileExpr in that it - * supports Tcl's two-level substitution semantics for expressions that - * appear as command words. + * contain a Tcl expression, emits inline instructions to execute the + * expression. In contrast with TclCompileExpr, supports Tcl's two-level + * substitution semantics for an expression that appears as command words. * * Results: - * The return value is a standard Tcl result. If an error occurs, an + * A standard Tcl result. If an error occurs, an * error message is left in the interpreter's result. * * Side effects: @@ -2682,10 +2720,10 @@ TclCompileExprWords( * * TclCompileNoOp -- * - * Function called to compile no-op's + * Compiles no-op's * * Results: - * The return value is TCL_OK, indicating successful compilation. + * TCL_OK if completion was successful. * * Side effects: * Instructions are added to envPtr to execute a no-op at runtime. No @@ -2700,8 +2738,7 @@ TclCompileNoOp( 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 definition of command being - * compiled. */ + TCL_UNUSED(Command *), CompileEnv *envPtr) /* Holds resulting instructions. */ { Tcl_Token *tokenPtr; @@ -2725,14 +2762,14 @@ TclCompileNoOp( * * TclInitByteCodeObj -- * - * Create a ByteCode structure and initialize it from a CompileEnv + * Creates a ByteCode structure and initializes it from a CompileEnv * compilation environment structure. The ByteCode structure is smaller * and contains just that information needed to execute the bytecode * instructions resulting from compiling a Tcl script. The resulting * structure is placed in the specified object. * * Results: - * A newly constructed ByteCode object is stored in the internal + * A newly-constructed ByteCode object is stored in the internal * representation of the objPtr. * * Side effects: @@ -2745,11 +2782,40 @@ TclCompileNoOp( *---------------------------------------------------------------------- */ -void -TclInitByteCodeObj( - Tcl_Obj *objPtr, /* Points object that should be initialized, - * and whose string rep contains the source - * code. */ +static void +PreventCycle( + Tcl_Obj *objPtr, + CompileEnv *envPtr) +{ + int i; + + for (i = 0; i < envPtr->literalArrayNext; i++) { + if (objPtr == TclFetchLiteral(envPtr, i)) { + /* + * Prevent circular reference where the bytecode internalrep of + * a value contains a literal which is that same value. + * If this is allowed to happen, refcount decrements may not + * reach zero, and memory may leak. Bugs 467523, 3357771 + * + * NOTE: [Bugs 3392070, 3389764] We make a copy based completely + * on the string value, and do not call Tcl_DuplicateObj() so we + * can be sure we do not have any lingering cycles hiding in + * the internalrep. + */ + int numBytes; + const char *bytes = TclGetStringFromObj(objPtr, &numBytes); + Tcl_Obj *copyPtr = Tcl_NewStringObj(bytes, numBytes); + + Tcl_IncrRefCount(copyPtr); + TclReleaseLiteral((Tcl_Interp *)envPtr->iPtr, objPtr); + + envPtr->literalArrayPtr[i].objPtr = copyPtr; + } + } +} + +ByteCode * +TclInitByteCode( CompileEnv *envPtr)/* Points to the CompileEnv structure from * which to create a ByteCode structure. */ { @@ -2779,9 +2845,13 @@ TclInitByteCodeObj( /* * Compute the total number of bytes needed for this bytecode. + * + * Note that code bytes need not be aligned but since later elements are we + * need to pad anyway, either directly after ByteCode or after codeBytes, + * and it's easier and more consistent to do the former. */ - structureSize = sizeof(ByteCode); + structureSize = TCL_ALIGN(sizeof(ByteCode)); /* align code bytes */ structureSize += TCL_ALIGN(codeBytes); /* align object array */ structureSize += TCL_ALIGN(objArrayBytes); /* align exc range arr */ structureSize += TCL_ALIGN(exceptArrayBytes); /* align AuxData array */ @@ -2794,13 +2864,14 @@ TclInitByteCodeObj( namespacePtr = envPtr->iPtr->globalNsPtr; } - p = ckalloc(structureSize); + p = (unsigned char *)ckalloc(structureSize); codePtr = (ByteCode *) p; codePtr->interpHandle = TclHandlePreserve(iPtr->handle); codePtr->compileEpoch = iPtr->compileEpoch; codePtr->nsPtr = namespacePtr; codePtr->nsEpoch = namespacePtr->resolverEpoch; - codePtr->refCount = 1; + codePtr->refCount = 0; + TclPreserveByteCode(codePtr); if (namespacePtr->compiledVarResProc || iPtr->resolverPtr) { codePtr->flags = TCL_BYTECODE_RESOLVE_VARS; } else { @@ -2819,36 +2890,14 @@ TclInitByteCodeObj( codePtr->maxExceptDepth = envPtr->maxExceptDepth; codePtr->maxStackDepth = envPtr->maxStackDepth; - p += sizeof(ByteCode); + p += TCL_ALIGN(sizeof(ByteCode)); /* align code bytes */ codePtr->codeStart = p; memcpy(p, envPtr->codeStart, codeBytes); p += TCL_ALIGN(codeBytes); /* align object array */ codePtr->objArrayPtr = (Tcl_Obj **) p; for (i = 0; i < numLitObjects; i++) { - Tcl_Obj *fetched = TclFetchLiteral(envPtr, i); - - if (objPtr == fetched) { - /* - * Prevent circular reference where the bytecode internalrep of - * a value contains a literal which is that same value. - * If this is allowed to happen, refcount decrements may not - * reach zero, and memory may leak. Bugs 467523, 3357771 - * - * NOTE: [Bugs 3392070, 3389764] We make a copy based completely - * on the string value, and do not call Tcl_DuplicateObj() so we - * can be sure we do not have any lingering cycles hiding in - * the internalrep. - */ - int numBytes; - const char *bytes = Tcl_GetStringFromObj(objPtr, &numBytes); - - codePtr->objArrayPtr[i] = Tcl_NewStringObj(bytes, numBytes); - Tcl_IncrRefCount(codePtr->objArrayPtr[i]); - TclReleaseLiteral((Tcl_Interp *)iPtr, objPtr); - } else { - codePtr->objArrayPtr[i] = fetched; - } + codePtr->objArrayPtr[i] = TclFetchLiteral(envPtr, i); } p += TCL_ALIGN(objArrayBytes); /* align exception range array */ @@ -2891,15 +2940,6 @@ TclInitByteCodeObj( #endif /* TCL_COMPILE_STATS */ /* - * Free the old internal rep then convert the object to a bytecode object - * by making its internal rep point to the just compiled ByteCode. - */ - - TclFreeIntRep(objPtr); - objPtr->internalRep.twoPtrValue.ptr1 = codePtr; - objPtr->typePtr = &tclByteCodeType; - - /* * TIP #280. Associate the extended per-word line information with the * byte code object (internal rep), for use with the bc compiler. */ @@ -2912,6 +2952,31 @@ TclInitByteCodeObj( envPtr->iPtr = NULL; codePtr->localCachePtr = NULL; + return codePtr; +} + +ByteCode * +TclInitByteCodeObj( + Tcl_Obj *objPtr, /* Points object that should be initialized, + * and whose string rep contains the source + * code. */ + const Tcl_ObjType *typePtr, + CompileEnv *envPtr)/* Points to the CompileEnv structure from + * which to create a ByteCode structure. */ +{ + ByteCode *codePtr; + + PreventCycle(objPtr, envPtr); + + codePtr = TclInitByteCode(envPtr); + + /* + * Free the old internal rep then convert the object to a bytecode object + * by making its internal rep point to the just compiled ByteCode. + */ + + ByteCodeSetInternalRep(objPtr, typePtr, codePtr); + return codePtr; } /* @@ -2950,7 +3015,7 @@ TclFindCompiledLocal( CompileEnv *envPtr) /* Points to the current compile environment*/ { CompiledLocal *localPtr; - int localVar = -1; + int localVar = TCL_INDEX_NONE; int i; Proc *procPtr; @@ -2973,19 +3038,19 @@ TclFindCompiledLocal( int len; if (!cachePtr || !name) { - return -1; + return TCL_INDEX_NONE; } varNamePtr = &cachePtr->varName0; for (i=0; i < cachePtr->numVars; varNamePtr++, i++) { if (*varNamePtr) { - localName = Tcl_GetStringFromObj(*varNamePtr, &len); + localName = TclGetStringFromObj(*varNamePtr, &len); if ((len == nameBytes) && !strncmp(name, localName, len)) { return i; } } } - return -1; + return TCL_INDEX_NONE; } if (name != NULL) { @@ -3011,7 +3076,7 @@ TclFindCompiledLocal( if (create || (name == NULL)) { localVar = procPtr->numCompiledLocals; - localPtr = ckalloc(TclOffset(CompiledLocal, name) + 1U + nameBytes); + localPtr = (CompiledLocal *)ckalloc(offsetof(CompiledLocal, name) + 1U + nameBytes); if (procPtr->firstLocalPtr == NULL) { procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr; } else { @@ -3042,16 +3107,15 @@ TclFindCompiledLocal( * * TclExpandCodeArray -- * - * Procedure that uses malloc to allocate more storage for a CompileEnv's - * code array. + * Uses malloc to allocate more storage for a CompileEnv's code array. * * Results: * None. * * Side effects: - * The byte code array in *envPtr is reallocated to a new array of double - * the size, and if envPtr->mallocedCodeArray is non-zero the old array - * is freed. Byte codes are copied from the old array to the new one. + * The size of the bytecode array is doubled. If envPtr->mallocedCodeArray + * is non-zero the old array is freed. Byte codes are copied from the old + * array to the new one. * *---------------------------------------------------------------------- */ @@ -3061,7 +3125,7 @@ TclExpandCodeArray( void *envArgPtr) /* Points to the CompileEnv whose code array * must be enlarged. */ { - CompileEnv *envPtr = envArgPtr; + CompileEnv *envPtr = (CompileEnv *)envArgPtr; /* The CompileEnv containing the code array to * be doubled in size. */ @@ -3075,14 +3139,14 @@ TclExpandCodeArray( size_t newBytes = 2 * (envPtr->codeEnd - envPtr->codeStart); if (envPtr->mallocedCodeArray) { - envPtr->codeStart = ckrealloc(envPtr->codeStart, newBytes); + envPtr->codeStart = (unsigned char *)ckrealloc(envPtr->codeStart, newBytes); } else { /* - * envPtr->codeStart isn't a ckalloc'd pointer, so we must code a - * ckrealloc equivalent for ourselves. + * envPtr->exceptArrayPtr isn't a Tcl_Alloc'd pointer, so + * perform the equivalent of Tcl_Realloc directly. */ - unsigned char *newPtr = ckalloc(newBytes); + unsigned char *newPtr = (unsigned char *)ckalloc(newBytes); memcpy(newPtr, envPtr->codeStart, currBytes); envPtr->codeStart = newPtr; @@ -3142,14 +3206,14 @@ EnterCmdStartData( size_t newBytes = newElems * sizeof(CmdLocation); if (envPtr->mallocedCmdMap) { - envPtr->cmdMapPtr = ckrealloc(envPtr->cmdMapPtr, newBytes); + envPtr->cmdMapPtr = (CmdLocation *)ckrealloc(envPtr->cmdMapPtr, newBytes); } else { /* * envPtr->cmdMapPtr isn't a ckalloc'd pointer, so we must code a * ckrealloc equivalent for ourselves. */ - CmdLocation *newPtr = ckalloc(newBytes); + CmdLocation *newPtr = (CmdLocation *)ckalloc(newBytes); memcpy(newPtr, envPtr->cmdMapPtr, currBytes); envPtr->cmdMapPtr = newPtr; @@ -3167,8 +3231,8 @@ EnterCmdStartData( cmdLocPtr = &envPtr->cmdMapPtr[cmdIndex]; cmdLocPtr->codeOffset = codeOffset; cmdLocPtr->srcOffset = srcOffset; - cmdLocPtr->numSrcBytes = -1; - cmdLocPtr->numCodeBytes = -1; + cmdLocPtr->numSrcBytes = TCL_INDEX_NONE; + cmdLocPtr->numCodeBytes = TCL_INDEX_NONE; } /* @@ -3246,7 +3310,6 @@ EnterCmdWordData( int srcOffset, /* Offset of first char of the command. */ Tcl_Token *tokenPtr, const char *cmd, - int len, int numWords, int line, int *clNext, @@ -3255,7 +3318,8 @@ EnterCmdWordData( { ECL *ePtr; const char *last; - int wordIdx, wordLine, *wwlines, *wordNext; + int wordIdx, wordLine; + int *wwlines, *wordNext; if (eclPtr->nuloc >= eclPtr->nloc) { /* @@ -3268,16 +3332,16 @@ EnterCmdWordData( size_t newElems = (currElems ? 2*currElems : 1); size_t newBytes = newElems * sizeof(ECL); - eclPtr->loc = ckrealloc(eclPtr->loc, newBytes); + eclPtr->loc = (ECL *)ckrealloc(eclPtr->loc, newBytes); eclPtr->nloc = newElems; } ePtr = &eclPtr->loc[eclPtr->nuloc]; ePtr->srcOffset = srcOffset; - ePtr->line = ckalloc(numWords * sizeof(int)); - ePtr->next = ckalloc(numWords * sizeof(int *)); + ePtr->line = (int *)ckalloc(numWords * sizeof(int)); + ePtr->next = (int **)ckalloc(numWords * sizeof(int *)); ePtr->nline = numWords; - wwlines = ckalloc(numWords * sizeof(int)); + wwlines = (int *)ckalloc(numWords * sizeof(int)); last = cmd; wordLine = line; @@ -3290,7 +3354,7 @@ EnterCmdWordData( /* See Ticket 4b61afd660 */ wwlines[wordIdx] = ((wordIdx == 0) || TclWordKnownAtCompileTime(tokenPtr, NULL)) - ? wordLine : -1; + ? wordLine : TCL_INDEX_NONE; ePtr->line[wordIdx] = wordLine; ePtr->next[wordIdx] = wordNext; last = tokenPtr->start; @@ -3340,23 +3404,23 @@ TclCreateExceptRange( size_t currBytes = envPtr->exceptArrayNext * sizeof(ExceptionRange); size_t currBytes2 = envPtr->exceptArrayNext * sizeof(ExceptionAux); - int newElems = 2*envPtr->exceptArrayEnd; + size_t newElems = 2*envPtr->exceptArrayEnd; size_t newBytes = newElems * sizeof(ExceptionRange); size_t newBytes2 = newElems * sizeof(ExceptionAux); if (envPtr->mallocedExceptArray) { envPtr->exceptArrayPtr = - ckrealloc(envPtr->exceptArrayPtr, newBytes); + (ExceptionRange *)ckrealloc(envPtr->exceptArrayPtr, newBytes); envPtr->exceptAuxArrayPtr = - ckrealloc(envPtr->exceptAuxArrayPtr, newBytes2); + (ExceptionAux *)ckrealloc(envPtr->exceptAuxArrayPtr, newBytes2); } else { /* * envPtr->exceptArrayPtr isn't a ckalloc'd pointer, so we must * code a ckrealloc equivalent for ourselves. */ - ExceptionRange *newPtr = ckalloc(newBytes); - ExceptionAux *newPtr2 = ckalloc(newBytes2); + ExceptionRange *newPtr = (ExceptionRange *)ckalloc(newBytes); + ExceptionAux *newPtr2 = (ExceptionAux *)ckalloc(newBytes2); memcpy(newPtr, envPtr->exceptArrayPtr, currBytes); memcpy(newPtr2, envPtr->exceptAuxArrayPtr, currBytes2); @@ -3371,16 +3435,16 @@ TclCreateExceptRange( rangePtr = &envPtr->exceptArrayPtr[index]; rangePtr->type = type; rangePtr->nestingLevel = envPtr->exceptDepth; - rangePtr->codeOffset = -1; - rangePtr->numCodeBytes = -1; - rangePtr->breakOffset = -1; - rangePtr->continueOffset = -1; - rangePtr->catchOffset = -1; + rangePtr->codeOffset = TCL_INDEX_NONE; + rangePtr->numCodeBytes = TCL_INDEX_NONE; + rangePtr->breakOffset = TCL_INDEX_NONE; + rangePtr->continueOffset = TCL_INDEX_NONE; + rangePtr->catchOffset = TCL_INDEX_NONE; auxPtr = &envPtr->exceptAuxArrayPtr[index]; auxPtr->supportsContinue = 1; auxPtr->stackDepth = envPtr->currStackDepth; auxPtr->expandTarget = envPtr->expandCount; - auxPtr->expandTargetDepth = -1; + auxPtr->expandTargetDepth = TCL_INDEX_NONE; auxPtr->numBreakTargets = 0; auxPtr->breakTargets = NULL; auxPtr->allocBreakTargets = 0; @@ -3396,7 +3460,7 @@ TclCreateExceptRange( * TclGetInnermostExceptionRange -- * * Returns the innermost exception range that covers the current code - * creation point, and (optionally) the stack depth that is expected at + * creation point, and optionally the stack depth that is expected at * that point. Relies on the fact that the range has a numCodeBytes = -1 * when it is being populated and that inner ranges come after outer * ranges. @@ -3410,14 +3474,14 @@ TclGetInnermostExceptionRange( int returnCode, ExceptionAux **auxPtrPtr) { - int i = envPtr->exceptArrayNext; + size_t i = envPtr->exceptArrayNext; ExceptionRange *rangePtr = envPtr->exceptArrayPtr + i; while (i > 0) { rangePtr--; i--; if (CurrentOffset(envPtr) >= rangePtr->codeOffset && - (rangePtr->numCodeBytes == -1 || CurrentOffset(envPtr) < + (rangePtr->numCodeBytes == TCL_INDEX_NONE || CurrentOffset(envPtr) < rangePtr->codeOffset+rangePtr->numCodeBytes) && (returnCode != TCL_CONTINUE || envPtr->exceptAuxArrayPtr[i].supportsContinue)) { @@ -3438,7 +3502,7 @@ TclGetInnermostExceptionRange( * * Adds a place that wants to break/continue to the loop exception range * tracking that will be fixed up once the loop can be finalized. These - * functions will generate an INST_JUMP4 that will be fixed up during the + * functions generate an INST_JUMP4 that is fixed up during the * loop finalization. * * --------------------------------------------------------------------- @@ -3459,11 +3523,11 @@ TclAddLoopBreakFixup( auxPtr->allocBreakTargets *= 2; auxPtr->allocBreakTargets += 2; if (auxPtr->breakTargets) { - auxPtr->breakTargets = ckrealloc(auxPtr->breakTargets, + auxPtr->breakTargets = (unsigned int *)ckrealloc(auxPtr->breakTargets, sizeof(int) * auxPtr->allocBreakTargets); } else { auxPtr->breakTargets = - ckalloc(sizeof(int) * auxPtr->allocBreakTargets); + (unsigned int *)ckalloc(sizeof(int) * auxPtr->allocBreakTargets); } } auxPtr->breakTargets[auxPtr->numBreakTargets - 1] = CurrentOffset(envPtr); @@ -3485,11 +3549,11 @@ TclAddLoopContinueFixup( auxPtr->allocContinueTargets *= 2; auxPtr->allocContinueTargets += 2; if (auxPtr->continueTargets) { - auxPtr->continueTargets = ckrealloc(auxPtr->continueTargets, + auxPtr->continueTargets = (unsigned int *)ckrealloc(auxPtr->continueTargets, sizeof(int) * auxPtr->allocContinueTargets); } else { auxPtr->continueTargets = - ckalloc(sizeof(int) * auxPtr->allocContinueTargets); + (unsigned int *)ckalloc(sizeof(int) * auxPtr->allocContinueTargets); } } auxPtr->continueTargets[auxPtr->numContinueTargets - 1] = @@ -3502,8 +3566,8 @@ TclAddLoopContinueFixup( * * TclCleanupStackForBreakContinue -- * - * Ditch the extra elements from the auxiliary stack and the main stack. - * How to do this exactly depends on whether there are any elements on + * Removes the extra elements from the auxiliary stack and the main stack. + * How this is done depends on whether there are any elements on * the auxiliary stack to pop. * * --------------------------------------------------------------------- @@ -3514,7 +3578,7 @@ TclCleanupStackForBreakContinue( CompileEnv *envPtr, ExceptionAux *auxPtr) { - int savedStackDepth = envPtr->currStackDepth; + size_t savedStackDepth = envPtr->currStackDepth; int toPop = envPtr->expandCount - auxPtr->expandTarget; if (toPop > 0) { @@ -3568,12 +3632,12 @@ StartExpanding( if (rangePtr->codeOffset > CurrentOffset(envPtr)) { continue; } - if (rangePtr->numCodeBytes != -1) { + if (rangePtr->numCodeBytes != TCL_INDEX_NONE) { continue; } /* - * Adequate condition: further out loops and further in exceptions + * Adequate condition: loops further out and exceptions further in * don't actually need this information. */ @@ -3583,7 +3647,7 @@ StartExpanding( } /* - * There's now one more expansion being processed on the auxiliary stack. + * One more expansion is now being processed on the auxiliary stack. */ envPtr->expandCount++; @@ -3596,7 +3660,7 @@ StartExpanding( * * Finalizes a loop exception range, binding the registered [break] and * [continue] implementations so that they jump to the correct place. - * Note that this must only be called after *all* the exception range + * This must be called only after *all* the exception range * target offsets have been set. * * --------------------------------------------------------------------- @@ -3628,7 +3692,7 @@ TclFinalizeLoopExceptionRange( } for (i=0 ; i<auxPtr->numContinueTargets ; i++) { site = envPtr->codeStart + auxPtr->continueTargets[i]; - if (rangePtr->continueOffset == -1) { + if (rangePtr->continueOffset == TCL_INDEX_NONE) { int j; /* @@ -3667,27 +3731,23 @@ TclFinalizeLoopExceptionRange( * * TclCreateAuxData -- * - * Procedure that allocates and initializes a new AuxData structure in a + * Allocates and initializes a new AuxData structure in a * CompileEnv's array of compilation auxiliary data records. These * AuxData records hold information created during compilation by * CompileProcs and used by instructions during execution. * * Results: - * Returns the index for the newly created AuxData structure. + * The index of the newly-created AuxData structure in the array. * * Side effects: - * If there is not enough room in the CompileEnv's AuxData array, the - * AuxData array in expanded: a new array of double the size is - * allocated, if envPtr->mallocedAuxDataArray is non-zero the old array - * is freed, and AuxData entries are copied from the old array to the new - * one. - * + * If there is not enough room in the CompileEnv's AuxData array, its size + * is doubled. *---------------------------------------------------------------------- */ int TclCreateAuxData( - ClientData clientData, /* The compilation auxiliary data to store in + void *clientData, /* The compilation auxiliary data to store in * the new aux data record. */ const AuxDataType *typePtr, /* Pointer to the type to attach to this * AuxData */ @@ -3707,19 +3767,19 @@ TclCreateAuxData( */ size_t currBytes = envPtr->auxDataArrayNext * sizeof(AuxData); - int newElems = 2*envPtr->auxDataArrayEnd; + size_t newElems = 2*envPtr->auxDataArrayEnd; size_t newBytes = newElems * sizeof(AuxData); if (envPtr->mallocedAuxDataArray) { envPtr->auxDataArrayPtr = - ckrealloc(envPtr->auxDataArrayPtr, newBytes); + (AuxData *)ckrealloc(envPtr->auxDataArrayPtr, newBytes); } else { /* * envPtr->auxDataArrayPtr isn't a ckalloc'd pointer, so we must * code a ckrealloc equivalent for ourselves. */ - AuxData *newPtr = ckalloc(newBytes); + AuxData *newPtr = (AuxData *)ckalloc(newBytes); memcpy(newPtr, envPtr->auxDataArrayPtr, currBytes); envPtr->auxDataArrayPtr = newPtr; @@ -3769,8 +3829,7 @@ TclInitJumpFixupArray( * * TclExpandJumpFixupArray -- * - * Procedure that uses malloc to allocate more storage for a jump fixup - * array. + * Uses malloc to allocate more storage for a jump fixup array. * * Results: * None. @@ -3797,18 +3856,18 @@ TclExpandJumpFixupArray( */ size_t currBytes = fixupArrayPtr->next * sizeof(JumpFixup); - int newElems = 2*(fixupArrayPtr->end + 1); + size_t newElems = 2*(fixupArrayPtr->end + 1); size_t newBytes = newElems * sizeof(JumpFixup); if (fixupArrayPtr->mallocedArray) { - fixupArrayPtr->fixup = ckrealloc(fixupArrayPtr->fixup, newBytes); + fixupArrayPtr->fixup = (JumpFixup *)ckrealloc(fixupArrayPtr->fixup, newBytes); } else { /* * fixupArrayPtr->fixup isn't a ckalloc'd pointer, so we must code a * ckrealloc equivalent for ourselves. */ - JumpFixup *newPtr = ckalloc(newBytes); + JumpFixup *newPtr = (JumpFixup *)ckalloc(newBytes); memcpy(newPtr, fixupArrayPtr->fixup, currBytes); fixupArrayPtr->fixup = newPtr; @@ -3849,10 +3908,11 @@ TclFreeJumpFixupArray( * * TclEmitForwardJump -- * - * Procedure to emit a two-byte forward jump of kind "jumpType". Since - * the jump may later have to be grown to five bytes if the jump target - * is more than, say, 127 bytes away, this procedure also initializes a - * JumpFixup record with information about the jump. + * Emits a two-byte forward jump of kind "jumpType". Also initializes a + * JumpFixup record with information about the jump. Since may later be + * necessary to increase the size of the jump instruction to five bytes if + * the jump target is more than, say, 127 bytes away. + * * * Results: * None. @@ -3907,16 +3967,17 @@ TclEmitForwardJump( * * TclFixupForwardJump -- * - * Procedure that updates a previously-emitted forward jump to jump a - * specified number of bytes, "jumpDist". If necessary, the jump is grown - * from two to five bytes; this is done if the jump distance is greater - * than "distThreshold" (normally 127 bytes). The jump is described by a - * JumpFixup record previously initialized by TclEmitForwardJump. + * Modifies a previously-emitted forward jump to jump a specified number + * of bytes, "jumpDist". If necessary, the size of the jump instruction is + * increased from two to five bytes. This is done if the jump distance is + * greater than "distThreshold" (normally 127 bytes). The jump is + * described by a JumpFixup record previously initialized by + * TclEmitForwardJump. * * Results: - * 1 if the jump was grown and subsequent instructions had to be moved; - * otherwise 0. This result is returned to allow callers to update any - * additional code offsets they may hold. + * 1 if the jump was grown and subsequent instructions had to be moved, or + * 0 otherwsie. This allows callers to update any additional code offsets + * they may hold. * * Side effects: * The jump may be grown and subsequent instructions moved. If this @@ -3940,7 +4001,7 @@ TclFixupForwardJump( { unsigned char *jumpPc, *p; int firstCmd, lastCmd, firstRange, lastRange, k; - unsigned numBytes; + size_t numBytes; if (jumpDist <= distThreshold) { jumpPc = envPtr->codeStart + jumpFixupPtr->codeOffset; @@ -3959,10 +4020,10 @@ TclFixupForwardJump( } /* - * We must grow the jump then move subsequent instructions down. Note that - * if we expand the space for generated instructions, code addresses might - * change; be careful about updating any of these addresses held in - * variables. + * Increase the size of the jump instruction, and then move subsequent + * instructions down. Expanding the space for generated instructions means + * that code addresses might change. Be careful about updating any of + * these addresses held in variables. */ if ((envPtr->codeNext + 3) > envPtr->codeEnd) { @@ -4009,7 +4070,7 @@ TclFixupForwardJump( switch (rangePtr->type) { case LOOP_EXCEPTION_RANGE: rangePtr->breakOffset += 3; - if (rangePtr->continueOffset != -1) { + if (rangePtr->continueOffset != TCL_INDEX_NONE) { rangePtr->continueOffset += 3; } break; @@ -4046,7 +4107,7 @@ TclFixupForwardJump( * * TclEmitInvoke -- * - * Emit one of the invoke-related instructions, wrapping it if necessary + * Emits one of the invoke-related instructions, wrapping it if necessary * in code that ensures that any break or continue operation passing * through it gets the stack unwinding correct, converting it into an * internal jump if in an appropriate context. @@ -4056,7 +4117,7 @@ TclFixupForwardJump( * * Side effects: * Issues the jump with all correct stack management. May create another - * loop exception range; pointers to ExceptionRange and ExceptionAux + * loop exception range. Pointers to ExceptionRange and ExceptionAux * structures should not be held across this call. * *---------------------------------------------------------------------- @@ -4114,12 +4175,11 @@ TclEmitInvoke( 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). + * If the exceptions is for break or continue handle it with special + * handling exception range so the stack may be correctly unwound. * - * These must be done separately; they can be different (especially for - * calls from inside a [for] increment clause). + * These must be done separately since they can be different, especially + * for calls from inside a [for] increment clause. */ rangePtr = TclGetInnermostExceptionRange(envPtr, TCL_CONTINUE, @@ -4127,7 +4187,7 @@ TclEmitInvoke( if (rangePtr == NULL || rangePtr->type != LOOP_EXCEPTION_RANGE) { auxContinuePtr = NULL; } else if (auxContinuePtr->stackDepth == envPtr->currStackDepth-wordCount - && auxContinuePtr->expandTarget == envPtr->expandCount-expandCount) { + && (auxContinuePtr->expandTarget+expandCount == envPtr->expandCount)) { auxContinuePtr = NULL; } else { continueRange = auxContinuePtr - envPtr->exceptAuxArrayPtr; @@ -4137,8 +4197,8 @@ TclEmitInvoke( if (rangePtr == NULL || rangePtr->type != LOOP_EXCEPTION_RANGE) { auxBreakPtr = NULL; } else if (auxContinuePtr == NULL - && auxBreakPtr->stackDepth == envPtr->currStackDepth-wordCount - && auxBreakPtr->expandTarget == envPtr->expandCount-expandCount) { + && auxBreakPtr->stackDepth+wordCount == envPtr->currStackDepth + && auxBreakPtr->expandTarget+expandCount == envPtr->expandCount) { auxBreakPtr = NULL; } else { breakRange = auxBreakPtr - envPtr->exceptAuxArrayPtr; @@ -4339,16 +4399,16 @@ GetCmdLocEncodingSize( * * EncodeCmdLocMap -- * - * Encode the command location information for some compiled code into a + * Encodes the command location information for some compiled code into a * ByteCode structure. The encoded command location map is stored as - * three adjacent byte sequences. + * three-adjacent-byte sequences. * * Results: - * Pointer to the first byte after the encoded command location + * A pointer to the first byte after the encoded command location * information. * * Side effects: - * The encoded information is stored into the block of memory headed by + * Stores encoded information into the block of memory headed by * codePtr. Also records pointers to the start of the four byte sequences * in fields in codePtr's ByteCode header structure. * @@ -4463,9 +4523,9 @@ EncodeCmdLocMap( * * RecordByteCodeStats -- * - * Accumulates various compilation-related statistics for each newly - * compiled ByteCode. Called by the TclInitByteCodeObj when Tcl is - * compiled with the -DTCL_COMPILE_STATS flag + * Accumulates compilation-related statistics for each newly-compiled + * ByteCode. Called by the TclInitByteCodeObj when Tcl is compiled with + * the -DTCL_COMPILE_STATS flag * * Results: * None. |