diff options
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tclCompCmds.c | 142 | ||||
-rw-r--r-- | generic/tclCompile.c | 25 | ||||
-rw-r--r-- | generic/tclDictObj.c | 4 | ||||
-rw-r--r-- | generic/tclListObj.c | 12 |
4 files changed, 110 insertions, 73 deletions
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index f64d14c..d3a2c9f 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCompCmds.c,v 1.84 2006/08/10 12:15:30 dkf Exp $ + * RCS: @(#) $Id: tclCompCmds.c,v 1.85 2006/11/08 13:47:07 dkf Exp $ */ #include "tclInt.h" @@ -127,8 +127,8 @@ static int PushVarName(Tcl_Interp *interp, * Flags bits used by PushVarName. */ -#define TCL_CREATE_VAR 1 /* Create a compiled local if none is found */ -#define TCL_NO_LARGE_INDEX 2 /* Do not return localIndex value > 255 */ +#define TCL_CREATE_VAR 1 /* Create a compiled local if none is found */ +#define TCL_NO_LARGE_INDEX 2 /* Do not return localIndex value > 255 */ /* * The structures below define the AuxData types defined in this file. @@ -634,7 +634,7 @@ TclCompileDictCmd( intObj = Tcl_NewStringObj(word, numBytes); Tcl_IncrRefCount(intObj); code = Tcl_GetIntFromObj(NULL, intObj, &incrAmount); - Tcl_DecrRefCount(intObj); + TclDecrRefCount(intObj); if (code != TCL_OK) { return TCL_ERROR; } @@ -1391,12 +1391,13 @@ TclCompileForeachCmd( for (j = 0; j < numVars; j++) { CONST char *varName = varvList[loopIndex][j]; int nameChars = strlen(varName); + varListPtr->varIndexes[j] = TclFindCompiledLocal(varName, nameChars, /*create*/ 1, VAR_SCALAR, procPtr); } infoPtr->varLists[loopIndex] = varListPtr; } - infoIndex = TclCreateAuxData((ClientData) infoPtr, &tclForeachInfoType, envPtr); + infoIndex = TclCreateAuxData(infoPtr, &tclForeachInfoType, envPtr); /* * Create an exception record to handle [break] and [continue]. @@ -1545,7 +1546,7 @@ DupForeachInfo( ClientData clientData) /* The foreach command's compilation auxiliary * data to duplicate. */ { - register ForeachInfo *srcPtr = (ForeachInfo *) clientData; + register ForeachInfo *srcPtr = clientData; ForeachInfo *dupPtr; register ForeachVarList *srcListPtr, *dupListPtr; int numLists = srcPtr->numLists; @@ -1568,7 +1569,7 @@ DupForeachInfo( } dupPtr->varLists[i] = dupListPtr; } - return (ClientData) dupPtr; + return dupPtr; } /* @@ -1595,7 +1596,7 @@ FreeForeachInfo( ClientData clientData) /* The foreach command's compilation auxiliary * data to free. */ { - register ForeachInfo *infoPtr = (ForeachInfo *) clientData; + register ForeachInfo *infoPtr = clientData; register ForeachVarList *listPtr; int numLists = infoPtr->numLists; register int i; @@ -1640,15 +1641,16 @@ TclCompileIfCmd( * determined. */ Tcl_Token *tokenPtr, *testTokenPtr; int jumpFalseDist; - int jumpIndex = 0; /* avoid compiler warning. */ + int jumpIndex = 0; /* Avoid compiler warning. */ int numWords, wordIdx, numBytes, j, code; CONST char *word; int savedStackDepth = envPtr->currStackDepth; /* Saved stack depth at the start of the first * test; the envPtr current depth is restored * to this value at the start of each test. */ - int realCond = 1; /* set to 0 for static conditions: "if 0 {..}" */ - int boolVal; /* value of static condition */ + int realCond = 1; /* Set to 0 for static conditions: + * "if 0 {..}" */ + int boolVal; /* Value of static condition */ int compileScripts = 1; /* @@ -1716,7 +1718,7 @@ TclCompileIfCmd( testTokenPtr[1].size); Tcl_IncrRefCount(boolObj); code = Tcl_GetBooleanFromObj(NULL, boolObj, &boolVal); - Tcl_DecrRefCount(boolObj); + TclDecrRefCount(boolObj); if (code == TCL_OK) { /* * A static condition @@ -1971,7 +1973,7 @@ TclCompileIncrCmd( Tcl_Obj *intObj = Tcl_NewStringObj(word, numBytes); Tcl_IncrRefCount(intObj); code = Tcl_GetIntFromObj(NULL, intObj, &immValue); - Tcl_DecrRefCount(intObj); + TclDecrRefCount(intObj); if ((code == TCL_OK) && (-127 <= immValue) && (immValue <= 127)) { haveImmValue = 1; } @@ -1981,7 +1983,7 @@ TclCompileIncrCmd( } else { CompileTokens(envPtr, incrTokenPtr, interp); } - } else { /* no incr amount given so use 1 */ + } else { /* No incr amount given so use 1 */ haveImmValue = 1; } @@ -2021,7 +2023,7 @@ TclCompileIncrCmd( } } } - } else { /* non-simple variable name */ + } else { /* Non-simple variable name */ if (haveImmValue) { TclEmitInstInt1(INST_INCR_STK_IMM, immValue, envPtr); } else { @@ -2234,7 +2236,7 @@ TclCompileLassignCmd( * Generate code to leave the rest of the list on the stack. */ TclEmitInstInt4(INST_LIST_RANGE_IMM, idx, envPtr); - TclEmitInt4(-2, envPtr); /* -2 == "end" */ + TclEmitInt4(-2, envPtr); /* -2 == "end" */ return TCL_OK; } @@ -2466,24 +2468,29 @@ TclCompileLlengthCmd( int TclCompileLsetCmd( - Tcl_Interp* interp, /* Tcl interpreter for error reporting */ - Tcl_Parse* parsePtr, /* Points to a parse structure for the + Tcl_Interp *interp, /* Tcl interpreter for error reporting */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the * command */ - CompileEnv* envPtr) /* Holds the resulting instructions */ + CompileEnv *envPtr) /* Holds the resulting instructions */ { int tempDepth; /* Depth used for emitting one part of the * code burst. */ - Tcl_Token* varTokenPtr; /* Pointer to the Tcl_Token representing the + Tcl_Token *varTokenPtr; /* Pointer to the Tcl_Token representing the * parse of the variable name */ int localIndex; /* Index of var in local var table */ int simpleVarName; /* Flag == 1 if var name is simple */ int isScalar; /* Flag == 1 if scalar, 0 if array */ int i; - /* Check argument count */ + /* + * Check argument count. + */ if (parsePtr->numWords < 3) { - /* Fail at run time, not in compilation */ + /* + * Fail at run time, not in compilation. + */ + return TCL_ERROR; } @@ -2615,10 +2622,10 @@ TclCompileLsetCmd( int TclCompileRegexpCmd( - Tcl_Interp* interp, /* Tcl interpreter for error reporting */ - Tcl_Parse* parsePtr, /* Points to a parse structure for the + Tcl_Interp *interp, /* Tcl interpreter for error reporting */ + Tcl_Parse *parsePtr, /* Points to a parse structure for the * command */ - CompileEnv* envPtr) /* Holds the resulting instructions */ + CompileEnv *envPtr) /* Holds the resulting instructions */ { Tcl_Token *varTokenPtr; /* Pointer to the Tcl_Token representing the * parse of the RE or string */ @@ -2648,7 +2655,10 @@ TclCompileRegexpCmd( for (i = 1; i < parsePtr->numWords - 2; i++) { varTokenPtr = TokenAfter(varTokenPtr); if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { - /* Not a simple string - punt to runtime. */ + /* + * Not a simple string - punt to runtime. + */ + return TCL_ERROR; } str = (char *) varTokenPtr[1].start; @@ -2659,13 +2669,19 @@ TclCompileRegexpCmd( } else if ((len > 1) && (strncmp(str,"-nocase",(unsigned)len) == 0)) { nocase = 1; } else { - /* Not an option we recognize. */ + /* + * Not an option we recognize. + */ + return TCL_ERROR; } } if ((parsePtr->numWords - i) != 2) { - /* We don't support capturing to variables */ + /* + * We don't support capturing to variables. + */ + return TCL_ERROR; } @@ -2878,7 +2894,7 @@ TclCompileReturnCmd( &returnOpts, &code, &level); cleanup: while (--objc >= 0) { - Tcl_DecrRefCount(objv[objc]); + TclDecrRefCount(objv[objc]); } if (numOptionWords > NUM_STATIC_OBJS) { ckfree((char *)objv); @@ -2917,8 +2933,10 @@ TclCompileReturnCmd( /* * We have default return options and we're in a proc ... */ + int index = envPtr->exceptArrayNext - 1; int enclosingCatch = 0; + while (index >= 0) { ExceptionRange range = envPtr->exceptArrayPtr[index]; if ((range.type == CATCH_EXCEPTION_RANGE) @@ -3013,7 +3031,7 @@ TclCompileSetCmd( if (isScalar) { if (localIndex < 0) { TclEmitOpcode((isAssignment? - INST_STORE_SCALAR_STK : INST_LOAD_SCALAR_STK), envPtr); + INST_STORE_SCALAR_STK : INST_LOAD_SCALAR_STK), envPtr); } else if (localIndex <= 255) { TclEmitInstInt1((isAssignment? INST_STORE_SCALAR1 : INST_LOAD_SCALAR1), @@ -3094,7 +3112,10 @@ TclCompileStringCmd( }; if (parsePtr->numWords < 2) { - /* Fail at run time, not in compilation */ + /* + * Fail at run time, not in compilation. + */ + return TCL_ERROR; } opTokenPtr = TokenAfter(parsePtr->tokenPtr); @@ -3137,7 +3158,10 @@ TclCompileStringCmd( case STR_INDEX: if (parsePtr->numWords != 4) { - /* Fail at run time, not in compilation */ + /* + * Fail at run time, not in compilation. + */ + return TCL_ERROR; } @@ -3157,7 +3181,10 @@ TclCompileStringCmd( CONST char *str; if (parsePtr->numWords < 4 || parsePtr->numWords > 5) { - /* Fail at run time, not in compilation */ + /* + * Fail at run time, not in compilation. + */ + return TCL_ERROR; } @@ -3171,7 +3198,10 @@ TclCompileStringCmd( strncmp(str, "-nocase", (size_t) length) == 0) { nocase = 1; } else { - /* Fail at run time, not in compilation */ + /* + * Fail at run time, not in compilation. + */ + return TCL_ERROR; } varTokenPtr = TokenAfter(varTokenPtr); @@ -3187,10 +3217,11 @@ TclCompileStringCmd( * -nocase was specified, we can't do this because * INST_STR_EQ has no support for nocase. */ + Tcl_Obj *copy = Tcl_NewStringObj(str, length); Tcl_IncrRefCount(copy); exactMatch = TclMatchIsTrivial(Tcl_GetString(copy)); - Tcl_DecrRefCount(copy); + TclDecrRefCount(copy); } PushLiteral(envPtr, str, length); } else { @@ -3208,7 +3239,10 @@ TclCompileStringCmd( } case STR_LENGTH: if (parsePtr->numWords != 3) { - /* Fail at run time, not in compilation */ + /* + * Fail at run time, not in compilation. + */ + return TCL_ERROR; } @@ -3217,9 +3251,11 @@ TclCompileStringCmd( * Here someone is asking for the length of a static string. Just * push the actual character (not byte) length. */ + char buf[TCL_INTEGER_SPACE]; int len = Tcl_NumUtfChars(varTokenPtr[1].start, varTokenPtr[1].size); + len = sprintf(buf, "%d", len); PushLiteral(envPtr, buf, len); return TCL_OK; @@ -3579,8 +3615,7 @@ TclCompileSwitchCmd( jtPtr = (JumptableInfo *) ckalloc(sizeof(JumptableInfo)); Tcl_InitHashTable(&jtPtr->hashTable, TCL_STRING_KEYS); - infoIndex = TclCreateAuxData((ClientData) jtPtr, - &tclJumptableInfoType, envPtr); + infoIndex = TclCreateAuxData(jtPtr, &tclJumptableInfoType, envPtr); finalFixups = (int *) ckalloc(sizeof(int) * (numWords/2)); foundDefault = 0; mustGenerate = 1; @@ -3806,6 +3841,7 @@ TclCompileSwitchCmd( if (contFixIndex != -1) { int j; + for (j=0 ; j<contFixCount ; j++) { fixupTargetArray[contFixIndex+j] = CurrentOffset(envPtr); } @@ -3869,6 +3905,7 @@ TclCompileSwitchCmd( if (TclFixupForwardJump(envPtr, &fixupArray[i], fixupTargetArray[i] - fixupArray[i].codeOffset, 127)) { int j; + for (j=i-1 ; j>=0 ; j--) { if (fixupTargetArray[j] > fixupArray[i].codeOffset) { fixupTargetArray[j] += 3; @@ -3906,7 +3943,7 @@ static ClientData DupJumptableInfo( ClientData clientData) { - JumptableInfo *jtPtr = (JumptableInfo *) clientData; + JumptableInfo *jtPtr = clientData; JumptableInfo *newJtPtr = (JumptableInfo *) ckalloc(sizeof(JumptableInfo)); Tcl_HashEntry *hPtr, *newHPtr; @@ -3920,14 +3957,14 @@ DupJumptableInfo( Tcl_GetHashKey(&jtPtr->hashTable, hPtr), &isNew); Tcl_SetHashValue(newHPtr, Tcl_GetHashValue(hPtr)); } - return (ClientData) newJtPtr; + return newJtPtr; } static void FreeJumptableInfo( ClientData clientData) { - JumptableInfo *jtPtr = (JumptableInfo *) clientData; + JumptableInfo *jtPtr = clientData; Tcl_DeleteHashTable(&jtPtr->hashTable); ckfree((char *) jtPtr); @@ -3942,10 +3979,10 @@ FreeJumptableInfo( * command. The command itself is *not* compiled. * * Results: - * Always returns TCL_ERROR. + * Always returns TCL_ERROR. * * Side effects: - * Indexed local variables are added to the environment. + * Indexed local variables are added to the environment. * *---------------------------------------------------------------------- */ @@ -4062,7 +4099,7 @@ TclCompileWhileCmd( boolObj = Tcl_NewStringObj(testTokenPtr[1].start, testTokenPtr[1].size); Tcl_IncrRefCount(boolObj); code = Tcl_GetBooleanFromObj(NULL, boolObj, &boolVal); - Tcl_DecrRefCount(boolObj); + TclDecrRefCount(boolObj); if (code == TCL_OK) { if (boolVal) { /* @@ -4104,7 +4141,7 @@ TclCompileWhileCmd( if (loopMayEnd) { TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpEvalCondFixup); - testCodeOffset = 0; /* avoid compiler warning */ + testCodeOffset = 0; /* Avoid compiler warning */ } else { testCodeOffset = CurrentOffset(envPtr); } @@ -4195,9 +4232,9 @@ PushVarName( Tcl_Token *varTokenPtr, /* Points to a variable token. */ CompileEnv *envPtr, /* Holds resulting instructions. */ int flags, /* TCL_CREATE_VAR or TCL_NO_LARGE_INDEX */ - int *localIndexPtr, /* must not be NULL */ - int *simpleVarNamePtr, /* must not be NULL */ - int *isScalarPtr) /* must not be NULL */ + int *localIndexPtr, /* Must not be NULL */ + int *simpleVarNamePtr, /* Must not be NULL */ + int *isScalarPtr) /* Must not be NULL */ { register CONST char *p; CONST char *name, *elName; @@ -4326,7 +4363,7 @@ PushVarName( * Copy the remaining tokens. */ - memcpy((void *) (elemTokenPtr+1), (void *) (&varTokenPtr[2]), + memcpy(elemTokenPtr+1, varTokenPtr+2, (n-1) * sizeof(Tcl_Token)); } else { /* @@ -4364,7 +4401,10 @@ PushVarName( /*flags*/ ((elName==NULL)? VAR_SCALAR : VAR_ARRAY), envPtr->procPtr); if ((flags & TCL_NO_LARGE_INDEX) && (localIndex > 255)) { - /* we'll push the name */ + /* + * We'll push the name. + */ + localIndex = -1; } } @@ -4395,7 +4435,7 @@ PushVarName( ++varTokenPtr[removedParen].size; } if (allocedTokens) { - ckfree((char *) elemTokenPtr); + ckfree((char *) elemTokenPtr); } *localIndexPtr = localIndex; *simpleVarNamePtr = simpleVarName; diff --git a/generic/tclCompile.c b/generic/tclCompile.c index ddaee64..2938698 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCompile.c,v 1.98 2006/09/30 17:56:46 msofer Exp $ + * RCS: @(#) $Id: tclCompile.c,v 1.99 2006/11/08 13:47:07 dkf Exp $ */ #include "tclInt.h" @@ -1775,7 +1775,7 @@ TclInitByteCodeObj( p += sizeof(ByteCode); codePtr->codeStart = p; - memcpy((void *) p, (void *) envPtr->codeStart, (size_t) codeBytes); + memcpy(p, envPtr->codeStart, (size_t) codeBytes); p += TCL_ALIGN(codeBytes); /* align object array */ codePtr->objArrayPtr = (Tcl_Obj **) p; @@ -1786,8 +1786,7 @@ TclInitByteCodeObj( p += TCL_ALIGN(objArrayBytes); /* align exception range array */ if (exceptArrayBytes > 0) { codePtr->exceptArrayPtr = (ExceptionRange *) p; - memcpy((void *) p, (void *) envPtr->exceptArrayPtr, - (size_t) exceptArrayBytes); + memcpy(p, envPtr->exceptArrayPtr, (size_t) exceptArrayBytes); } else { codePtr->exceptArrayPtr = NULL; } @@ -1795,8 +1794,7 @@ TclInitByteCodeObj( p += TCL_ALIGN(exceptArrayBytes); /* align AuxData array */ if (auxDataArrayBytes > 0) { codePtr->auxDataArrayPtr = (AuxData *) p; - memcpy((void *) p, (void *) envPtr->auxDataArrayPtr, - (size_t) auxDataArrayBytes); + memcpy(p, envPtr->auxDataArrayPtr, (size_t) auxDataArrayBytes); } else { codePtr->auxDataArrayPtr = NULL; } @@ -1884,6 +1882,7 @@ TclFindCompiledLocal( if (name != NULL) { int localCt = procPtr->numCompiledLocals; + localPtr = procPtr->firstLocalPtr; for (i = 0; i < localCt; i++) { if (!TclIsVarTemporary(localPtr)) { @@ -1923,7 +1922,7 @@ TclFindCompiledLocal( localPtr->resolveInfo = NULL; if (name != NULL) { - memcpy((void *) localPtr->name, (void *) name, (size_t) nameBytes); + memcpy(localPtr->name, name, (size_t) nameBytes); } localPtr->name[nameBytes] = '\0'; procPtr->numCompiledLocals++; @@ -1974,7 +1973,7 @@ TclExpandCodeArray( * mark new code array as malloced. */ - memcpy((void *) newPtr, (void *) envPtr->codeStart, currBytes); + memcpy(newPtr, envPtr->codeStart, currBytes); if (envPtr->mallocedCodeArray) { ckfree((char *) envPtr->codeStart); } @@ -2038,7 +2037,7 @@ EnterCmdStartData( * location array if needed, and mark new array as malloced. */ - memcpy((void *) newPtr, (void *) envPtr->cmdMapPtr, currBytes); + memcpy(newPtr, envPtr->cmdMapPtr, currBytes); if (envPtr->mallocedCmdMap) { ckfree((char *) envPtr->cmdMapPtr); } @@ -2155,7 +2154,7 @@ TclCreateExceptRange( * array if needed, and mark the new ExceptionRange array as malloced. */ - memcpy((void *) newPtr, (void *) envPtr->exceptArrayPtr, currBytes); + memcpy(newPtr, envPtr->exceptArrayPtr, currBytes); if (envPtr->mallocedExceptArray) { ckfree((char *) envPtr->exceptArrayPtr); } @@ -2230,7 +2229,7 @@ TclCreateAuxData( * needed, and mark the new AuxData array as malloced. */ - memcpy((void *) newPtr, (void *) envPtr->auxDataArrayPtr, currBytes); + memcpy(newPtr, envPtr->auxDataArrayPtr, currBytes); if (envPtr->mallocedAuxDataArray) { ckfree((char *) envPtr->auxDataArrayPtr); } @@ -2317,11 +2316,11 @@ TclExpandJumpFixupArray( * the new array as malloced. */ - memcpy((void *) newPtr, (void *) fixupArrayPtr->fixup, currBytes); + memcpy(newPtr, fixupArrayPtr->fixup, currBytes); if (fixupArrayPtr->mallocedArray) { ckfree((char *) fixupArrayPtr->fixup); } - fixupArrayPtr->fixup = (JumpFixup *) newPtr; + fixupArrayPtr->fixup = newPtr; fixupArrayPtr->end = newElems; fixupArrayPtr->mallocedArray = 1; } diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index de469f9..e04d956 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclDictObj.c,v 1.43 2006/11/02 15:58:08 dgp Exp $ + * RCS: @(#) $Id: tclDictObj.c,v 1.44 2006/11/08 13:47:07 dkf Exp $ */ #include "tclInt.h" @@ -467,7 +467,7 @@ SetDictFromAny( s = ckalloc((unsigned) elemSize + 1); if (hasBrace) { - memcpy((void *) s, (void *) elemStart, (size_t) elemSize); + memcpy(s, elemStart, (size_t) elemSize); s[elemSize] = 0; } else { elemSize = TclCopyAndCollapse(elemSize, elemStart, s); diff --git a/generic/tclListObj.c b/generic/tclListObj.c index 3329dae..9f15cd2 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclListObj.c,v 1.33 2006/08/10 12:15:31 dkf Exp $ + * RCS: @(#) $Id: tclListObj.c,v 1.34 2006/11/08 13:47:07 dkf Exp $ */ #include "tclInt.h" @@ -859,8 +859,7 @@ Tcl_ListObjReplace( */ if (first > 0) { - memcpy((VOID *) elemPtrs, (VOID *) oldPtrs, - (size_t) (first * sizeof(Tcl_Obj *))); + memcpy(elemPtrs, oldPtrs, (size_t) first * sizeof(Tcl_Obj *)); } /* @@ -880,9 +879,8 @@ Tcl_ListObjReplace( start = (first + count); numAfterLast = (numElems - start); if (numAfterLast > 0) { - memcpy((VOID *) &(elemPtrs[first + objc]), - (VOID *) &(oldPtrs[start]), - (size_t) (numAfterLast * sizeof(Tcl_Obj *))); + memcpy(elemPtrs + first + objc, oldPtrs + start, + (size_t) numAfterLast * sizeof(Tcl_Obj *)); } ckfree((char *) oldListRepPtr); @@ -1563,7 +1561,7 @@ SetListFromAny( s = ckalloc((unsigned) elemSize + 1); if (hasBrace) { - memcpy((void *) s, (void *) elemStart, (size_t) elemSize); + memcpy(s, elemStart, (size_t) elemSize); s[elemSize] = 0; } else { elemSize = TclCopyAndCollapse(elemSize, elemStart, s); |