diff options
Diffstat (limited to 'generic')
59 files changed, 642 insertions, 483 deletions
diff --git a/generic/tcl.decls b/generic/tcl.decls index 42438c1..b3c3ffc 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -2325,7 +2325,7 @@ declare 630 { # ----- BASELINE -- FOR -- 8.6.0 ----- # -declare 660 { +declare 673 { void TclUnusedStubEntry(void) } diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c index bf86b90..42c0c47 100644 --- a/generic/tclAssembly.c +++ b/generic/tclAssembly.c @@ -1975,7 +1975,7 @@ CreateMirrorJumpTable( * table. */ int i; - if (Tcl_ListObjGetElements(interp, jumps, &objc, &objv) != TCL_OK) { + if (TclListObjGetElements(interp, jumps, &objc, &objv) != TCL_OK) { return TCL_ERROR; } if (objc % 2 != 0) { diff --git a/generic/tclBasic.c b/generic/tclBasic.c index fb85241..33a96eb 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -517,7 +517,7 @@ Tcl_CreateInterp(void) iPtr->result = iPtr->resultSpace; iPtr->freeProc = NULL; iPtr->errorLine = 0; - iPtr->objResultPtr = Tcl_NewObj(); + TclNewObj(iPtr->objResultPtr); Tcl_IncrRefCount(iPtr->objResultPtr); iPtr->handle = TclHandleCreate(iPtr); iPtr->globalNsPtr = NULL; @@ -606,7 +606,7 @@ Tcl_CreateInterp(void) iPtr->activeInterpTracePtr = NULL; iPtr->assocData = NULL; iPtr->execEnvPtr = NULL; /* Set after namespaces initialized. */ - iPtr->emptyObjPtr = Tcl_NewObj(); + TclNewObj(iPtr->emptyObjPtr); /* Another empty object. */ Tcl_IncrRefCount(iPtr->emptyObjPtr); iPtr->resultSpace[0] = 0; @@ -671,7 +671,7 @@ Tcl_CreateInterp(void) * TIP #285, Script cancellation support. */ - iPtr->asyncCancelMsg = Tcl_NewObj(); + TclNewObj(iPtr->asyncCancelMsg); cancelInfo = (CancelInfo *)ckalloc(sizeof(CancelInfo)); cancelInfo->interp = interp; @@ -2652,7 +2652,7 @@ TclRenameCommand( } cmdNsPtr = cmdPtr->nsPtr; - oldFullName = Tcl_NewObj(); + TclNewObj(oldFullName); Tcl_IncrRefCount(oldFullName); Tcl_GetCommandFullName(interp, cmd, oldFullName); @@ -3551,7 +3551,9 @@ Tcl_CreateMathFunc( data->proc = proc; data->numArgs = numArgs; data->argTypes = (Tcl_ValueType *)ckalloc(numArgs * sizeof(Tcl_ValueType)); - memcpy(data->argTypes, argTypes, numArgs * sizeof(Tcl_ValueType)); + if ((numArgs > 0) && (argTypes != NULL)) { + memcpy(data->argTypes, argTypes, numArgs * sizeof(Tcl_ValueType)); + } data->clientData = clientData; Tcl_DStringInit(&bigName); @@ -3855,7 +3857,7 @@ Tcl_ListMathFuncs( if (TCL_OK == Tcl_EvalObjEx(interp, script, 0)) { result = Tcl_DuplicateObj(Tcl_GetObjResult(interp)); } else { - result = Tcl_NewObj(); + TclNewObj(result); } Tcl_DecrRefCount(script); Tcl_RestoreInterpState(interp, state); @@ -4713,7 +4715,7 @@ TEOV_NotFound( * itself. */ - Tcl_ListObjGetElements(NULL, currNsPtr->unknownHandlerPtr, + TclListObjGetElements(NULL, currNsPtr->unknownHandlerPtr, &handlerObjc, &handlerObjv); newObjc = objc + handlerObjc; newObjv = (Tcl_Obj **)TclStackAlloc(interp, sizeof(Tcl_Obj *) * newObjc); @@ -5320,7 +5322,7 @@ TclEvalEx( int numElements; Tcl_Obj **elements, *temp = copy[wordIdx]; - Tcl_ListObjGetElements(NULL, temp, &numElements, + TclListObjGetElements(NULL, temp, &numElements, &elements); objectsUsed += numElements; while (numElements--) { @@ -7781,15 +7783,15 @@ ExprRandFunc( * take into consideration the thread this interp is running in. */ - iPtr->randSeed = TclpGetClicks() + (PTR2INT(Tcl_GetCurrentThread())<<12); + iPtr->randSeed = TclpGetClicks() + PTR2UINT(Tcl_GetCurrentThread())*4093U; /* * Make sure 1 <= randSeed <= (2^31) - 2. See below. */ - iPtr->randSeed &= (unsigned long) 0x7FFFFFFF; - if ((iPtr->randSeed == 0) || (iPtr->randSeed == 0x7FFFFFFF)) { - iPtr->randSeed ^= 123459876; + iPtr->randSeed &= 0x7FFFFFFFL; + if ((iPtr->randSeed == 0) || (iPtr->randSeed == 0x7FFFFFFFL)) { + iPtr->randSeed ^= 123459876L; } } @@ -8495,7 +8497,7 @@ TclNRTailcallEval( int objc; Tcl_Obj **objv; - Tcl_ListObjGetElements(interp, listPtr, &objc, &objv); + TclListObjGetElements(interp, listPtr, &objc, &objv); nsObjPtr = objv[0]; if (result == TCL_OK) { diff --git a/generic/tclBinary.c b/generic/tclBinary.c index 0f8f77e..703c35b 100644 --- a/generic/tclBinary.c +++ b/generic/tclBinary.c @@ -69,7 +69,7 @@ static void UpdateStringOfByteArray(Tcl_Obj *listPtr); static void DeleteScanNumberCache(Tcl_HashTable *numberCachePtr); static int NeedReversing(int format); static void CopyNumber(const void *from, void *to, - unsigned length, int type); + unsigned int length, int type); /* Binary ensemble commands */ static Tcl_ObjCmdProc BinaryFormatCmd; static Tcl_ObjCmdProc BinaryScanCmd; @@ -179,17 +179,18 @@ const Tcl_ObjType tclByteArrayType = { */ typedef struct ByteArray { - int used; /* The number of bytes used in the byte + unsigned int used; /* The number of bytes used in the byte * array. */ - int allocated; /* The amount of space actually allocated - * minus 1 byte. */ - unsigned char bytes[TCLFLEXARRAY]; /* The array of bytes. The actual size of this + unsigned int allocated; /* The number of bytes allocated for storage + * of the following "bytes" field. */ + unsigned char bytes[TCLFLEXARRAY]; + /* The array of bytes. The actual size of this * field depends on the 'allocated' field * above. */ } ByteArray; #define BYTEARRAY_SIZE(len) \ - ((unsigned) (TclOffset(ByteArray, bytes) + (len))) + (((unsigned)TclOffset(ByteArray, bytes) + (len))) #define GET_BYTEARRAY(objPtr) \ ((ByteArray *) (objPtr)->internalRep.twoPtrValue.ptr1) #define SET_BYTEARRAY(objPtr, baPtr) \ @@ -401,9 +402,11 @@ Tcl_SetByteArrayLength( if (objPtr->typePtr != &tclByteArrayType) { SetByteArrayFromAny(NULL, objPtr); } - + if (length < 0) { + length = 0; + } byteArrayPtr = GET_BYTEARRAY(objPtr); - if (length > byteArrayPtr->allocated) { + if ((unsigned int)length > byteArrayPtr->allocated) { byteArrayPtr = (ByteArray *)ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(length)); byteArrayPtr->allocated = length; SET_BYTEARRAY(objPtr, byteArrayPtr); @@ -507,7 +510,7 @@ DupByteArrayInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { - int length; + unsigned int length; ByteArray *srcArrayPtr, *copyArrayPtr; srcArrayPtr = GET_BYTEARRAY(srcPtr); @@ -549,7 +552,7 @@ UpdateStringOfByteArray( Tcl_Obj *objPtr) /* ByteArray object whose string rep to * update. */ { - int i, length, size; + unsigned int i, length, size; unsigned char *src; char *dst; ByteArray *byteArrayPtr; @@ -563,16 +566,16 @@ UpdateStringOfByteArray( */ size = length; - for (i = 0; i < length && size >= 0; i++) { + for (i = 0; i < length && size <= INT_MAX; i++) { if ((src[i] == 0) || (src[i] > 127)) { size++; } } - if (size < 0) { + if (size > INT_MAX) { Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } - dst = (char *)ckalloc(size + 1); + dst = (char *)ckalloc(size + 1U); objPtr->bytes = dst; objPtr->length = size; @@ -613,7 +616,7 @@ TclAppendBytesToByteArray( int len) { ByteArray *byteArrayPtr; - int needed; + unsigned int needed; if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object","TclAppendBytesToByteArray"); @@ -634,7 +637,7 @@ TclAppendBytesToByteArray( } byteArrayPtr = GET_BYTEARRAY(objPtr); - if (len > INT_MAX - byteArrayPtr->used) { + if ((unsigned int)len > INT_MAX - byteArrayPtr->used) { Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } @@ -645,7 +648,7 @@ TclAppendBytesToByteArray( if (needed > byteArrayPtr->allocated) { ByteArray *ptr = NULL; - int attempt; + unsigned int attempt; if (needed <= INT_MAX/2) { /* @@ -927,7 +930,7 @@ BinaryFormatCmd( * bytes and filling with nulls. */ - resultPtr = Tcl_NewObj(); + TclNewObj(resultPtr); buffer = Tcl_SetByteArrayLength(resultPtr, length); memset(buffer, 0, length); @@ -1360,7 +1363,7 @@ BinaryScanCmd( } } src = buffer + offset; - valuePtr = Tcl_NewObj(); + TclNewObj(valuePtr); Tcl_SetObjLength(valuePtr, count); dest = TclGetString(valuePtr); @@ -1415,7 +1418,7 @@ BinaryScanCmd( } } src = buffer + offset; - valuePtr = Tcl_NewObj(); + TclNewObj(valuePtr); Tcl_SetObjLength(valuePtr, count); dest = TclGetString(valuePtr); @@ -1499,7 +1502,7 @@ BinaryScanCmd( if ((length - offset) < (count * size)) { goto done; } - valuePtr = Tcl_NewObj(); + TclNewObj(valuePtr); src = buffer + offset; for (i = 0; i < count; i++) { elementPtr = ScanNumber(src, cmd, flags, &numberCachePtr); @@ -1649,7 +1652,7 @@ GetFormatSpec( (*formatPtr)++; *countPtr = BINARY_ALL; } else if (isdigit(UCHAR(**formatPtr))) { /* INTL: digit */ - unsigned long int count; + unsigned long count; errno = 0; count = strtoul(*formatPtr, (char **) formatPtr, 10); @@ -2102,12 +2105,12 @@ ScanNumber( value = (long) (buffer[0] + (buffer[1] << 8) + (buffer[2] << 16) - + (((long)buffer[3]) << 24)); + + (((unsigned long)buffer[3]) << 24)); } else { value = (long) (buffer[3] + (buffer[2] << 8) + (buffer[1] << 16) - + (((long) buffer[0]) << 24)); + + (((unsigned long) buffer[0]) << 24)); } /* @@ -2521,7 +2524,7 @@ BinaryEncode64( maxlen = 0; } - resultObj = Tcl_NewObj(); + TclNewObj(resultObj); data = Tcl_GetByteArrayFromObj(objv[objc - 1], &count); if (count > 0) { unsigned char *cursor = NULL; @@ -2599,7 +2602,8 @@ BinaryEncodeUu( { Tcl_Obj *resultObj; unsigned char *data, *start, *cursor; - int offset, count, rawLength, n, i, j, bits, index; + int offset, count, rawLength, i, j, bits, index; + unsigned int n; int lineLength = 61; const unsigned char SingleNewline[] = { UCHAR('\n') }; const unsigned char *wrapchar = SingleNewline; diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c index 48832d9..20285eb 100644 --- a/generic/tclCkalloc.c +++ b/generic/tclCkalloc.c @@ -41,7 +41,7 @@ typedef struct MemTag { * last field in the structure. */ } MemTag; -#define TAG_SIZE(bytesInString) ((unsigned) ((TclOffset(MemTag, string) + 1) + bytesInString)) +#define TAG_SIZE(bytesInString) ((unsigned) ((TclOffset(MemTag, string) + 1U) + (bytesInString))) static MemTag *curTagPtr = NULL;/* Tag to use in all future mem_headers (set * by "memory tag" command). */ diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index da3fc8b..c94abbd 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -394,7 +394,7 @@ Tcl_RegexpObjCmd( newPtr = Tcl_NewListObj(2, objs); } else { - if (i <= info.nsubs) { + if ((i <= info.nsubs) && (info.matches[i].end > 0)) { newPtr = Tcl_GetRange(objPtr, offset + info.matches[i].start, offset + info.matches[i].end - 1); @@ -4136,7 +4136,7 @@ Tcl_ThrowObjCmd( * The type must be a list of at least length 1. */ - if (Tcl_ListObjLength(interp, objv[1], &len) != TCL_OK) { + if (TclListObjLength(interp, objv[1], &len) != TCL_OK) { return TCL_ERROR; } else if (len < 1) { Tcl_SetObjResult(interp, Tcl_NewStringObj( @@ -4921,7 +4921,7 @@ TclNRTryObjCmd( return TCL_ERROR; } code = 1; - if (Tcl_ListObjLength(NULL, objv[i+1], &dummy) != TCL_OK) { + if (TclListObjLength(NULL, objv[i+1], &dummy) != TCL_OK) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "bad prefix '%s': must be a list", Tcl_GetString(objv[i+1]))); @@ -4933,7 +4933,7 @@ TclNRTryObjCmd( info[2] = objv[i+1]; commonHandler: - if (Tcl_ListObjLength(interp, objv[i+2], &dummy) != TCL_OK) { + if (TclListObjLength(interp, objv[i+2], &dummy) != TCL_OK) { Tcl_DecrRefCount(handlersObj); return TCL_ERROR; } @@ -5083,11 +5083,11 @@ TryPostBody( int found = 0; Tcl_Obj **handlers, **info; - Tcl_ListObjGetElements(NULL, handlersObj, &numHandlers, &handlers); + TclListObjGetElements(NULL, handlersObj, &numHandlers, &handlers); for (i=0 ; i<numHandlers ; i++) { Tcl_Obj *handlerBodyObj; - Tcl_ListObjGetElements(NULL, handlers[i], &dummy, &info); + TclListObjGetElements(NULL, handlers[i], &dummy, &info); if (!found) { Tcl_GetIntFromObj(NULL, info[1], &code); if (code != result) { @@ -5108,8 +5108,8 @@ TryPostBody( TclNewLiteralStringObj(errorCodeName, "-errorcode"); Tcl_DictObjGet(NULL, options, errorCodeName, &errcode); Tcl_DecrRefCount(errorCodeName); - Tcl_ListObjGetElements(NULL, info[2], &len1, &bits1); - if (Tcl_ListObjGetElements(NULL, errcode, &len2, + TclListObjGetElements(NULL, info[2], &len1, &bits1); + if (TclListObjGetElements(NULL, errcode, &len2, &bits2) != TCL_OK) { continue; } @@ -5149,7 +5149,7 @@ TryPostBody( Tcl_ResetResult(interp); result = TCL_ERROR; - Tcl_ListObjLength(NULL, info[3], &dummy); + TclListObjLength(NULL, info[3], &dummy); if (dummy > 0) { Tcl_Obj *varName; diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index c8970ce..0f52338 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -311,10 +311,10 @@ TclCompileArraySetCmd( varTokenPtr = TokenAfter(parsePtr->tokenPtr); dataTokenPtr = TokenAfter(varTokenPtr); - literalObj = Tcl_NewObj(); + TclNewObj(literalObj); isDataLiteral = TclWordKnownAtCompileTime(dataTokenPtr, literalObj); isDataValid = (isDataLiteral - && Tcl_ListObjLength(NULL, literalObj, &len) == TCL_OK); + && TclListObjLength(NULL, literalObj, &len) == TCL_OK); isDataEven = (isDataValid && (len & 1) == 0); /* @@ -890,10 +890,10 @@ TclCompileConcatCmd( * implement with a simple push. */ - listObj = Tcl_NewObj(); + TclNewObj(listObj); for (i = 1, tokenPtr = parsePtr->tokenPtr; i < parsePtr->numWords; i++) { tokenPtr = TokenAfter(tokenPtr); - objPtr = Tcl_NewObj(); + TclNewObj(objPtr); if (!TclWordKnownAtCompileTime(tokenPtr, objPtr)) { Tcl_DecrRefCount(objPtr); Tcl_DecrRefCount(listObj); @@ -907,7 +907,7 @@ TclCompileConcatCmd( const char *bytes; int len; - Tcl_ListObjGetElements(NULL, listObj, &len, &objs); + TclListObjGetElements(NULL, listObj, &len, &objs); objPtr = Tcl_ConcatObj(len, objs); Tcl_DecrRefCount(listObj); bytes = Tcl_GetStringFromObj(objPtr, &len); @@ -1288,10 +1288,10 @@ TclCompileDictCreateCmd( */ tokenPtr = TokenAfter(parsePtr->tokenPtr); - dictObj = Tcl_NewObj(); + TclNewObj(dictObj); Tcl_IncrRefCount(dictObj); for (i=1 ; i<parsePtr->numWords ; i+=2) { - keyObj = Tcl_NewObj(); + TclNewObj(keyObj); Tcl_IncrRefCount(keyObj); if (!TclWordKnownAtCompileTime(tokenPtr, keyObj)) { Tcl_DecrRefCount(keyObj); @@ -1299,7 +1299,7 @@ TclCompileDictCreateCmd( goto nonConstant; } tokenPtr = TokenAfter(tokenPtr); - valueObj = Tcl_NewObj(); + TclNewObj(valueObj); Tcl_IncrRefCount(valueObj); if (!TclWordKnownAtCompileTime(tokenPtr, valueObj)) { Tcl_DecrRefCount(keyObj); @@ -2298,8 +2298,9 @@ DisassembleDictUpdateInfo( { DictUpdateInfo *duiPtr = clientData; int i; - Tcl_Obj *variables = Tcl_NewObj(); + Tcl_Obj *variables; + TclNewObj(variables); for (i=0 ; i<duiPtr->length ; i++) { Tcl_ListObjAppendElement(NULL, variables, Tcl_NewIntObj(duiPtr->varIndices[i])); @@ -2722,7 +2723,7 @@ CompileEachloopCmd( * a scalar, or if any var list needs substitutions. */ - varListObj = Tcl_NewObj(); + TclNewObj(varListObj); for (i = 0, tokenPtr = parsePtr->tokenPtr; i < numWords-1; i++, tokenPtr = TokenAfter(tokenPtr)) { @@ -2740,7 +2741,7 @@ CompileEachloopCmd( */ if (!TclWordKnownAtCompileTime(tokenPtr, varListObj) || - TCL_OK != Tcl_ListObjLength(NULL, varListObj, &numVars) || + TCL_OK != TclListObjLength(NULL, varListObj, &numVars) || numVars == 0) { code = TCL_ERROR; goto done; @@ -3041,7 +3042,7 @@ DisassembleForeachInfo( * Data stores. */ - objPtr = Tcl_NewObj(); + TclNewObj(objPtr); for (i=0 ; i<infoPtr->numLists ; i++) { Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewIntObj(infoPtr->firstValueTemp + i)); @@ -3059,9 +3060,9 @@ DisassembleForeachInfo( * Assignment targets. */ - objPtr = Tcl_NewObj(); + TclNewObj(objPtr); for (i=0 ; i<infoPtr->numLists ; i++) { - innerPtr = Tcl_NewObj(); + TclNewObj(innerPtr); varsPtr = infoPtr->varLists[i]; for (j=0 ; j<varsPtr->numVars ; j++) { Tcl_ListObjAppendElement(NULL, innerPtr, @@ -3095,9 +3096,9 @@ DisassembleNewForeachInfo( * Assignment targets. */ - objPtr = Tcl_NewObj(); + TclNewObj(objPtr); for (i=0 ; i<infoPtr->numLists ; i++) { - innerPtr = Tcl_NewObj(); + TclNewObj(innerPtr); varsPtr = infoPtr->varLists[i]; for (j=0 ; j<varsPtr->numVars ; j++) { Tcl_ListObjAppendElement(NULL, innerPtr, @@ -3155,7 +3156,7 @@ TclCompileFormatCmd( * a case we can handle by compiling to a constant. */ - formatObj = Tcl_NewObj(); + TclNewObj(formatObj); Tcl_IncrRefCount(formatObj); tokenPtr = TokenAfter(tokenPtr); if (!TclWordKnownAtCompileTime(tokenPtr, formatObj)) { @@ -3166,7 +3167,7 @@ TclCompileFormatCmd( objv = ckalloc((parsePtr->numWords-2) * sizeof(Tcl_Obj *)); for (i=0 ; i+2 < parsePtr->numWords ; i++) { tokenPtr = TokenAfter(tokenPtr); - objv[i] = Tcl_NewObj(); + TclNewObj(objv[i]); Tcl_IncrRefCount(objv[i]); if (!TclWordKnownAtCompileTime(tokenPtr, objv[i])) { goto checkForStringConcatCase; @@ -3258,7 +3259,7 @@ TclCompileFormatCmd( start = Tcl_GetString(formatObj); /* The start of the currently-scanned literal * in the format string. */ - tmpObj = Tcl_NewObj(); /* The buffer used to accumulate the literal + TclNewObj(tmpObj); /* The buffer used to accumulate the literal * being built. */ for (bytes = start ; *bytes ; bytes++) { if (*bytes == '%') { @@ -3276,7 +3277,7 @@ TclCompileFormatCmd( if (len > 0) { PushLiteral(envPtr, b, len); Tcl_DecrRefCount(tmpObj); - tmpObj = Tcl_NewObj(); + TclNewObj(tmpObj); i++; } diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c index c453878..a324706 100644 --- a/generic/tclCompCmdsGR.c +++ b/generic/tclCompCmdsGR.c @@ -54,9 +54,10 @@ TclGetIndexFromToken( int after, int *indexPtr) { - Tcl_Obj *tmpObj = Tcl_NewObj(); + Tcl_Obj *tmpObj; int result = TCL_ERROR; + TclNewObj(tmpObj); if (TclWordKnownAtCompileTime(tokenPtr, tmpObj)) { result = TclIndexEncode(NULL, tmpObj, before, after, indexPtr); } @@ -599,7 +600,7 @@ TclCompileInfoCommandsCmd( return TCL_ERROR; } tokenPtr = TokenAfter(parsePtr->tokenPtr); - objPtr = Tcl_NewObj(); + TclNewObj(objPtr); Tcl_IncrRefCount(objPtr); if (!TclWordKnownAtCompileTime(tokenPtr, objPtr)) { goto notCompilable; @@ -1180,9 +1181,9 @@ TclCompileListCmd( numWords = parsePtr->numWords; valueTokenPtr = TokenAfter(parsePtr->tokenPtr); - listObj = Tcl_NewObj(); + TclNewObj(listObj); for (i = 1; i < numWords && listObj != NULL; i++) { - objPtr = Tcl_NewObj(); + TclNewObj(objPtr); if (TclWordKnownAtCompileTime(valueTokenPtr, objPtr)) { (void) Tcl_ListObjAppendElement(NULL, listObj, objPtr); } else { @@ -2289,7 +2290,7 @@ TclCompileRegsubCmd( Tcl_DStringInit(&pattern); tokenPtr = TokenAfter(tokenPtr); - patternObj = Tcl_NewObj(); + TclNewObj(patternObj); if (!TclWordKnownAtCompileTime(tokenPtr, patternObj)) { goto done; } @@ -2300,7 +2301,7 @@ TclCompileRegsubCmd( } tokenPtr = TokenAfter(tokenPtr); Tcl_DecrRefCount(patternObj); - patternObj = Tcl_NewObj(); + TclNewObj(patternObj); if (!TclWordKnownAtCompileTime(tokenPtr, patternObj)) { goto done; } @@ -2315,7 +2316,7 @@ TclCompileRegsubCmd( stringTokenPtr = TokenAfter(tokenPtr); tokenPtr = TokenAfter(stringTokenPtr); - replacementObj = Tcl_NewObj(); + TclNewObj(replacementObj); if (!TclWordKnownAtCompileTime(tokenPtr, replacementObj)) { goto done; } @@ -2466,7 +2467,7 @@ TclCompileReturnCmd( */ for (objc = 0; objc < numOptionWords; objc++) { - objv[objc] = Tcl_NewObj(); + TclNewObj(objv[objc]); Tcl_IncrRefCount(objv[objc]); if (!TclWordKnownAtCompileTime(wordTokenPtr, objv[objc])) { /* @@ -2686,7 +2687,7 @@ TclCompileUpvarCmd( * Push the frame index if it is known at compile time */ - objPtr = Tcl_NewObj(); + TclNewObj(objPtr); tokenPtr = TokenAfter(parsePtr->tokenPtr); if (TclWordKnownAtCompileTime(tokenPtr, objPtr)) { CallFrame *framePtr; diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index ddfe0dc..8828b59 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -248,7 +248,7 @@ TclCompileStringCatCmd( folded = NULL; wordTokenPtr = TokenAfter(parsePtr->tokenPtr); for (i = 1; i < numWords; i++) { - obj = Tcl_NewObj(); + TclNewObj(obj); if (TclWordKnownAtCompileTime(wordTokenPtr, obj)) { if (folded) { Tcl_AppendObjToObj(folded, obj); @@ -482,7 +482,7 @@ TclCompileStringIsCmd( if (parsePtr->numWords < 3 || parsePtr->numWords > 6) { return TCL_ERROR; } - isClass = Tcl_NewObj(); + TclNewObj(isClass); if (!TclWordKnownAtCompileTime(tokenPtr, isClass)) { Tcl_DecrRefCount(isClass); return TCL_ERROR; @@ -878,12 +878,12 @@ TclCompileStringMapCmd( } mapTokenPtr = TokenAfter(parsePtr->tokenPtr); stringTokenPtr = TokenAfter(mapTokenPtr); - mapObj = Tcl_NewObj(); + TclNewObj(mapObj); Tcl_IncrRefCount(mapObj); if (!TclWordKnownAtCompileTime(mapTokenPtr, mapObj)) { Tcl_DecrRefCount(mapObj); return TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr); - } else if (Tcl_ListObjGetElements(NULL, mapObj, &len, &objv) != TCL_OK) { + } else if (TclListObjGetElements(NULL, mapObj, &len, &objv) != TCL_OK) { Tcl_DecrRefCount(mapObj); return TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr); } else if (len != 2) { @@ -1418,7 +1418,7 @@ TclCompileSubstCmd( objv = TclStackAlloc(interp, /*numArgs*/ numOpts * sizeof(Tcl_Obj *)); for (objc = 0; objc < /*numArgs*/ numOpts; objc++) { - objv[objc] = Tcl_NewObj(); + TclNewObj(objv[objc]); Tcl_IncrRefCount(objv[objc]); if (!TclWordKnownAtCompileTime(wordTokenPtr, objv[objc])) { objc++; @@ -2570,12 +2570,13 @@ DisassembleJumptableInfo( unsigned int pcOffset) { JumptableInfo *jtPtr = clientData; - Tcl_Obj *mapping = Tcl_NewObj(); + Tcl_Obj *mapping; Tcl_HashEntry *hPtr; Tcl_HashSearch search; const char *keyPtr; int offset; + TclNewObj(mapping); hPtr = Tcl_FirstHashEntry(&jtPtr->hashTable, &search); for (; hPtr ; hPtr = Tcl_NextHashEntry(&search)) { keyPtr = Tcl_GetHashKey(&jtPtr->hashTable, hPtr); @@ -2688,7 +2689,7 @@ TclCompileThrowCmd( CompileWord(envPtr, msgToken, interp, 2); codeIsList = codeKnown && (TCL_OK == - Tcl_ListObjLength(interp, objPtr, &len)); + TclListObjLength(interp, objPtr, &len)); codeIsValid = codeIsList && (len != 0); if (codeIsValid) { @@ -2822,7 +2823,7 @@ TclCompileTryCmd( TclNewObj(tmpObj); Tcl_IncrRefCount(tmpObj); if (!TclWordKnownAtCompileTime(tokenPtr, tmpObj) - || Tcl_ListObjLength(NULL, tmpObj, &objc) != TCL_OK + || TclListObjLength(NULL, tmpObj, &objc) != TCL_OK || (objc == 0)) { TclDecrRefCount(tmpObj); goto failedToCompile; @@ -2865,7 +2866,7 @@ TclCompileTryCmd( TclDecrRefCount(tmpObj); goto failedToCompile; } - if (Tcl_ListObjGetElements(NULL, tmpObj, &objc, &objv) != TCL_OK + if (TclListObjGetElements(NULL, tmpObj, &objc, &objv) != TCL_OK || (objc > 2)) { TclDecrRefCount(tmpObj); goto failedToCompile; @@ -3076,7 +3077,7 @@ IssueTryClausesInstructions( JUMP4( JUMP_FALSE, notCodeJumpSource); if (matchClauses[i]) { const char *p; - Tcl_ListObjLength(NULL, matchClauses[i], &len); + TclListObjLength(NULL, matchClauses[i], &len); /* * Match the errorcode according to try/trap rules. @@ -3287,7 +3288,7 @@ IssueTryClausesFinallyInstructions( OP( EQ); JUMP4( JUMP_FALSE, notCodeJumpSource); if (matchClauses[i]) { - Tcl_ListObjLength(NULL, matchClauses[i], &len); + TclListObjLength(NULL, matchClauses[i], &len); /* * Match the errorcode according to try/trap rules. @@ -3587,8 +3588,9 @@ TclCompileUnsetCmd( */ for (i=1,varTokenPtr=parsePtr->tokenPtr ; i<parsePtr->numWords ; i++) { - Tcl_Obj *leadingWord = Tcl_NewObj(); + Tcl_Obj *leadingWord; + TclNewObj(leadingWord); varTokenPtr = TokenAfter(varTokenPtr); if (!TclWordKnownAtCompileTime(varTokenPtr, leadingWord)) { TclDecrRefCount(leadingWord); diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index 52b62fc..ca9a21a 100644 --- a/generic/tclCompExpr.c +++ b/generic/tclCompExpr.c @@ -1001,7 +1001,7 @@ ParseExpr( * later. */ - literal = Tcl_NewObj(); + TclNewObj(literal); if (TclWordKnownAtCompileTime(tokenPtr, literal)) { Tcl_ListObjAppendElement(NULL, litList, literal); complete = lastParsed = OT_LITERAL; @@ -1828,8 +1828,8 @@ Tcl_ParseExpr( { int code; OpNode *opTree = NULL; /* Will point to the tree of operators. */ - Tcl_Obj *litList = Tcl_NewObj(); /* List to hold the literals. */ - Tcl_Obj *funcList = Tcl_NewObj(); /* List to hold the functon names. */ + Tcl_Obj *litList; /* List to hold the literals. */ + Tcl_Obj *funcList; /* List to hold the functon names. */ Tcl_Parse *exprParsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse)); /* Holds the Tcl_Tokens of substitutions. */ @@ -1837,6 +1837,8 @@ Tcl_ParseExpr( numBytes = (start ? strlen(start) : 0); } + TclNewObj(litList); + TclNewObj(funcList); code = ParseExpr(interp, start, numBytes, &opTree, litList, funcList, exprParsePtr, 1 /* parseOnly */); Tcl_DecrRefCount(funcList); @@ -2003,7 +2005,7 @@ ParseLexeme( } } - literal = Tcl_NewObj(); + TclNewObj(literal); if (TclParseNumber(NULL, literal, NULL, start, numBytes, &end, TCL_PARSE_NO_WHITESPACE) == TCL_OK) { if (end < start + numBytes && !TclIsBareword(*end)) { @@ -2117,12 +2119,15 @@ TclCompileExpr( int optimize) /* 0 for one-off expressions. */ { OpNode *opTree = NULL; /* Will point to the tree of operators */ - Tcl_Obj *litList = Tcl_NewObj(); /* List to hold the literals */ - Tcl_Obj *funcList = Tcl_NewObj(); /* List to hold the functon names*/ + Tcl_Obj *litList; /* List to hold the literals */ + Tcl_Obj *funcList; /* List to hold the functon names*/ Tcl_Parse *parsePtr = TclStackAlloc(interp, sizeof(Tcl_Parse)); /* Holds the Tcl_Tokens of substitutions */ + int code; - int code = ParseExpr(interp, script, numBytes, &opTree, litList, + TclNewObj(litList); + TclNewObj(funcList); + code = ParseExpr(interp, script, numBytes, &opTree, litList, funcList, parsePtr, 0 /* parseOnly */); if (code == TCL_OK) { @@ -2181,9 +2186,10 @@ ExecConstantExprTree( CompileEnv *envPtr; ByteCode *byteCodePtr; int code; - Tcl_Obj *byteCodeObj = Tcl_NewObj(); + Tcl_Obj *byteCodeObj; NRE_callback *rootPtr = TOP_CB(interp); + TclNewObj(byteCodeObj); /* * Note we are compiling an expression with literal arguments. This means * there can be no [info frame] calls when we execute the resulting diff --git a/generic/tclCompile.c b/generic/tclCompile.c index eb2e16b..9a59b71 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -1710,7 +1710,7 @@ TclWordKnownAtCompileTime( } tokenPtr++; if (valuePtr != NULL) { - tempPtr = Tcl_NewObj(); + TclNewObj(tempPtr); Tcl_IncrRefCount(tempPtr); } while (numComponents--) { @@ -1999,7 +1999,7 @@ CompileCommandTokens( Interp *iPtr = (Interp *) interp; Tcl_Token *tokenPtr = parsePtr->tokenPtr; ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr; - Tcl_Obj *cmdObj = Tcl_NewObj(); + Tcl_Obj *cmdObj; Command *cmdPtr = NULL; int code = TCL_ERROR; int cmdKnown, expand = -1; @@ -2010,6 +2010,7 @@ CompileCommandTokens( int startCodeOffset = envPtr->codeNext - envPtr->codeStart; int depth = TclGetStackDepth(envPtr); + TclNewObj(cmdObj); assert (parsePtr->numWords > 0); /* Pre-Compile */ @@ -3010,7 +3011,7 @@ TclFindCompiledLocal( if (create || (name == NULL)) { localVar = procPtr->numCompiledLocals; - localPtr = ckalloc(TclOffset(CompiledLocal, name) + nameBytes + 1); + localPtr = ckalloc(TclOffset(CompiledLocal, name) + 1U + nameBytes); if (procPtr->firstLocalPtr == NULL) { procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr; } else { diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 03b4a90..997f08e 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -1509,22 +1509,22 @@ MODULE_SCOPE int TclPushProcCallFrame(ClientData clientData, # define TclGetInt1AtPtr(p) ((int) *((signed char *) p)) #else # define TclGetInt1AtPtr(p) \ - (((int) *((char *) p)) | ((*(p) & 0200) ? (-256) : 0)) + ((int) ((*((char *) p)) | ((*(p) & 0200) ? (-256) : 0))) #endif #define TclGetInt4AtPtr(p) \ - (((int) (TclGetUInt1AtPtr(p) << 24)) | \ - (*((p)+1) << 16) | \ - (*((p)+2) << 8) | \ - (*((p)+3))) + ((int) ((TclGetUInt1AtPtr(p) << 24) | \ + (*((p)+1) << 16) | \ + (*((p)+2) << 8) | \ + (*((p)+3)))) #define TclGetUInt1AtPtr(p) \ ((unsigned int) *(p)) #define TclGetUInt4AtPtr(p) \ - ((unsigned int) (*(p) << 24) | \ - (*((p)+1) << 16) | \ - (*((p)+2) << 8) | \ - (*((p)+3))) + ((unsigned int) ((*(p) << 24) | \ + (*((p)+1) << 16) | \ + (*((p)+2) << 8) | \ + (*((p)+3)))) /* * Macros used to compute the minimum and maximum of two integers. The ANSI C diff --git a/generic/tclDate.c b/generic/tclDate.c index aa199c3..23cf336 100644 --- a/generic/tclDate.c +++ b/generic/tclDate.c @@ -185,9 +185,9 @@ typedef struct DateInfo { #define TM_YEAR_BASE 1900 -#define HOUR(x) ((int) (60 * x)) +#define HOUR(x) ((int) (60 * (x))) #define SECSPERDAY (24L * 60L * 60L) -#define IsLeapYear(x) ((x % 4 == 0) && (x % 100 != 0 || x % 400 == 0)) +#define IsLeapYear(x) (((x) % 4 == 0) && ((x) % 100 != 0 || (x) % 400 == 0)) /* * An entry in the lexical lookup table. diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 621b1ba..2d11df5 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -1844,7 +1844,20 @@ EXTERN void Tcl_ZlibStreamSetCompressionDictionary( /* Slot 657 is reserved */ /* Slot 658 is reserved */ /* Slot 659 is reserved */ -/* 660 */ +/* Slot 660 is reserved */ +/* Slot 661 is reserved */ +/* Slot 662 is reserved */ +/* Slot 663 is reserved */ +/* Slot 664 is reserved */ +/* Slot 665 is reserved */ +/* Slot 666 is reserved */ +/* Slot 667 is reserved */ +/* Slot 668 is reserved */ +/* Slot 669 is reserved */ +/* Slot 670 is reserved */ +/* Slot 671 is reserved */ +/* Slot 672 is reserved */ +/* 673 */ EXTERN void TclUnusedStubEntry(void); typedef struct { @@ -2541,7 +2554,20 @@ typedef struct TclStubs { void (*reserved657)(void); void (*reserved658)(void); void (*reserved659)(void); - void (*tclUnusedStubEntry) (void); /* 660 */ + void (*reserved660)(void); + void (*reserved661)(void); + void (*reserved662)(void); + void (*reserved663)(void); + void (*reserved664)(void); + void (*reserved665)(void); + void (*reserved666)(void); + void (*reserved667)(void); + void (*reserved668)(void); + void (*reserved669)(void); + void (*reserved670)(void); + void (*reserved671)(void); + void (*reserved672)(void); + void (*tclUnusedStubEntry) (void); /* 673 */ } TclStubs; extern const TclStubs *tclStubsPtr; @@ -3863,8 +3889,21 @@ extern const TclStubs *tclStubsPtr; /* Slot 657 is reserved */ /* Slot 658 is reserved */ /* Slot 659 is reserved */ +/* Slot 660 is reserved */ +/* Slot 661 is reserved */ +/* Slot 662 is reserved */ +/* Slot 663 is reserved */ +/* Slot 664 is reserved */ +/* Slot 665 is reserved */ +/* Slot 666 is reserved */ +/* Slot 667 is reserved */ +/* Slot 668 is reserved */ +/* Slot 669 is reserved */ +/* Slot 670 is reserved */ +/* Slot 671 is reserved */ +/* Slot 672 is reserved */ #define TclUnusedStubEntry \ - (tclStubsPtr->tclUnusedStubEntry) /* 660 */ + (tclStubsPtr->tclUnusedStubEntry) /* 673 */ #endif /* defined(USE_TCL_STUBS) */ diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index becc029..ba9ab98 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -3257,7 +3257,7 @@ FinalizeDictUpdate( * an instruction to remove the key. */ - Tcl_ListObjGetElements(NULL, argsObj, &objc, &objv); + TclListObjGetElements(NULL, argsObj, &objc, &objv); for (i=0 ; i<objc ; i+=2) { objPtr = Tcl_ObjGetVar2(interp, objv[i+1], NULL, 0); if (objPtr == NULL) { @@ -3381,7 +3381,7 @@ FinalizeDictWith( state = Tcl_SaveInterpState(interp, result); if (pathPtr != NULL) { - Tcl_ListObjGetElements(NULL, pathPtr, &pathc, &pathv); + TclListObjGetElements(NULL, pathPtr, &pathc, &pathv); } else { pathc = 0; pathv = NULL; diff --git a/generic/tclDisassemble.c b/generic/tclDisassemble.c index 8b137d4..6f463ca 100644 --- a/generic/tclDisassemble.c +++ b/generic/tclDisassemble.c @@ -758,7 +758,7 @@ TclGetInnerContext( * Reset while keeping the list internalrep as much as possible. */ - Tcl_ListObjLength(interp, result, &len); + TclListObjLength(interp, result, &len); Tcl_ListObjReplace(interp, result, 0, len, 0, NULL); } Tcl_ListObjAppendElement(NULL, result, TclNewInstNameObj(*pc)); @@ -798,8 +798,9 @@ Tcl_Obj * TclNewInstNameObj( unsigned char inst) { - Tcl_Obj *objPtr = Tcl_NewObj(); + Tcl_Obj *objPtr; + TclNewObj(objPtr); objPtr->typePtr = &tclInstNameType; objPtr->internalRep.longValue = (long) inst; objPtr->bytes = NULL; @@ -943,7 +944,7 @@ DisassembleByteCodeAsDicts( * Get the literals from the bytecode. */ - literals = Tcl_NewObj(); + TclNewObj(literals); for (i=0 ; i<codePtr->numLitObjects ; i++) { Tcl_ListObjAppendElement(NULL, literals, codePtr->objArrayPtr[i]); } @@ -952,7 +953,7 @@ DisassembleByteCodeAsDicts( * Get the variables from the bytecode. */ - variables = Tcl_NewObj(); + TclNewObj(variables); if (codePtr->procPtr) { int localCount = codePtr->procPtr->numCompiledLocals; CompiledLocal *localPtr = codePtr->procPtr->firstLocalPtr; @@ -960,7 +961,7 @@ DisassembleByteCodeAsDicts( for (i=0 ; i<localCount ; i++,localPtr=localPtr->nextPtr) { Tcl_Obj *descriptor[2]; - descriptor[0] = Tcl_NewObj(); + TclNewObj(descriptor[0]); if (!(localPtr->flags & (VAR_ARRAY|VAR_LINK))) { Tcl_ListObjAppendElement(NULL, descriptor[0], Tcl_NewStringObj("scalar", -1)); @@ -1000,12 +1001,12 @@ DisassembleByteCodeAsDicts( * Get the instructions from the bytecode. */ - instructions = Tcl_NewObj(); + TclNewObj(instructions); for (pc=codePtr->codeStart; pc<codePtr->codeStart+codePtr->numCodeBytes;){ const InstructionDesc *instDesc = &tclInstructionTable[*pc]; int address = pc - codePtr->codeStart; - inst = Tcl_NewObj(); + TclNewObj(inst); Tcl_ListObjAppendElement(NULL, inst, Tcl_NewStringObj( instDesc->name, -1)); opnd = pc + 1; @@ -1103,21 +1104,23 @@ DisassembleByteCodeAsDicts( * Get the auxiliary data from the bytecode. */ - aux = Tcl_NewObj(); + TclNewObj(aux); for (i=0 ; i<codePtr->numAuxDataItems ; i++) { AuxData *auxData = &codePtr->auxDataArrayPtr[i]; Tcl_Obj *auxDesc = Tcl_NewStringObj(auxData->type->name, -1); if (auxData->type->disassembleProc) { - Tcl_Obj *desc = Tcl_NewObj(); + Tcl_Obj *desc; + TclNewObj(desc); Tcl_DictObjPut(NULL, desc, Tcl_NewStringObj("name", -1), auxDesc); auxDesc = desc; auxData->type->disassembleProc(auxData->clientData, auxDesc, codePtr, 0); } else if (auxData->type->printProc) { - Tcl_Obj *desc = Tcl_NewObj(); + Tcl_Obj *desc; + TclNewObj(desc); auxData->type->printProc(auxData->clientData, desc, codePtr, 0); Tcl_ListObjAppendElement(NULL, auxDesc, desc); } @@ -1128,7 +1131,7 @@ DisassembleByteCodeAsDicts( * Get the exception ranges from the bytecode. */ - exn = Tcl_NewObj(); + TclNewObj(exn); for (i=0 ; i<codePtr->numExceptRanges ; i++) { ExceptionRange *rangePtr = &codePtr->exceptArrayPtr[i]; @@ -1163,7 +1166,7 @@ DisassembleByteCodeAsDicts( ? ((ptr)+=5 , TclGetInt4AtPtr((ptr)-4)) \ : ((ptr)+=1 , TclGetInt1AtPtr((ptr)-1))) - commands = Tcl_NewObj(); + TclNewObj(commands); codeOffPtr = codePtr->codeDeltaStart; codeLenPtr = codePtr->codeLengthStart; srcOffPtr = codePtr->srcDeltaStart; @@ -1176,7 +1179,7 @@ DisassembleByteCodeAsDicts( codeLength = Decode(codeLenPtr); sourceOffset += Decode(srcOffPtr); sourceLength = Decode(srcLenPtr); - cmd = Tcl_NewObj(); + TclNewObj(cmd); Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("codefrom", -1), Tcl_NewIntObj(codeOffset)); Tcl_DictObjPut(NULL, cmd, Tcl_NewStringObj("codeto", -1), @@ -1211,7 +1214,7 @@ DisassembleByteCodeAsDicts( * Build the overall result. */ - description = Tcl_NewObj(); + TclNewObj(description); Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("literals", -1), literals); Tcl_DictObjPut(NULL, description, Tcl_NewStringObj("variables", -1), diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 8fff493..fe2b55b 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -384,7 +384,7 @@ Tcl_SetEncodingSearchPath( { int dummy; - if (TCL_ERROR == Tcl_ListObjLength(NULL, searchPath, &dummy)) { + if (TCL_ERROR == TclListObjLength(NULL, searchPath, &dummy)) { return TCL_ERROR; } TclSetProcessGlobalValue(&encodingSearchPath, searchPath, NULL); @@ -431,7 +431,7 @@ TclSetLibraryPath( { int dummy; - if (TCL_ERROR == Tcl_ListObjLength(NULL, path, &dummy)) { + if (TCL_ERROR == TclListObjLength(NULL, path, &dummy)) { return; } TclSetProcessGlobalValue(&libraryPath, path, NULL); @@ -470,7 +470,7 @@ FillEncodingFileMap(void) searchPath = Tcl_GetEncodingSearchPath(); Tcl_IncrRefCount(searchPath); - Tcl_ListObjLength(NULL, searchPath, &numDirs); + TclListObjLength(NULL, searchPath, &numDirs); map = Tcl_NewDictObj(); Tcl_IncrRefCount(map); @@ -481,19 +481,20 @@ FillEncodingFileMap(void) */ int j, numFiles; - Tcl_Obj *directory, *matchFileList = Tcl_NewObj(); + Tcl_Obj *directory, *matchFileList; Tcl_Obj **filev; Tcl_GlobTypeData readableFiles = { TCL_GLOB_TYPE_FILE, TCL_GLOB_PERM_R, NULL, NULL }; + TclNewObj(matchFileList); Tcl_ListObjIndex(NULL, searchPath, i, &directory); Tcl_IncrRefCount(directory); Tcl_IncrRefCount(matchFileList); Tcl_FSMatchInDirectory(NULL, matchFileList, directory, "*.enc", &readableFiles); - Tcl_ListObjGetElements(NULL, matchFileList, &numFiles, &filev); + TclListObjGetElements(NULL, matchFileList, &numFiles, &filev); for (j=0; j<numFiles; j++) { Tcl_Obj *encodingName, *fileObj; @@ -691,7 +692,7 @@ Tcl_GetDefaultEncodingDir(void) int numDirs; Tcl_Obj *first, *searchPath = Tcl_GetEncodingSearchPath(); - Tcl_ListObjLength(NULL, searchPath, &numDirs); + TclListObjLength(NULL, searchPath, &numDirs); if (numDirs == 0) { return NULL; } @@ -903,10 +904,11 @@ Tcl_GetEncodingNames( Tcl_HashTable table; Tcl_HashSearch search; Tcl_HashEntry *hPtr; - Tcl_Obj *map, *name, *result = Tcl_NewObj(); + Tcl_Obj *map, *name, *result; Tcl_DictSearch mapSearch; int dummy, done = 0; + TclNewObj(result); Tcl_InitObjHashTable(&table); /* @@ -1486,7 +1488,7 @@ OpenEncodingFileChannel( Tcl_Channel chan = NULL; int i, numDirs; - Tcl_ListObjGetElements(NULL, searchPath, &numDirs, &dir); + TclListObjGetElements(NULL, searchPath, &numDirs, &dir); Tcl_IncrRefCount(nameObj); Tcl_AppendToObj(fileNameObj, ".enc", -1); Tcl_IncrRefCount(fileNameObj); @@ -3678,7 +3680,7 @@ InitializeEncodingSearchPath( Tcl_IncrRefCount(searchPathObj); libPathObj = TclGetLibraryPath(); Tcl_IncrRefCount(libPathObj); - Tcl_ListObjLength(NULL, libPathObj, &numDirs); + TclListObjLength(NULL, libPathObj, &numDirs); for (i = 0; i < numDirs; i++) { Tcl_Obj *directoryObj, *pathObj; diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index 7f47510..5e0a9e2 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -1882,7 +1882,7 @@ NsEnsembleImplementationCmdNR( Tcl_Obj **copyObjv; int copyObjc, prefixObjc; - Tcl_ListObjLength(NULL, prefixObj, &prefixObjc); + TclListObjLength(NULL, prefixObj, &prefixObjc); if (objc == 2) { copyPtr = TclListObjCopy(NULL, prefixObj); @@ -1916,7 +1916,7 @@ NsEnsembleImplementationCmdNR( */ TclSkipTailcall(interp); - Tcl_ListObjGetElements(NULL, copyPtr, ©Objc, ©Objv); + TclListObjGetElements(NULL, copyPtr, ©Objc, ©Objv); ((Interp *)interp)->lookupNsPtr = ensemblePtr->nsPtr; return TclNREvalObjv(interp, copyObjc, copyObjv, TCL_EVAL_INVOKE, NULL); } @@ -2598,7 +2598,7 @@ BuildEnsembleConfig( * Must determine the target for each. */ - Tcl_ListObjGetElements(NULL, subList, &subc, &subv); + TclListObjGetElements(NULL, subList, &subc, &subv); if (subList == mapDict) { /* * Strange case where explicit list of subcommands is same value @@ -2913,7 +2913,7 @@ TclCompileEnsemble( DefineLineInformation; Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr); Tcl_Obj *mapObj, *subcmdObj, *targetCmdObj, *listObj, **elems; - Tcl_Obj *replaced = Tcl_NewObj(), *replacement; + Tcl_Obj *replaced, *replacement; Tcl_Command ensemble = (Tcl_Command) cmdPtr; Command *oldCmdPtr = cmdPtr, *newCmdPtr; int len, result, flags = 0, i, depth = 1, invokeAnyway = 0; @@ -2921,6 +2921,7 @@ TclCompileEnsemble( unsigned numBytes; const char *word; + TclNewObj(replaced); Tcl_IncrRefCount(replaced); if (parsePtr->numWords < depth + 1) { goto failed; @@ -2991,7 +2992,7 @@ TclCompileEnsemble( const char *str; Tcl_Obj *matchObj = NULL; - if (Tcl_ListObjGetElements(NULL, listObj, &len, &elems) != TCL_OK) { + if (TclListObjGetElements(NULL, listObj, &len, &elems) != TCL_OK) { goto failed; } for (i=0 ; i<len ; i++) { @@ -3111,7 +3112,7 @@ TclCompileEnsemble( doneMapLookup: Tcl_ListObjAppendElement(NULL, replaced, replacement); - if (Tcl_ListObjGetElements(NULL, targetCmdObj, &len, &elems) != TCL_OK) { + if (TclListObjGetElements(NULL, targetCmdObj, &len, &elems) != TCL_OK) { goto failed; } else if (len != 1) { /* @@ -3393,7 +3394,7 @@ CompileToInvokedCommand( * difference. Hence the call to TclContinuationsEnterDerived... */ - Tcl_ListObjGetElements(NULL, replacements, &numWords, &words); + TclListObjGetElements(NULL, replacements, &numWords, &words); for (i = 0, tokPtr = parsePtr->tokenPtr; i < parsePtr->numWords; i++, tokPtr = TokenAfter(tokPtr)) { if (i > 0 && i < numWords+1) { @@ -3424,7 +3425,7 @@ CompileToInvokedCommand( * the implementation. */ - objPtr = Tcl_NewObj(); + TclNewObj(objPtr); Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr); bytes = Tcl_GetStringFromObj(objPtr, &length); if ((cmdPtr != NULL) && (cmdPtr->flags & CMD_VIA_RESOLVER)) { @@ -3463,8 +3464,9 @@ CompileBasicNArgCommand( * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { - Tcl_Obj *objPtr = Tcl_NewObj(); + Tcl_Obj *objPtr; + TclNewObj(objPtr); Tcl_IncrRefCount(objPtr); Tcl_GetCommandFullName(interp, (Tcl_Command) cmdPtr, objPtr); TclCompileInvocation(interp, parsePtr->tokenPtr, objPtr, diff --git a/generic/tclEvent.c b/generic/tclEvent.c index e9d760c..3c4ff74 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -226,7 +226,7 @@ HandleBgErrors( errPtr = assocPtr->firstBgPtr; - Tcl_ListObjGetElements(NULL, copyObj, &prefixObjc, &prefixObjv); + TclListObjGetElements(NULL, copyObj, &prefixObjc, &prefixObjv); tempObjv = (Tcl_Obj**)ckalloc((prefixObjc+2) * sizeof(Tcl_Obj *)); memcpy(tempObjv, prefixObjv, prefixObjc*sizeof(Tcl_Obj *)); tempObjv[prefixObjc] = errPtr->errorMsg; diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 8963472..a26aae1 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -193,10 +193,10 @@ typedef struct TEBCdata { #define PUSH_TAUX_OBJ(objPtr) \ do { \ if (auxObjList) { \ - objPtr->length += auxObjList->length; \ + (objPtr)->length += auxObjList->length; \ } \ - objPtr->internalRep.twoPtrValue.ptr1 = auxObjList; \ - auxObjList = objPtr; \ + (objPtr)->internalRep.twoPtrValue.ptr1 = auxObjList; \ + auxObjList = (objPtr); \ } while (0) #define POP_TAUX_OBJ() \ @@ -1898,7 +1898,7 @@ TclIncrObj( if ((type1 == TCL_NUMBER_LONG) && (type2 == TCL_NUMBER_LONG)) { long augend = *((const long *) ptr1); long addend = *((const long *) ptr2); - long sum = augend + addend; + long sum = (long)((unsigned long)augend + (unsigned long)addend); /* * Overflow when (augend and sum have different sign) and (augend and @@ -1949,7 +1949,7 @@ TclIncrObj( TclGetWideIntFromObj(NULL, valuePtr, &w1); TclGetWideIntFromObj(NULL, incrPtr, &w2); - sum = w1 + w2; + sum = (Tcl_WideInt)((Tcl_WideUInt)w1 + (Tcl_WideUInt)w2); /* * Check for overflow. @@ -3240,7 +3240,7 @@ TEBCresume( TclMarkTailcall(interp); TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL); - Tcl_ListObjGetElements(NULL, objPtr, &objc, &objv); + TclListObjGetElements(NULL, objPtr, &objc, &objv); TclNRAddCallback(interp, TclNRReleaseValues, objPtr, NULL, NULL, NULL); return TclNREvalObjv(interp, objc, objv, TCL_EVAL_INVOKE, NULL); @@ -3929,7 +3929,7 @@ TEBCresume( if (GetNumberFromObj(NULL, objPtr, &ptr, &type) == TCL_OK) { if (type == TCL_NUMBER_LONG) { long augend = *((const long *)ptr); - long sum = augend + increment; + long sum = (long)((unsigned long)augend + (unsigned long)increment); /* * Overflow when (augend and sum have different sign) and @@ -3977,7 +3977,7 @@ TEBCresume( Tcl_WideInt sum; w = *((const Tcl_WideInt *) ptr); - sum = w + increment; + sum = (Tcl_WideInt)((Tcl_WideUInt)w + (Tcl_WideUInt)increment); /* * Check for overflow. @@ -5855,7 +5855,9 @@ TEBCresume( p = ustring1; end = ustring1 + length; for (; ustring1 < end; ustring1++) { - if ((*ustring1 == *ustring2) && (length2==1 || + if ((*ustring1 == *ustring2) && + /* Fix bug [69218ab7b]: restrict max compare length. */ + (end-ustring1 >= length2) && (length2==1 || memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length2) == 0)) { if (p != ustring1) { @@ -6284,7 +6286,8 @@ TEBCresume( (lResult * l2 != l1)) { lResult -= 1; } - lResult = l1 - l2*lResult; + lResult = (long)((unsigned long)l1 - + (unsigned long)l2*(unsigned long)lResult); goto longResultOfArithmetic; } break; @@ -6379,10 +6382,10 @@ TEBCresume( * Handle shifts within the native long range. */ - if ((size_t) shift < CHAR_BIT*sizeof(long) && (l1 != 0) + if (((size_t) shift < CHAR_BIT*sizeof(long)) && !((l1>0 ? l1 : ~l1) & - -(1L<<(CHAR_BIT*sizeof(long) - 1 - shift)))) { - lResult = l1 << shift; + -(1UL<<(CHAR_BIT*sizeof(long) - 1 - shift)))) { + lResult = (unsigned long)l1 << shift; goto longResultOfArithmetic; } } @@ -6504,7 +6507,7 @@ TEBCresume( case INST_ADD: w1 = (Tcl_WideInt) l1; w2 = (Tcl_WideInt) l2; - wResult = w1 + w2; + wResult = (Tcl_WideInt)((Tcl_WideUInt)w1 + (Tcl_WideUInt)w2); #ifdef TCL_WIDE_INT_IS_LONG /* * Check for overflow. @@ -6519,7 +6522,7 @@ TEBCresume( case INST_SUB: w1 = (Tcl_WideInt) l1; w2 = (Tcl_WideInt) l2; - wResult = w1 - w2; + wResult = (Tcl_WideInt)((Tcl_WideUInt)w1 - (Tcl_WideUInt)w2); #ifdef TCL_WIDE_INT_IS_LONG /* * Must check for overflow. The macro tests for overflows in @@ -8462,24 +8465,24 @@ ExecuteExtendedBinaryMathOp( { #define LONG_RESULT(l) \ if (Tcl_IsShared(valuePtr)) { \ - TclNewLongObj(objResultPtr, l); \ + TclNewLongObj(objResultPtr, (l)); \ return objResultPtr; \ } else { \ - Tcl_SetLongObj(valuePtr, l); \ + Tcl_SetLongObj(valuePtr, (l)); \ return NULL; \ } #define WIDE_RESULT(w) \ if (Tcl_IsShared(valuePtr)) { \ return Tcl_NewWideIntObj(w); \ } else { \ - Tcl_SetWideIntObj(valuePtr, w); \ + Tcl_SetWideIntObj(valuePtr, (w)); \ return NULL; \ } #define BIG_RESULT(b) \ if (Tcl_IsShared(valuePtr)) { \ return Tcl_NewBignumObj(b); \ } else { \ - Tcl_SetBignumObj(valuePtr, b); \ + Tcl_SetBignumObj(valuePtr, (b)); \ return NULL; \ } #define DOUBLE_RESULT(d) \ @@ -8542,7 +8545,8 @@ ExecuteExtendedBinaryMathOp( && (wQuotient * w2 != w1)) { wQuotient -= (Tcl_WideInt) 1; } - wRemainder = w1 - w2*wQuotient; + wRemainder = (Tcl_WideInt)((Tcl_WideUInt)w1 - + (Tcl_WideUInt)w2*(Tcl_WideUInt)wQuotient); WIDE_RESULT(wRemainder); } @@ -8657,9 +8661,9 @@ ExecuteExtendedBinaryMathOp( && ((size_t)shift < CHAR_BIT*sizeof(Tcl_WideInt))) { TclGetWideIntFromObj(NULL, valuePtr, &w1); if (!((w1>0 ? w1 : ~w1) - & -(((Tcl_WideInt)1) + & -(((Tcl_WideUInt)1) << (CHAR_BIT*sizeof(Tcl_WideInt) - 1 - shift)))) { - WIDE_RESULT(w1 << shift); + WIDE_RESULT((Tcl_WideUInt)w1 << shift); } } } else { @@ -9144,7 +9148,7 @@ ExecuteExtendedBinaryMathOp( switch (opcode) { case INST_ADD: - wResult = w1 + w2; + wResult = (Tcl_WideInt)((Tcl_WideUInt)w1 + (Tcl_WideUInt)w2); #ifndef TCL_WIDE_INT_IS_LONG if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE)) #endif @@ -9160,7 +9164,7 @@ ExecuteExtendedBinaryMathOp( break; case INST_SUB: - wResult = w1 - w2; + wResult = (Tcl_WideInt)((Tcl_WideUInt)w1 - (Tcl_WideUInt)w2); #ifndef TCL_WIDE_INT_IS_LONG if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE)) #endif diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c index e2d4164..d58d02d 100644 --- a/generic/tclFCmd.c +++ b/generic/tclFCmd.c @@ -1006,7 +1006,7 @@ TclFileAttrsCmd( * Use objStrings as a list object. */ - if (Tcl_ListObjLength(interp, objStrings, &numObjStrings) != TCL_OK) { + if (TclListObjLength(interp, objStrings, &numObjStrings) != TCL_OK) { goto end; } attributeStringsAllocated = (const char **) diff --git a/generic/tclFileName.c b/generic/tclFileName.c index cfd76e6..b6a6439 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -517,7 +517,7 @@ TclpNativeSplitPath( */ if (lenPtr != NULL) { - Tcl_ListObjLength(NULL, resultPtr, lenPtr); + TclListObjLength(NULL, resultPtr, lenPtr); } return resultPtr; } @@ -1333,7 +1333,7 @@ Tcl_GlobObjCmd( return TCL_ERROR; } typePtr = objv[i+1]; - if (Tcl_ListObjLength(interp, typePtr, &length) != TCL_OK) { + if (TclListObjLength(interp, typePtr, &length) != TCL_OK) { return TCL_ERROR; } i++; @@ -1455,7 +1455,7 @@ Tcl_GlobObjCmd( * platform. */ - Tcl_ListObjLength(interp, typePtr, &length); + TclListObjLength(interp, typePtr, &length); if (length <= 0) { goto skipTypes; } @@ -1525,7 +1525,7 @@ Tcl_GlobObjCmd( } else { Tcl_Obj *item; - if ((Tcl_ListObjLength(NULL, look, &len) == TCL_OK) + if ((TclListObjLength(NULL, look, &len) == TCL_OK) && (len == 3)) { Tcl_ListObjIndex(interp, look, 0, &item); if (!strcmp("macintosh", Tcl_GetString(item))) { @@ -1632,7 +1632,7 @@ Tcl_GlobObjCmd( } if ((globFlags & TCL_GLOBMODE_NO_COMPLAIN) == 0) { - if (Tcl_ListObjLength(interp, Tcl_GetObjResult(interp), + if (TclListObjLength(interp, Tcl_GetObjResult(interp), &length) != TCL_OK) { /* * This should never happen. Maybe we should be more dramatic. @@ -2015,7 +2015,7 @@ TclGlob( } } - Tcl_ListObjGetElements(NULL, filenamesObj, &objc, &objv); + TclListObjGetElements(NULL, filenamesObj, &objc, &objv); for (i = 0; i< objc; i++) { int len; const char *oldStr = Tcl_GetStringFromObj(objv[i], &len); @@ -2344,13 +2344,13 @@ DoGlob( int subdirc, i, repair = -1; Tcl_Obj **subdirv; - result = Tcl_ListObjGetElements(interp, subdirsPtr, + result = TclListObjGetElements(interp, subdirsPtr, &subdirc, &subdirv); for (i=0; result==TCL_OK && i<subdirc; i++) { Tcl_Obj *copy = NULL; if (pathPtr == NULL && Tcl_GetString(subdirv[i])[0] == '~') { - Tcl_ListObjLength(NULL, matchesObj, &repair); + TclListObjLength(NULL, matchesObj, &repair); copy = subdirv[i]; subdirv[i] = Tcl_NewStringObj("./", 2); Tcl_AppendObjToObj(subdirv[i], copy); @@ -2363,7 +2363,7 @@ DoGlob( Tcl_DecrRefCount(subdirv[i]); subdirv[i] = copy; - Tcl_ListObjLength(NULL, matchesObj, &end); + TclListObjLength(NULL, matchesObj, &end); while (repair < end) { const char *bytes; int numBytes; diff --git a/generic/tclGetDate.y b/generic/tclGetDate.y index e6748a4..7e26b37 100644 --- a/generic/tclGetDate.y +++ b/generic/tclGetDate.y @@ -136,9 +136,9 @@ typedef struct DateInfo { #define TM_YEAR_BASE 1900 -#define HOUR(x) ((int) (60 * x)) +#define HOUR(x) ((int) (60 * (x))) #define SECSPERDAY (24L * 60L * 60L) -#define IsLeapYear(x) ((x % 4 == 0) && (x % 100 != 0 || x % 400 == 0)) +#define IsLeapYear(x) (((x) % 4 == 0) && ((x) % 100 != 0 || (x) % 400 == 0)) /* * An entry in the lexical lookup table. diff --git a/generic/tclHash.c b/generic/tclHash.c index bcf6eee..5de8168 100644 --- a/generic/tclHash.c +++ b/generic/tclHash.c @@ -35,7 +35,7 @@ */ #define RANDOM_INDEX(tablePtr, i) \ - ((((i)*1103515245L) >> (tablePtr)->downShift) & (tablePtr)->mask) + ((((i)*1103515245UL) >> (tablePtr)->downShift) & (tablePtr)->mask) /* * Prototypes for the array hash key methods. diff --git a/generic/tclIO.c b/generic/tclIO.c index 43b7ce3..108114c 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -11006,7 +11006,7 @@ FixLevelCode( * information. Hence an error means that we've got serious breakage. */ - res = Tcl_ListObjGetElements(NULL, msg, &lc, &lv); + res = TclListObjGetElements(NULL, msg, &lc, &lv); if (res != TCL_OK) { Tcl_Panic("Tcl_SetChannelError: bad syntax of message"); } diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index af1295f..f11a4ab 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -323,7 +323,7 @@ Tcl_GetsObjCmd( } TclChannelPreserve(chan); - linePtr = Tcl_NewObj(); + TclNewObj(linePtr); lineLen = Tcl_GetsObj(chan, linePtr); if (lineLen < 0) { if (!Tcl_Eof(chan) && !Tcl_InputBlocked(chan)) { @@ -463,7 +463,7 @@ Tcl_ReadObjCmd( } } - resultPtr = Tcl_NewObj(); + TclNewObj(resultPtr); Tcl_IncrRefCount(resultPtr); TclChannelPreserve(chan); charactersRead = Tcl_ReadChars(chan, resultPtr, toRead, 0); @@ -991,7 +991,7 @@ Tcl_ExecObjCmd( return TCL_OK; } - resultPtr = Tcl_NewObj(); + TclNewObj(resultPtr); if (Tcl_GetChannelHandle(chan, TCL_READABLE, NULL) == TCL_OK) { if (Tcl_ReadChars(chan, resultPtr, -1, 0) < 0) { /* @@ -1903,7 +1903,7 @@ ChanPipeObjCmd( channelNames[0] = Tcl_GetChannelName(rchan); channelNames[1] = Tcl_GetChannelName(wchan); - resultPtr = Tcl_NewObj(); + TclNewObj(resultPtr); Tcl_ListObjAppendElement(NULL, resultPtr, Tcl_NewStringObj(channelNames[0], -1)); Tcl_ListObjAppendElement(NULL, resultPtr, diff --git a/generic/tclIOGT.c b/generic/tclIOGT.c index dadcb53..bbb0838 100644 --- a/generic/tclIOGT.c +++ b/generic/tclIOGT.c @@ -108,7 +108,7 @@ typedef struct ResultBuffer ResultBuffer; static inline void ResultClear(ResultBuffer *r); static inline void ResultInit(ResultBuffer *r); static inline int ResultEmpty(ResultBuffer *r); -static inline int ResultCopy(ResultBuffer *r, unsigned char *buf, +static inline size_t ResultCopy(ResultBuffer *r, unsigned char *buf, size_t toRead); static inline void ResultAdd(ResultBuffer *r, unsigned char *buf, size_t toWrite); @@ -271,7 +271,7 @@ TclChannelTransform( return TCL_ERROR; } - if (TCL_OK != Tcl_ListObjLength(interp, cmdObjPtr, &objc)) { + if (TCL_OK != TclListObjLength(interp, cmdObjPtr, &objc)) { Tcl_SetObjResult(interp, Tcl_NewStringObj("-command value is not a list", -1)); return TCL_ERROR; @@ -1361,13 +1361,13 @@ ResultEmpty( *---------------------------------------------------------------------- */ -static inline int +static inline size_t ResultCopy( ResultBuffer *r, /* The buffer to read from. */ unsigned char *buf, /* The buffer to copy into. */ size_t toRead) /* Number of requested bytes. */ { - if (r->used == 0) { + if (ResultEmpty(r)) { /* * Nothing to copy in the case of an empty buffer. */ @@ -1424,7 +1424,7 @@ ResultAdd( unsigned char *buf, /* The buffer to read from. */ size_t toWrite) /* The number of bytes in 'buf'. */ { - if (r->used + toWrite > r->allocated) { + if ((r->used + toWrite + 1) > r->allocated) { /* * Extension of the internal buffer is required. */ diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c index c48c904..7ea50c8 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -200,7 +200,7 @@ typedef enum { #define IMPLIES(a,b) ((!(a)) || (b)) #define NEGIMPL(a,b) -#define HAS(x,f) (x & FLAG(f)) +#define HAS(x,f) ((x) & FLAG(f)) #ifdef TCL_THREADS /* @@ -592,7 +592,7 @@ TclChanCreateObjCmd( * Compare open mode against optional r/w. */ - if (Tcl_ListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) { + if (TclListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "chan handler \"%s initialize\" returned non-list: %s", Tcl_GetString(cmdObj), Tcl_GetString(resObj))); @@ -1016,7 +1016,7 @@ UnmarshallErrorResult( * information; if we panic here, something has gone badly wrong already. */ - if (Tcl_ListObjGetElements(interp, msgObj, &lc, &lv) != TCL_OK) { + if (TclListObjGetElements(interp, msgObj, &lc, &lv) != TCL_OK) { Tcl_Panic("TclChanCaughtErrorBypass: Bad syntax of caught result"); } if (interp == NULL) { @@ -1957,7 +1957,7 @@ ReflectGetOption( * result is a valid list. Nor that the list has an even number elements. */ - if (Tcl_ListObjGetElements(interp, resObj, &listc, &listv) != TCL_OK) { + if (TclListObjGetElements(interp, resObj, &listc, &listv) != TCL_OK) { goto error; } @@ -2036,7 +2036,7 @@ EncodeEventMask( int evIndex; /* Id of event for an element of the eventspec * list. */ - if (Tcl_ListObjGetElements(interp, obj, &listc, &listv) != TCL_OK) { + if (TclListObjGetElements(interp, obj, &listc, &listv) != TCL_OK) { return TCL_ERROR; } @@ -3197,7 +3197,7 @@ ForwardProc( int listc; Tcl_Obj **listv; - if (Tcl_ListObjGetElements(interp, resObj, &listc, + if (TclListObjGetElements(interp, resObj, &listc, &listv) != TCL_OK) { Tcl_DecrRefCount(resObj); resObj = MarshallError(interp); diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c index 039b594..26b6d99 100644 --- a/generic/tclIORTrans.c +++ b/generic/tclIORTrans.c @@ -85,22 +85,22 @@ static const Tcl_ChannelType tclRTransformType = { * layers upon reading from the channel, plus the functions to manage such. */ -typedef struct _ResultBuffer_ { +typedef struct { unsigned char *buf; /* Reference to the buffer area. */ - int allocated; /* Allocated size of the buffer area. */ - int used; /* Number of bytes in the buffer, + size_t allocated; /* Allocated size of the buffer area. */ + size_t used; /* Number of bytes in the buffer, * <= allocated. */ } ResultBuffer; #define ResultLength(r) ((r)->used) /* static int ResultLength(ResultBuffer *r); */ -static void ResultClear(ResultBuffer *r); -static void ResultInit(ResultBuffer *r); -static void ResultAdd(ResultBuffer *r, unsigned char *buf, - int toWrite); -static int ResultCopy(ResultBuffer *r, unsigned char *buf, - int toRead); +static inline void ResultClear(ResultBuffer *r); +static inline void ResultInit(ResultBuffer *r); +static inline void ResultAdd(ResultBuffer *r, unsigned char *buf, + size_t toWrite); +static inline size_t ResultCopy(ResultBuffer *r, unsigned char *buf, + size_t toRead); #define RB_INCREMENT (512) @@ -216,7 +216,7 @@ typedef enum { #define IMPLIES(a,b) ((!(a)) || (b)) #define NEGIMPL(a,b) -#define HAS(x,f) (x & FLAG(f)) +#define HAS(x,f) ((x) & FLAG(f)) #ifdef TCL_THREADS /* @@ -604,7 +604,7 @@ TclChanPushObjCmd( * through the mask. Compare open mode against optional r/w. */ - if (Tcl_ListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) { + if (TclListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "chan handler \"%s initialize\" returned non-list: %s", Tcl_GetString(cmdObj), Tcl_GetString(resObj))); @@ -841,7 +841,7 @@ UnmarshallErrorResult( * information; if we panic here, something has gone badly wrong already. */ - if (Tcl_ListObjGetElements(interp, msgObj, &lc, &lv) != TCL_OK) { + if (TclListObjGetElements(interp, msgObj, &lc, &lv) != TCL_OK) { Tcl_Panic("TclChanCaughtErrorBypass: Bad syntax of caught result"); } if (interp == NULL) { @@ -1224,7 +1224,7 @@ ReflectInput( } if (Tcl_IsShared(bufObj)) { Tcl_DecrRefCount(bufObj); - bufObj = Tcl_NewObj(); + TclNewObj(bufObj); Tcl_IncrRefCount(bufObj); } Tcl_SetByteArrayLength(bufObj, 0); @@ -1806,7 +1806,7 @@ NewReflectedTransform( /* ASSERT: cmdpfxObj is a Tcl List */ - Tcl_ListObjGetElements(interp, cmdpfxObj, &listc, &listv); + TclListObjGetElements(interp, cmdpfxObj, &listc, &listv); /* * See [==] as well. @@ -2934,7 +2934,7 @@ TimerRun( *---------------------------------------------------------------------- */ -static void +static inline void ResultInit( ResultBuffer *rPtr) /* Reference to the structure to * initialize. */ @@ -2959,7 +2959,7 @@ ResultInit( *---------------------------------------------------------------------- */ -static void +static inline void ResultClear( ResultBuffer *rPtr) /* Reference to the buffer to clear out */ { @@ -2990,11 +2990,11 @@ ResultClear( *---------------------------------------------------------------------- */ -static void +static inline void ResultAdd( ResultBuffer *rPtr, /* The buffer to extend */ unsigned char *buf, /* The buffer to read from */ - int toWrite) /* The number of bytes in 'buf' */ + size_t toWrite) /* The number of bytes in 'buf' */ { if ((rPtr->used + toWrite + 1) > rPtr->allocated) { /* @@ -3038,11 +3038,11 @@ ResultAdd( *---------------------------------------------------------------------- */ -static int +static inline size_t ResultCopy( ResultBuffer *rPtr, /* The buffer to read from */ unsigned char *buf, /* The buffer to copy into */ - int toRead) /* Number of requested bytes */ + size_t toRead) /* Number of requested bytes */ { int copied; diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index 312fd08..8d5a6db 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -1128,7 +1128,7 @@ Tcl_FSMatchInDirectory( * Note that we know resultPtr and tmpResultPtr are distinct. */ - ret = Tcl_ListObjGetElements(interp, tmpResultPtr, + ret = TclListObjGetElements(interp, tmpResultPtr, &resLength, &elemsPtr); for (i=0 ; ret==TCL_OK && i<resLength ; i++) { ret = Tcl_ListObjAppendElement(interp, resultPtr, @@ -1178,10 +1178,10 @@ FsAddMountsToGlobResult( return; } - if (Tcl_ListObjLength(NULL, mounts, &mLength) != TCL_OK || mLength == 0) { + if (TclListObjLength(NULL, mounts, &mLength) != TCL_OK || mLength == 0) { goto endOfMounts; } - if (Tcl_ListObjLength(NULL, resultPtr, &gLength) != TCL_OK) { + if (TclListObjLength(NULL, resultPtr, &gLength) != TCL_OK) { goto endOfMounts; } for (i=0 ; i<mLength ; i++) { @@ -1775,7 +1775,7 @@ Tcl_FSEvalFileEx( } } - objPtr = Tcl_NewObj(); + TclNewObj(objPtr); Tcl_IncrRefCount(objPtr); /* @@ -1909,7 +1909,7 @@ TclNREvalFile( } } - objPtr = Tcl_NewObj(); + TclNewObj(objPtr); Tcl_IncrRefCount(objPtr); /* @@ -2518,7 +2518,7 @@ TclFSFileAttrIndex( int i, objc; Tcl_Obj **objv; - if (Tcl_ListObjGetElements(NULL, listObj, &objc, &objv) != TCL_OK) { + if (TclListObjGetElements(NULL, listObj, &objc, &objv) != TCL_OK) { TclDecrRefCount(listObj); return TCL_ERROR; } @@ -3878,8 +3878,9 @@ Tcl_Obj * Tcl_FSListVolumes(void) { FilesystemRecord *fsRecPtr; - Tcl_Obj *resultPtr = Tcl_NewObj(); + Tcl_Obj *resultPtr; + TclNewObj(resultPtr); /* * Call each of the "listVolumes" function in succession. A non-NULL * return value indicates the particular function has succeeded. We call @@ -3945,7 +3946,7 @@ FsListMounts( if (fsRecPtr->fsPtr != &tclNativeFilesystem && fsRecPtr->fsPtr->matchInDirectoryProc != NULL) { if (resultPtr == NULL) { - resultPtr = Tcl_NewObj(); + TclNewObj(resultPtr); } fsRecPtr->fsPtr->matchInDirectoryProc(NULL, resultPtr, pathPtr, pattern, &mountsOnly); @@ -4021,7 +4022,7 @@ Tcl_FSSplitPath( * slashes (for example 'ftp://' is a valid vfs drive name) */ - result = Tcl_NewObj(); + TclNewObj(result); p = Tcl_GetString(pathPtr); Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj(p, driveNameLength)); @@ -4191,7 +4192,7 @@ TclFSNonnativePathType( Tcl_Obj *thisFsVolumes = fsRecPtr->fsPtr->listVolumesProc(); if (thisFsVolumes != NULL) { - if (Tcl_ListObjLength(NULL, thisFsVolumes, &numVolumes) + if (TclListObjLength(NULL, thisFsVolumes, &numVolumes) != TCL_OK) { /* * This is VERY bad; the listVolumesProc didn't return a diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index bdcd653..b17b224 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -73,7 +73,7 @@ typedef struct { #define NEXT_ENTRY(table, offset) \ (&(STRING_AT(table, offset))) #define EXPAND_OF(indexRep) \ - STRING_AT((indexRep)->tablePtr, (indexRep)->offset*(indexRep)->index) + (((indexRep)->index >= 0) ? STRING_AT((indexRep)->tablePtr, (indexRep)->offset*(indexRep)->index) : "") /* *---------------------------------------------------------------------- @@ -105,7 +105,7 @@ int Tcl_GetIndexFromObj( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr, /* Object containing the string to lookup. */ - const char *const*tablePtr, /* Array of strings to compare against the + const char *const *tablePtr, /* Array of strings to compare against the * value of objPtr; last entry must be NULL * and there must not be duplicate entries. */ const char *msg, /* Identifying word to use in error @@ -128,7 +128,7 @@ Tcl_GetIndexFromObj( * on odd platforms like a Cray PVP... */ - if (indexRep->tablePtr == (void *) tablePtr + if (indexRep->tablePtr == (void *)tablePtr && indexRep->offset == sizeof(char *)) { *indexPtr = indexRep->index; return TCL_OK; @@ -184,7 +184,7 @@ GetIndexFromObjList( * of the code there. This is a bit ineffiecient but simpler. */ - result = Tcl_ListObjGetElements(interp, tableObjPtr, &objc, &objv); + result = TclListObjGetElements(interp, tableObjPtr, &objc, &objv); if (result != TCL_OK) { return result; } @@ -193,7 +193,7 @@ GetIndexFromObjList( * Build a string table from the list. */ - tablePtr = ckalloc((objc + 1) * sizeof(char *)); + tablePtr = (const char **)ckalloc((objc + 1) * sizeof(char *)); for (t = 0; t < objc; t++) { if (objv[t] == objPtr) { /* @@ -278,9 +278,11 @@ Tcl_GetIndexFromObjStruct( * See if there is a valid cached result from a previous lookup. */ - if (objPtr->typePtr == &indexType) { + if (objPtr && (objPtr->typePtr == &indexType)) { indexRep = objPtr->internalRep.twoPtrValue.ptr1; - if (indexRep->tablePtr==tablePtr && indexRep->offset==offset) { + if ((indexRep->tablePtr == tablePtr) + && (indexRep->offset == offset) + && (indexRep->index >= 0)) { *indexPtr = indexRep->index; return TCL_OK; } @@ -291,7 +293,7 @@ Tcl_GetIndexFromObjStruct( * abbreviations unless TCL_EXACT is set in flags. */ - key = TclGetString(objPtr); + key = objPtr ? TclGetString(objPtr) : ""; index = -1; numAbbrev = 0; @@ -302,7 +304,7 @@ Tcl_GetIndexFromObjStruct( * - Several abbreviations (never allowed, but overridden by exact match) */ - for (entryPtr = tablePtr, idx = 0; *entryPtr != NULL; + for (entryPtr = (const char *const *)tablePtr, idx = 0; *entryPtr != NULL; entryPtr = NEXT_ENTRY(entryPtr, offset), idx++) { for (p1 = key, p2 = *entryPtr; *p1 == *p2; p1++, p2++) { if (*p1 == '\0') { @@ -339,17 +341,19 @@ Tcl_GetIndexFromObjStruct( * operation. */ - if (objPtr->typePtr == &indexType) { - indexRep = objPtr->internalRep.twoPtrValue.ptr1; - } else { - TclFreeIntRep(objPtr); - indexRep = ckalloc(sizeof(IndexRep)); - objPtr->internalRep.twoPtrValue.ptr1 = indexRep; - objPtr->typePtr = &indexType; + if (objPtr && (index >= 0)) { + if (objPtr->typePtr == &indexType) { + indexRep = objPtr->internalRep.twoPtrValue.ptr1; + } else { + TclFreeIntRep(objPtr); + indexRep = ckalloc(sizeof(IndexRep)); + objPtr->internalRep.twoPtrValue.ptr1 = indexRep; + objPtr->typePtr = &indexType; + } + indexRep->tablePtr = (void *) tablePtr; + indexRep->offset = offset; + indexRep->index = index; } - indexRep->tablePtr = (void *) tablePtr; - indexRep->offset = offset; - indexRep->index = index; *indexPtr = index; return TCL_OK; @@ -363,7 +367,7 @@ Tcl_GetIndexFromObjStruct( int count = 0; TclNewObj(resultPtr); - entryPtr = tablePtr; + entryPtr = (const char *const *)tablePtr; while ((*entryPtr != NULL) && !**entryPtr) { entryPtr = NEXT_ENTRY(entryPtr, offset); } @@ -414,7 +418,7 @@ static void UpdateStringOfIndex( Tcl_Obj *objPtr) { - IndexRep *indexRep = objPtr->internalRep.twoPtrValue.ptr1; + IndexRep *indexRep = (IndexRep *)objPtr->internalRep.twoPtrValue.ptr1; char *buf; unsigned len; const char *indexStr = EXPAND_OF(indexRep); @@ -449,8 +453,8 @@ DupIndex( Tcl_Obj *srcPtr, Tcl_Obj *dupPtr) { - IndexRep *srcIndexRep = srcPtr->internalRep.twoPtrValue.ptr1; - IndexRep *dupIndexRep = ckalloc(sizeof(IndexRep)); + IndexRep *srcIndexRep = (IndexRep *)srcPtr->internalRep.twoPtrValue.ptr1; + IndexRep *dupIndexRep = (IndexRep *)ckalloc(sizeof(IndexRep)); memcpy(dupIndexRep, srcIndexRep, sizeof(IndexRep)); dupPtr->internalRep.twoPtrValue.ptr1 = dupIndexRep; @@ -548,7 +552,7 @@ PrefixMatchObjCmd( static const char *const matchOptions[] = { "-error", "-exact", "-message", NULL }; - enum matchOptions { + enum matchOptionsEnum { PRFMATCH_ERROR, PRFMATCH_EXACT, PRFMATCH_MESSAGE }; @@ -562,7 +566,7 @@ PrefixMatchObjCmd( &index) != TCL_OK) { return TCL_ERROR; } - switch ((enum matchOptions) index) { + switch ((enum matchOptionsEnum) index) { case PRFMATCH_EXACT: flags |= TCL_EXACT; break; @@ -584,7 +588,7 @@ PrefixMatchObjCmd( return TCL_ERROR; } i++; - result = Tcl_ListObjLength(interp, objv[i], &errorLength); + result = TclListObjLength(interp, objv[i], &errorLength); if (result != TCL_OK) { return TCL_ERROR; } @@ -608,7 +612,7 @@ PrefixMatchObjCmd( * error case regardless of level. */ - result = Tcl_ListObjLength(interp, tablePtr, &dummyLength); + result = TclListObjLength(interp, tablePtr, &dummyLength); if (result != TCL_OK) { return result; } @@ -673,7 +677,7 @@ PrefixAllObjCmd( return TCL_ERROR; } - result = Tcl_ListObjGetElements(interp, objv[1], &tableObjc, &tableObjv); + result = TclListObjGetElements(interp, objv[1], &tableObjc, &tableObjv); if (result != TCL_OK) { return result; } @@ -730,7 +734,7 @@ PrefixLongestObjCmd( return TCL_ERROR; } - result = Tcl_ListObjGetElements(interp, objv[1], &tableObjc, &tableObjv); + result = TclListObjGetElements(interp, objv[1], &tableObjc, &tableObjv); if (result != TCL_OK) { return result; } @@ -931,8 +935,7 @@ Tcl_WrongNumArgs( len = TclScanElement(elementStr, elemLen, &flags); if (MAY_QUOTE_WORD && len != elemLen) { - char *quotedElementStr = TclStackAlloc(interp, - (unsigned)len + 1); + char *quotedElementStr = (char *)TclStackAlloc(interp, len + 1); len = TclConvertElement(elementStr, elemLen, quotedElementStr, flags); @@ -982,8 +985,7 @@ Tcl_WrongNumArgs( len = TclScanElement(elementStr, elemLen, &flags); if (MAY_QUOTE_WORD && len != elemLen) { - char *quotedElementStr = TclStackAlloc(interp, - (unsigned) len + 1); + char *quotedElementStr = (char *)TclStackAlloc(interp, len + 1); len = TclConvertElement(elementStr, elemLen, quotedElementStr, flags); @@ -1089,7 +1091,7 @@ Tcl_ParseArgsObjv( */ nrem = 1; - leftovers = ckalloc((1 + *objcPtr) * sizeof(Tcl_Obj *)); + leftovers = (Tcl_Obj **)ckalloc((1 + *objcPtr) * sizeof(Tcl_Obj *)); leftovers[0] = objv[0]; } else { nrem = 0; @@ -1273,7 +1275,7 @@ Tcl_ParseArgsObjv( } leftovers[nrem] = NULL; *objcPtr = nrem++; - *remObjv = ckrealloc(leftovers, nrem * sizeof(Tcl_Obj *)); + *remObjv = (Tcl_Obj **)ckrealloc(leftovers, nrem * sizeof(Tcl_Obj *)); return TCL_OK; /* diff --git a/generic/tclInt.h b/generic/tclInt.h index 491abe6..89ce8f0 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -4316,7 +4316,7 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, (objPtr)->bytes = tclEmptyStringRep; \ (objPtr)->length = 0; \ } else { \ - (objPtr)->bytes = (char *) ckalloc((len) + 1); \ + (objPtr)->bytes = (char *) ckalloc((unsigned int)(len) + 1U); \ memcpy((objPtr)->bytes, (bytePtr), (len)); \ (objPtr)->bytes[len] = '\0'; \ (objPtr)->length = (len); \ @@ -4958,7 +4958,7 @@ typedef struct NRE_callback { #define TCLNR_FREE(interp, ptr) TclSmallFreeEx((interp), (ptr)) #else #define TCLNR_ALLOC(interp, ptr) \ - (ptr = ((ClientData) ckalloc(sizeof(NRE_callback)))) + ((ptr) = ((void *)ckalloc(sizeof(NRE_callback)))) #define TCLNR_FREE(interp, ptr) ckfree((char *) (ptr)) #endif diff --git a/generic/tclInterp.c b/generic/tclInterp.c index 4f5b300..11202ce 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -1021,7 +1021,7 @@ NRInterpCmd( return TCL_ERROR; } iiPtr = (InterpInfo *) ((Interp *) childInterp)->interpInfo; - resultPtr = Tcl_NewObj(); + TclNewObj(resultPtr); hPtr = Tcl_FirstHashEntry(&iiPtr->parent.childTable, &hashSearch); for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&hashSearch)) { string = Tcl_GetHashKey(&iiPtr->parent.childTable, hPtr); @@ -1748,10 +1748,11 @@ AliasList( { Tcl_HashEntry *entryPtr; Tcl_HashSearch hashSearch; - Tcl_Obj *resultPtr = Tcl_NewObj(); + Tcl_Obj *resultPtr; Alias *aliasPtr; Child *childPtr; + TclNewObj(resultPtr); childPtr = &((InterpInfo *) ((Interp *) childInterp)->interpInfo)->child; entryPtr = Tcl_FirstHashEntry(&childPtr->aliasTable, &hashSearch); @@ -2325,7 +2326,7 @@ ChildCreate( int isNew, objc; Tcl_Obj **objv; - if (Tcl_ListObjGetElements(interp, pathPtr, &objc, &objv) != TCL_OK) { + if (TclListObjGetElements(interp, pathPtr, &objc, &objv) != TCL_OK) { return NULL; } if (objc < 2) { @@ -2725,7 +2726,7 @@ ChildDebugCmd( iPtr = (Interp *) childInterp; if (objc == 0) { - resultPtr = Tcl_NewObj(); + TclNewObj(resultPtr); Tcl_ListObjAppendElement(NULL, resultPtr, Tcl_NewStringObj("-frame", -1)); Tcl_ListObjAppendElement(NULL, resultPtr, @@ -2994,11 +2995,12 @@ ChildHidden( Tcl_Interp *interp, /* Interp for data return. */ Tcl_Interp *childInterp) /* Interp whose hidden commands to query. */ { - Tcl_Obj *listObjPtr = Tcl_NewObj(); /* Local object pointer. */ + Tcl_Obj *listObjPtr; /* Local object pointer. */ Tcl_HashTable *hTblPtr; /* For local searches. */ Tcl_HashEntry *hPtr; /* For local searches. */ Tcl_HashSearch hSearch; /* For local searches. */ + TclNewObj(listObjPtr); hTblPtr = ((Interp *) childInterp)->hiddenCmdTablePtr; if (hTblPtr != NULL) { for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch); diff --git a/generic/tclMain.c b/generic/tclMain.c index f0b2682..3f72838 100644 --- a/generic/tclMain.c +++ b/generic/tclMain.c @@ -28,7 +28,7 @@ * The default prompt used when the user has not overridden it. */ -#define DEFAULT_PRIMARY_PROMPT "% " +static const char DEFAULT_PRIMARY_PROMPT[] = "% "; /* * This file can be compiled on Windows in UNICODE mode, as well as on all @@ -95,7 +95,7 @@ typedef enum { PROMPT_CONTINUE /* Print prompt for command continuation */ } PromptType; -typedef struct InteractiveState { +typedef struct { Tcl_Channel input; /* The standard input channel from which lines * are read. */ int tty; /* Non-zero means standard input is a @@ -229,7 +229,7 @@ Tcl_SourceRCFile( const char *fileName; Tcl_Channel chan; - fileName = Tcl_GetVar(interp, "tcl_rcFileName", TCL_GLOBAL_ONLY); + fileName = Tcl_GetVar2(interp, "tcl_rcFileName", NULL, TCL_GLOBAL_ONLY); if (fileName != NULL) { Tcl_Channel c; const char *fullName; @@ -515,7 +515,7 @@ Tcl_MainEx( * error messages troubles deeper in, so lop it back off. */ - Tcl_GetStringFromObj(is.commandPtr, &length); + (void)Tcl_GetStringFromObj(is.commandPtr, &length); Tcl_SetObjLength(is.commandPtr, --length); code = Tcl_RecordAndEvalObj(interp, is.commandPtr, TCL_EVAL_GLOBAL); @@ -532,7 +532,7 @@ Tcl_MainEx( } else if (is.tty) { resultPtr = Tcl_GetObjResult(interp); Tcl_IncrRefCount(resultPtr); - Tcl_GetStringFromObj(resultPtr, &length); + (void)Tcl_GetStringFromObj(resultPtr, &length); chan = Tcl_GetStdChannel(TCL_STDOUT); if ((length > 0) && chan) { Tcl_WriteObj(chan, resultPtr); @@ -745,17 +745,18 @@ TclFullFinalizationRequested(void) *---------------------------------------------------------------------- */ - /* ARGSUSED */ static void StdinProc( ClientData clientData, /* The state of interactive cmd line */ int mask) /* Not used. */ { - int code, length; - InteractiveState *isPtr = clientData; + int code; + int length; + InteractiveState *isPtr = (InteractiveState *)clientData; Tcl_Channel chan = isPtr->input; Tcl_Obj *commandPtr = isPtr->commandPtr; Tcl_Interp *interp = isPtr->interp; + (void)mask; if (Tcl_IsShared(commandPtr)) { Tcl_DecrRefCount(commandPtr); @@ -791,7 +792,7 @@ StdinProc( goto prompt; } isPtr->prompt = PROMPT_START; - Tcl_GetStringFromObj(commandPtr, &length); + (void)Tcl_GetStringFromObj(commandPtr, &length); Tcl_SetObjLength(commandPtr, --length); /* @@ -823,7 +824,7 @@ StdinProc( chan = Tcl_GetStdChannel(TCL_STDOUT); Tcl_IncrRefCount(resultPtr); - Tcl_GetStringFromObj(resultPtr, &length); + (void)Tcl_GetStringFromObj(resultPtr, &length); if ((length > 0) && (chan != NULL)) { Tcl_WriteObj(chan, resultPtr); Tcl_WriteChars(chan, "\n", 1); @@ -886,7 +887,7 @@ Prompt( chan = Tcl_GetStdChannel(TCL_STDOUT); if (chan != NULL) { Tcl_WriteChars(chan, DEFAULT_PRIMARY_PROMPT, - strlen(DEFAULT_PRIMARY_PROMPT)); + sizeof(DEFAULT_PRIMARY_PROMPT) - 1); } } } else { @@ -925,7 +926,7 @@ static void FreeMainInterp( ClientData clientData) { - Tcl_Interp *interp = clientData; + Tcl_Interp *interp = (Tcl_Interp *)clientData; /*if (TclInExit()) return;*/ diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index bea0043..eccca78 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -4998,7 +4998,7 @@ TclLogCommandInfo( int len; iPtr->resetErrorStack = 0; - Tcl_ListObjLength(interp, iPtr->errorStack, &len); + TclListObjLength(interp, iPtr->errorStack, &len); /* * Reset while keeping the list internalrep as much as possible. @@ -5083,7 +5083,7 @@ TclErrorStackResetIf( int len; iPtr->resetErrorStack = 0; - Tcl_ListObjLength(interp, iPtr->errorStack, &len); + TclListObjLength(interp, iPtr->errorStack, &len); /* * Reset while keeping the list internalrep as much as possible. diff --git a/generic/tclOO.c b/generic/tclOO.c index 053abfe..9a32543 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -2925,7 +2925,7 @@ TclOOObjectName( if (oPtr->cachedNameObj) { return oPtr->cachedNameObj; } - namePtr = Tcl_NewObj(); + TclNewObj(namePtr); Tcl_GetCommandFullName(interp, oPtr->command, namePtr); Tcl_IncrRefCount(namePtr); oPtr->cachedNameObj = namePtr; diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c index b7f70e7..e746b64 100644 --- a/generic/tclOOBasic.c +++ b/generic/tclOOBasic.c @@ -727,7 +727,7 @@ TclOO_Object_VarName( * (including traversing variable links), convert back to a name. */ - varNamePtr = Tcl_NewObj(); + TclNewObj(varNamePtr); if (aryVar != NULL) { Tcl_HashEntry *hPtr; Tcl_HashSearch search; diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c index aeee165..4b97740 100644 --- a/generic/tclOODefineCmds.c +++ b/generic/tclOODefineCmds.c @@ -850,8 +850,8 @@ MagicDefinitionInvoke( * comments above for why these contortions are necessary. */ - objPtr = Tcl_NewObj(); - obj2Ptr = Tcl_NewObj(); + TclNewObj(objPtr); + TclNewObj(obj2Ptr); cmd = FindCommand(interp, objv[cmdIndex], nsPtr); if (cmd == NULL) { /* @@ -865,7 +865,7 @@ MagicDefinitionInvoke( Tcl_ListObjAppendElement(NULL, objPtr, obj2Ptr); /* TODO: overflow? */ Tcl_ListObjReplace(NULL, objPtr, 1, 0, objc - offset, objv + offset); - Tcl_ListObjGetElements(NULL, objPtr, &dummy, &objs); + TclListObjGetElements(NULL, objPtr, &dummy, &objs); result = Tcl_EvalObjv(interp, objc - cmdIndex, objs, TCL_EVAL_INVOKE); if (isRoot) { @@ -1874,7 +1874,7 @@ ClassFilterGet( return TCL_ERROR; } - resultObj = Tcl_NewObj(); + TclNewObj(resultObj); FOREACH(filterObj, oPtr->classPtr->filters) { Tcl_ListObjAppendElement(NULL, resultObj, filterObj); } @@ -1908,7 +1908,7 @@ ClassFilterSet( "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; - } else if (Tcl_ListObjGetElements(interp, objv[0], &filterc, + } else if (TclListObjGetElements(interp, objv[0], &filterc, &filterv) != TCL_OK) { return TCL_ERROR; } @@ -1954,7 +1954,7 @@ ClassMixinGet( return TCL_ERROR; } - resultObj = Tcl_NewObj(); + TclNewObj(resultObj); FOREACH(mixinPtr, oPtr->classPtr->mixins) { Tcl_ListObjAppendElement(NULL, resultObj, TclOOObjectName(interp, mixinPtr->thisPtr)); @@ -1991,7 +1991,7 @@ ClassMixinSet( "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; - } else if (Tcl_ListObjGetElements(interp, objv[0], &mixinc, + } else if (TclListObjGetElements(interp, objv[0], &mixinc, &mixinv) != TCL_OK) { return TCL_ERROR; } @@ -2059,7 +2059,7 @@ ClassSuperGet( return TCL_ERROR; } - resultObj = Tcl_NewObj(); + TclNewObj(resultObj); FOREACH(superPtr, oPtr->classPtr->superclasses) { Tcl_ListObjAppendElement(NULL, resultObj, TclOOObjectName(interp, superPtr->thisPtr)); @@ -2100,7 +2100,7 @@ ClassSuperSet( "may not modify the superclass of the root object", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; - } else if (Tcl_ListObjGetElements(interp, objv[0], &superc, + } else if (TclListObjGetElements(interp, objv[0], &superc, &superv) != TCL_OK) { return TCL_ERROR; } @@ -2224,7 +2224,7 @@ ClassVarsGet( return TCL_ERROR; } - resultObj = Tcl_NewObj(); + TclNewObj(resultObj); FOREACH(variableObj, oPtr->classPtr->variables) { Tcl_ListObjAppendElement(NULL, resultObj, variableObj); } @@ -2259,7 +2259,7 @@ ClassVarsSet( "attempt to misuse API", -1)); Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL); return TCL_ERROR; - } else if (Tcl_ListObjGetElements(interp, objv[0], &varc, + } else if (TclListObjGetElements(interp, objv[0], &varc, &varv) != TCL_OK) { return TCL_ERROR; } @@ -2360,7 +2360,7 @@ ObjFilterGet( return TCL_ERROR; } - resultObj = Tcl_NewObj(); + TclNewObj(resultObj); FOREACH(filterObj, oPtr->filters) { Tcl_ListObjAppendElement(NULL, resultObj, filterObj); } @@ -2388,7 +2388,7 @@ ObjFilterSet( return TCL_ERROR; } objv += Tcl_ObjectContextSkippedArgs(context); - if (Tcl_ListObjGetElements(interp, objv[0], &filterc, + if (TclListObjGetElements(interp, objv[0], &filterc, &filterv) != TCL_OK) { return TCL_ERROR; } @@ -2428,7 +2428,7 @@ ObjMixinGet( return TCL_ERROR; } - resultObj = Tcl_NewObj(); + TclNewObj(resultObj); FOREACH(mixinPtr, oPtr->mixins) { if (mixinPtr) { Tcl_ListObjAppendElement(NULL, resultObj, @@ -2461,7 +2461,7 @@ ObjMixinSet( return TCL_ERROR; } objv += Tcl_ObjectContextSkippedArgs(context); - if (Tcl_ListObjGetElements(interp, objv[0], &mixinc, + if (TclListObjGetElements(interp, objv[0], &mixinc, &mixinv) != TCL_OK) { return TCL_ERROR; } @@ -2512,7 +2512,7 @@ ObjVarsGet( return TCL_ERROR; } - resultObj = Tcl_NewObj(); + TclNewObj(resultObj); FOREACH(variableObj, oPtr->variables) { Tcl_ListObjAppendElement(NULL, resultObj, variableObj); } @@ -2540,7 +2540,7 @@ ObjVarsSet( return TCL_ERROR; } objv += Tcl_ObjectContextSkippedArgs(context); - if (Tcl_ListObjGetElements(interp, objv[0], &varc, + if (TclListObjGetElements(interp, objv[0], &varc, &varv) != TCL_OK) { return TCL_ERROR; } diff --git a/generic/tclOOInfo.c b/generic/tclOOInfo.c index 4b25c1a..9f1233c 100644 --- a/generic/tclOOInfo.c +++ b/generic/tclOOInfo.c @@ -266,13 +266,13 @@ InfoObjectDefnCmd( return TCL_ERROR; } - resultObjs[0] = Tcl_NewObj(); + TclNewObj(resultObjs[0]); for (localPtr=procPtr->firstLocalPtr; localPtr!=NULL; localPtr=localPtr->nextPtr) { if (TclIsVarArgument(localPtr)) { Tcl_Obj *argObj; - argObj = Tcl_NewObj(); + TclNewObj(argObj); Tcl_ListObjAppendElement(NULL, argObj, Tcl_NewStringObj(localPtr->name, -1)); if (localPtr->defValuePtr != NULL) { @@ -316,7 +316,7 @@ InfoObjectFiltersCmd( if (oPtr == NULL) { return TCL_ERROR; } - resultObj = Tcl_NewObj(); + TclNewObj(resultObj); FOREACH(filterObj, oPtr->filters) { Tcl_ListObjAppendElement(NULL, resultObj, filterObj); @@ -560,7 +560,7 @@ InfoObjectMethodsCmd( } } - resultObj = Tcl_NewObj(); + TclNewObj(resultObj); if (recurse) { const char **names; int i, numNames = TclOOGetSortedMethodList(oPtr, flag, &names); @@ -671,7 +671,7 @@ InfoObjectMixinsCmd( return TCL_ERROR; } - resultObj = Tcl_NewObj(); + TclNewObj(resultObj); FOREACH(mixinPtr, oPtr->mixins) { if (!mixinPtr) { continue; @@ -746,7 +746,7 @@ InfoObjectVariablesCmd( return TCL_ERROR; } - resultObj = Tcl_NewObj(); + TclNewObj(resultObj); FOREACH(variableObj, oPtr->variables) { Tcl_ListObjAppendElement(NULL, resultObj, variableObj); } @@ -788,7 +788,7 @@ InfoObjectVarsCmd( if (objc == 3) { pattern = TclGetString(objv[2]); } - resultObj = Tcl_NewObj(); + TclNewObj(resultObj); /* * Extract the information we need from the object's namespace's table of @@ -856,13 +856,13 @@ InfoClassConstrCmd( return TCL_ERROR; } - resultObjs[0] = Tcl_NewObj(); + TclNewObj(resultObjs[0]); for (localPtr=procPtr->firstLocalPtr; localPtr!=NULL; localPtr=localPtr->nextPtr) { if (TclIsVarArgument(localPtr)) { Tcl_Obj *argObj; - argObj = Tcl_NewObj(); + TclNewObj(argObj); Tcl_ListObjAppendElement(NULL, argObj, Tcl_NewStringObj(localPtr->name, -1)); if (localPtr->defValuePtr != NULL) { @@ -924,13 +924,13 @@ InfoClassDefnCmd( return TCL_ERROR; } - resultObjs[0] = Tcl_NewObj(); + TclNewObj(resultObjs[0]); for (localPtr=procPtr->firstLocalPtr; localPtr!=NULL; localPtr=localPtr->nextPtr) { if (TclIsVarArgument(localPtr)) { Tcl_Obj *argObj; - argObj = Tcl_NewObj(); + TclNewObj(argObj); Tcl_ListObjAppendElement(NULL, argObj, Tcl_NewStringObj(localPtr->name, -1)); if (localPtr->defValuePtr != NULL) { @@ -1018,7 +1018,7 @@ InfoClassFiltersCmd( return TCL_ERROR; } - resultObj = Tcl_NewObj(); + TclNewObj(resultObj); FOREACH(filterObj, clsPtr->filters) { Tcl_ListObjAppendElement(NULL, resultObj, filterObj); } @@ -1112,7 +1112,7 @@ InfoClassInstancesCmd( pattern = TclGetString(objv[2]); } - resultObj = Tcl_NewObj(); + TclNewObj(resultObj); FOREACH(oPtr, clsPtr->instances) { Tcl_Obj *tmpObj = TclOOObjectName(interp, oPtr); @@ -1183,7 +1183,7 @@ InfoClassMethodsCmd( } } - resultObj = Tcl_NewObj(); + TclNewObj(resultObj); if (recurse) { const char **names; int i, numNames = TclOOGetSortedClassMethodList(clsPtr, flag, &names); @@ -1290,7 +1290,7 @@ InfoClassMixinsCmd( return TCL_ERROR; } - resultObj = Tcl_NewObj(); + TclNewObj(resultObj); FOREACH(mixinPtr, clsPtr->mixins) { if (!mixinPtr) { continue; @@ -1336,7 +1336,7 @@ InfoClassSubsCmd( pattern = TclGetString(objv[2]); } - resultObj = Tcl_NewObj(); + TclNewObj(resultObj); FOREACH(subclassPtr, clsPtr->subclasses) { Tcl_Obj *tmpObj = TclOOObjectName(interp, subclassPtr->thisPtr); @@ -1387,7 +1387,7 @@ InfoClassSupersCmd( return TCL_ERROR; } - resultObj = Tcl_NewObj(); + TclNewObj(resultObj); FOREACH(superPtr, clsPtr->superclasses) { Tcl_ListObjAppendElement(NULL, resultObj, TclOOObjectName(interp, superPtr->thisPtr)); @@ -1426,7 +1426,7 @@ InfoClassVariablesCmd( return TCL_ERROR; } - resultObj = Tcl_NewObj(); + TclNewObj(resultObj); FOREACH(variableObj, clsPtr->variables) { Tcl_ListObjAppendElement(NULL, resultObj, variableObj); } diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h index 44316ac..f061bc6 100644 --- a/generic/tclOOInt.h +++ b/generic/tclOOInt.h @@ -561,7 +561,7 @@ MODULE_SCOPE void TclOOSetupVariableResolver(Tcl_Namespace *nsPtr); #define FOREACH(var,ary) \ for(i=0 ; i<(ary).num; i++) if ((ary).list[i] == NULL) { \ continue; \ - } else if (var = (ary).list[i], 1) + } else if ((var) = (ary).list[i], 1) /* * Convenience macros for iterating through hash tables. FOREACH_HASH_DECLS diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c index cd3c2c2..717aa09 100644 --- a/generic/tclOOMethod.c +++ b/generic/tclOOMethod.c @@ -339,7 +339,7 @@ TclOONewProcInstanceMethod( ProcedureMethod *pmPtr; Tcl_Method method; - if (Tcl_ListObjLength(interp, argsObj, &argsLen) != TCL_OK) { + if (TclListObjLength(interp, argsObj, &argsLen) != TCL_OK) { return NULL; } pmPtr = ckalloc(sizeof(ProcedureMethod)); @@ -394,10 +394,10 @@ TclOONewProcMethod( if (argsObj == NULL) { argsLen = -1; - argsObj = Tcl_NewObj(); + TclNewObj(argsObj); Tcl_IncrRefCount(argsObj); procName = "<destructor>"; - } else if (Tcl_ListObjLength(interp, argsObj, &argsLen) != TCL_OK) { + } else if (TclListObjLength(interp, argsObj, &argsLen) != TCL_OK) { return NULL; } else { procName = (nameObj==NULL ? "<constructor>" : TclGetString(nameObj)); @@ -1293,12 +1293,13 @@ CloneProcedureMethod( * Copy the argument list. */ - argsObj = Tcl_NewObj(); + TclNewObj(argsObj); for (localPtr=pmPtr->procPtr->firstLocalPtr; localPtr!=NULL; localPtr=localPtr->nextPtr) { if (TclIsVarArgument(localPtr)) { - Tcl_Obj *argObj = Tcl_NewObj(); + Tcl_Obj *argObj; + TclNewObj(argObj); Tcl_ListObjAppendElement(NULL, argObj, Tcl_NewStringObj(localPtr->name, -1)); if (localPtr->defValuePtr != NULL) { @@ -1366,7 +1367,7 @@ TclOONewForwardInstanceMethod( int prefixLen; ForwardMethod *fmPtr; - if (Tcl_ListObjLength(interp, prefixObj, &prefixLen) != TCL_OK) { + if (TclListObjLength(interp, prefixObj, &prefixLen) != TCL_OK) { return NULL; } if (prefixLen < 1) { @@ -1405,7 +1406,7 @@ TclOONewForwardMethod( int prefixLen; ForwardMethod *fmPtr; - if (Tcl_ListObjLength(interp, prefixObj, &prefixLen) != TCL_OK) { + if (TclListObjLength(interp, prefixObj, &prefixLen) != TCL_OK) { return NULL; } if (prefixLen < 1) { @@ -1453,7 +1454,7 @@ InvokeForwardMethod( * can ignore here. */ - Tcl_ListObjGetElements(NULL, fmPtr->prefixObj, &numPrefixes, &prefixObjs); + TclListObjGetElements(NULL, fmPtr->prefixObj, &numPrefixes, &prefixObjs); argObjs = InitEnsembleRewrite(interp, objc, objv, skip, numPrefixes, prefixObjs, &len); Tcl_NRAddCallback(interp, FinalizeForwardCall, argObjs, NULL, NULL, NULL); diff --git a/generic/tclObj.c b/generic/tclObj.c index 0950dcd..9afcedb 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -576,7 +576,7 @@ TclContinuationsEnter( ThreadSpecificData *tsdPtr = TclGetContLineTable(); Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(tsdPtr->lineCLPtr, objPtr, &newEntry); - ContLineLoc *clLocPtr = (ContLineLoc *)ckalloc(TclOffset(ContLineLoc, loc) + (num + 1) *sizeof(int)); + ContLineLoc *clLocPtr = (ContLineLoc *)ckalloc(TclOffset(ContLineLoc, loc) + (num + 1U) *sizeof(int)); if (!newEntry) { /* @@ -2816,7 +2816,7 @@ Tcl_GetLongFromObj( value = (value << CHAR_BIT) | *bytes++; } if (big.sign) { - *longPtr = - (long) value; + *longPtr = (long) (-value); } else { *longPtr = (long) value; } @@ -3116,7 +3116,7 @@ Tcl_GetWideIntFromObj( value = (value << CHAR_BIT) | *bytes++; } if (big.sign) { - *wideIntPtr = - (Tcl_WideInt) value; + *wideIntPtr = (Tcl_WideInt) (-value); } else { *wideIntPtr = (Tcl_WideInt) value; } @@ -3547,7 +3547,7 @@ Tcl_SetBignumObj( goto tooLargeForLong; } if (bignumValue->sign) { - TclSetLongObj(objPtr, -(long)value); + TclSetLongObj(objPtr, (long)(-value)); } else { TclSetLongObj(objPtr, (long)value); } @@ -3569,11 +3569,11 @@ Tcl_SetBignumObj( while (numBytes-- > 0) { value = (value << CHAR_BIT) | *bytes++; } - if (value > (((~(Tcl_WideUInt)0) >> 1) + bignumValue->sign)) { + if (value > ((UWIDE_MAX >> 1) + bignumValue->sign)) { goto tooLargeForWide; } if (bignumValue->sign) { - TclSetWideIntObj(objPtr, -(Tcl_WideInt)value); + TclSetWideIntObj(objPtr, (Tcl_WideInt)(-value)); } else { TclSetWideIntObj(objPtr, (Tcl_WideInt)value); } diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index d919c40..372a30d 100644 --- a/generic/tclPathObj.c +++ b/generic/tclPathObj.c @@ -743,7 +743,7 @@ TclPathPart( (Tcl_FSGetPathType(pathPtr) == TCL_PATH_RELATIVE))) { Tcl_ListObjIndex(NULL, splitPtr, splitElements-1, &resultPtr); } else { - resultPtr = Tcl_NewObj(); + TclNewObj(resultPtr); } } else { /* @@ -781,7 +781,7 @@ GetExtension( tail = TclGetString(pathPtr); extension = TclGetExtension(tail); if (extension == NULL) { - ret = Tcl_NewObj(); + TclNewObj(ret); } else { ret = Tcl_NewStringObj(extension, -1); } @@ -833,12 +833,12 @@ Tcl_FSJoinPath( int objc; Tcl_Obj **objv; - if (Tcl_ListObjLength(NULL, listObj, &objc) != TCL_OK) { + if (TclListObjLength(NULL, listObj, &objc) != TCL_OK) { return NULL; } elements = ((elements >= 0) && (elements <= objc)) ? elements : objc; - Tcl_ListObjGetElements(NULL, listObj, &objc, &objv); + TclListObjGetElements(NULL, listObj, &objc, &objv); res = TclJoinPath(elements, objv, 0); return res; } @@ -857,7 +857,8 @@ TclJoinPath( assert ( elements >= 0 ); if (elements == 0) { - return Tcl_NewObj(); + TclNewObj(res); + return res; } assert ( elements > 0 ); @@ -1056,7 +1057,7 @@ TclJoinPath( noQuickReturn: if (res == NULL) { - res = Tcl_NewObj(); + TclNewObj(res); ptr = Tcl_GetStringFromObj(res, &length); } else { ptr = Tcl_GetStringFromObj(res, &length); @@ -1317,7 +1318,7 @@ TclNewFSPathObj( return pathPtr; } - pathPtr = Tcl_NewObj(); + TclNewObj(pathPtr); fsPathPtr = ckalloc(sizeof(FsPath)); /* @@ -2448,7 +2449,7 @@ SetFsPathFromAny( Tcl_Obj **objv; Tcl_Obj *parts = TclpNativeSplitPath(pathPtr, NULL); - Tcl_ListObjGetElements(NULL, parts, &objc, &objv); + TclListObjGetElements(NULL, parts, &objc, &objv); /* * Skip '~'. It's replaced by its expansion. diff --git a/generic/tclPipe.c b/generic/tclPipe.c index 7d5fab0..f5c82f1 100644 --- a/generic/tclPipe.c +++ b/generic/tclPipe.c @@ -371,7 +371,7 @@ TclCleanupChildren( Tcl_Obj *objPtr; Tcl_Seek(errorChan, (Tcl_WideInt)0, SEEK_SET); - objPtr = Tcl_NewObj(); + TclNewObj(objPtr); count = Tcl_ReadChars(errorChan, objPtr, -1, 0); if (count < 0) { result = TCL_ERROR; diff --git a/generic/tclPkg.c b/generic/tclPkg.c index 2150c31..35ec1a3 100644 --- a/generic/tclPkg.c +++ b/generic/tclPkg.c @@ -1014,7 +1014,7 @@ TclNRPackageObjCmd( } else { Tcl_Obj *resultObj; - resultObj = Tcl_NewObj(); + TclNewObj(resultObj); tablePtr = &iPtr->packageTable; for (hPtr = Tcl_FirstHashEntry(tablePtr, &search); hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) { @@ -1132,7 +1132,7 @@ TclNRPackageObjCmd( objvListPtr = Tcl_NewListObj(0, NULL); Tcl_IncrRefCount(objvListPtr); Tcl_ListObjAppendElement(interp, objvListPtr, ov); - Tcl_ListObjGetElements(interp, objvListPtr, &newobjc, &newObjvPtr); + TclListObjGetElements(interp, objvListPtr, &newobjc, &newObjvPtr); Tcl_NRAddCallback(interp, TclNRPackageObjCmdCleanup, objv[3], objvListPtr, NULL, NULL); Tcl_NRAddCallback(interp, PkgRequireCore, (void *)argv3, INT2PTR(newobjc), newObjvPtr, NULL); @@ -1156,7 +1156,7 @@ TclNRPackageObjCmd( Tcl_ListObjAppendElement(interp, objvListPtr, Tcl_DuplicateObj(newobjv[i])); } - Tcl_ListObjGetElements(interp, objvListPtr, &newobjc, &newObjvPtr); + TclListObjGetElements(interp, objvListPtr, &newobjc, &newObjvPtr); Tcl_NRAddCallback(interp, TclNRPackageObjCmdCleanup, objv[2], objvListPtr, NULL, NULL); Tcl_NRAddCallback(interp, PkgRequireCore, (void *)argv2, INT2PTR(newobjc), newObjvPtr, NULL); return TCL_OK; @@ -1257,8 +1257,9 @@ TclNRPackageObjCmd( Tcl_WrongNumArgs(interp, 2, objv, "package"); return TCL_ERROR; } else { - Tcl_Obj *resultObj = Tcl_NewObj(); + Tcl_Obj *resultObj; + TclNewObj(resultObj); argv2 = TclGetString(objv[2]); hPtr = Tcl_FindHashEntry(&iPtr->packageTable, argv2); if (hPtr != NULL) { diff --git a/generic/tclProc.c b/generic/tclProc.c index 642294c..59153b8 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -452,7 +452,7 @@ TclCreateProc( * in the Proc. */ - result = Tcl_ListObjGetElements(interp, argsPtr, &numArgs, &argArray); + result = TclListObjGetElements(interp, argsPtr, &numArgs, &argArray); if (result != TCL_OK) { goto procError; } @@ -482,7 +482,7 @@ TclCreateProc( * Now divide the specifier up into name and default. */ - result = Tcl_ListObjGetElements(interp, argArray[i], &fieldCount, + result = TclListObjGetElements(interp, argArray[i], &fieldCount, &fieldValues); if (result != TCL_OK) { goto procError; @@ -600,7 +600,7 @@ TclCreateProc( */ localPtr = (CompiledLocal *)ckalloc( - TclOffset(CompiledLocal, name) + fieldValues[0]->length + 1); + TclOffset(CompiledLocal, name) + 1U + fieldValues[0]->length); if (procPtr->firstLocalPtr == NULL) { procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr; } else { @@ -913,7 +913,7 @@ TclNRUplevelObjCmd( return TCL_ERROR; } else if (!TclHasStringRep(objv[1]) && objc == 2) { int status ,llength; - status = Tcl_ListObjLength(interp, objv[1], &llength); + status = TclListObjLength(interp, objv[1], &llength); if (status == TCL_OK && llength > 1) { /* the first argument can't interpreted as a level. Avoid * generating a string representation of the script. */ @@ -1428,7 +1428,6 @@ InitArgsAndLocals( numArgs = procPtr->numArgs; argCt = framePtr->objc - skip; /* Set it to the number of args to the * procedure. */ - argObjs = framePtr->objv + skip; if (numArgs == 0) { if (argCt) { goto incorrectArgs; @@ -1436,6 +1435,7 @@ InitArgsAndLocals( goto correctArgs; } } + argObjs = framePtr->objv + skip; imax = ((argCt < numArgs-1) ? argCt : numArgs-1); for (i = 0; i < imax; i++, varPtr++, defPtr ? defPtr++ : defPtr) { /* diff --git a/generic/tclRegexp.c b/generic/tclRegexp.c index 2070956..bd923ba 100644 --- a/generic/tclRegexp.c +++ b/generic/tclRegexp.c @@ -677,7 +677,7 @@ TclRegAbout( * well and Tcl has other limits that constrain things as well... */ - resultObj = Tcl_NewObj(); + TclNewObj(resultObj); Tcl_ListObjAppendElement(NULL, resultObj, Tcl_NewIntObj((int) regexpPtr->re.re_nsub)); diff --git a/generic/tclResult.c b/generic/tclResult.c index b1cf9ee..f82e6a4 100644 --- a/generic/tclResult.c +++ b/generic/tclResult.c @@ -245,7 +245,7 @@ Tcl_SaveResult( */ statePtr->objResultPtr = iPtr->objResultPtr; - iPtr->objResultPtr = Tcl_NewObj(); + TclNewObj(iPtr->objResultPtr); Tcl_IncrRefCount(iPtr->objResultPtr); /* @@ -1026,13 +1026,14 @@ Tcl_SetErrorCodeVA( Tcl_Interp *interp, /* Interpreter in which to set errorCode */ va_list argList) /* Variable argument list. */ { - Tcl_Obj *errorObj = Tcl_NewObj(); + Tcl_Obj *errorObj; /* * Scan through the arguments one at a time, appending them to the * errorCode field as list elements. */ + TclNewObj(errorObj); while (1) { char *elem = va_arg(argList, char *); @@ -1314,12 +1315,12 @@ TclProcessReturn( * if someone does [return -errorstack [info errorstack]] */ - if (Tcl_ListObjGetElements(interp, valuePtr, &valueObjc, + if (TclListObjGetElements(interp, valuePtr, &valueObjc, &valueObjv) == TCL_ERROR) { return TCL_ERROR; } iPtr->resetErrorStack = 0; - Tcl_ListObjLength(interp, iPtr->errorStack, &len); + TclListObjLength(interp, iPtr->errorStack, &len); /* * Reset while keeping the list internalrep as much as possible. @@ -1387,9 +1388,10 @@ TclMergeReturnOptions( int code = TCL_OK; int level = 1; Tcl_Obj *valuePtr; - Tcl_Obj *returnOpts = Tcl_NewObj(); + Tcl_Obj *returnOpts; Tcl_Obj **keys = GetKeys(); + TclNewObj(returnOpts); for (; objc > 1; objv += 2, objc -= 2) { int optLen; const char *opt = TclGetStringFromObj(objv[0], &optLen); @@ -1477,7 +1479,7 @@ TclMergeReturnOptions( if (valuePtr != NULL) { int length; - if (TCL_ERROR == Tcl_ListObjLength(NULL, valuePtr, &length )) { + if (TCL_ERROR == TclListObjLength(NULL, valuePtr, &length )) { /* * Value is not a list, which is illegal for -errorcode. */ @@ -1499,7 +1501,7 @@ TclMergeReturnOptions( if (valuePtr != NULL) { int length; - if (TCL_ERROR == Tcl_ListObjLength(NULL, valuePtr, &length )) { + if (TCL_ERROR == TclListObjLength(NULL, valuePtr, &length )) { /* * Value is not a list, which is illegal for -errorstack. */ @@ -1585,7 +1587,7 @@ Tcl_GetReturnOptions( if (iPtr->returnOpts) { options = Tcl_DuplicateObj(iPtr->returnOpts); } else { - options = Tcl_NewObj(); + TclNewObj(options); } if (result == TCL_RETURN) { diff --git a/generic/tclScan.c b/generic/tclScan.c index 6ab17bd..f37f596 100644 --- a/generic/tclScan.c +++ b/generic/tclScan.c @@ -28,15 +28,17 @@ * character set. */ -typedef struct CharSet { +typedef struct { + Tcl_UniChar start; + Tcl_UniChar end; +} Range; + +typedef struct { int exclude; /* 1 if this is an exclusion set. */ int nchars; Tcl_UniChar *chars; int nranges; - struct Range { - Tcl_UniChar start; - Tcl_UniChar end; - } *ranges; + Range *ranges; } CharSet; /* @@ -101,9 +103,9 @@ BuildCharSet( end += TclUtfToUniChar(end, &ch); } - cset->chars = ckalloc(sizeof(Tcl_UniChar) * (end - format - 1)); + cset->chars = (Tcl_UniChar *)ckalloc(sizeof(Tcl_UniChar) * (end - format - 1)); if (nranges > 0) { - cset->ranges = ckalloc(sizeof(struct Range) * nranges); + cset->ranges = (Range *)ckalloc(sizeof(Range) * nranges); } else { cset->ranges = NULL; } @@ -259,12 +261,12 @@ ValidateFormat( char *end; Tcl_UniChar ch = 0; int objIndex, xpgSize, nspace = numVars; - int *nassign = TclStackAlloc(interp, nspace * sizeof(int)); - char buf[TCL_UTF_MAX+1] = ""; + int *nassign = (int *)TclStackAlloc(interp, nspace * sizeof(int)); Tcl_Obj *errorMsg; /* Place to build an error messages. Note that * these are messy operations because we do * not want to use the formatting engine; * we're inside there! */ + char buf[TCL_UTF_MAX+1] = ""; /* * Initialize an array that records the number of times a variable is @@ -483,7 +485,7 @@ ValidateFormat( } else { nspace += 16; /* formerly STATIC_LIST_SIZE */ } - nassign = TclStackRealloc(interp, nassign, + nassign = (int *)TclStackRealloc(interp, nassign, nspace * sizeof(int)); for (i = value; i < nspace; i++) { nassign[i] = 0; @@ -566,7 +568,6 @@ ValidateFormat( *---------------------------------------------------------------------- */ - /* ARGSUSED */ int Tcl_ScanObjCmd( ClientData dummy, /* Not used. */ @@ -585,6 +586,7 @@ Tcl_ScanObjCmd( Tcl_UniChar ch = 0, sch = 0; Tcl_Obj **objs = NULL, *objPtr = NULL; int flags; + (void)dummy; if (objc < 3) { Tcl_WrongNumArgs(interp, 1, objv, @@ -608,7 +610,7 @@ Tcl_ScanObjCmd( */ if (totalVars > 0) { - objs = ckalloc(sizeof(Tcl_Obj *) * totalVars); + objs = (Tcl_Obj **)ckalloc(sizeof(Tcl_Obj *) * totalVars); for (i = 0; i < totalVars; i++) { objs[i] = NULL; } @@ -895,7 +897,7 @@ Tcl_ScanObjCmd( /* * Scan an unsigned or signed integer. */ - objPtr = Tcl_NewLongObj(0); + TclNewIntObj(objPtr, 0); Tcl_IncrRefCount(objPtr); if (width == 0) { width = ~0; @@ -921,9 +923,10 @@ Tcl_ScanObjCmd( } if (flags & SCAN_LONGER) { if (Tcl_GetWideIntFromObj(NULL, objPtr, &wideValue) != TCL_OK) { - wideValue = ~(Tcl_WideUInt)0 >> 1; /* WIDE_MAX */ if (TclGetString(objPtr)[0] == '-') { - wideValue++; /* WIDE_MAX + 1 = WIDE_MIN */ + wideValue = WIDE_MIN; + } else { + wideValue = WIDE_MAX; } } if ((flags & SCAN_UNSIGNED) && (wideValue < 0)) { @@ -950,7 +953,7 @@ Tcl_ScanObjCmd( Tcl_SetWideIntObj(objPtr, (unsigned long)value); #endif } else { - Tcl_SetLongObj(objPtr, value); + TclSetLongObj(objPtr, value); } } objs[objIndex++] = objPtr; diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index 35848f7..61162d0 100644 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -542,8 +542,7 @@ TclParseNumber( int shift = 0; /* Amount to shift when accumulating binary */ int explicitOctal = 0; -#define ALL_BITS (~(Tcl_WideUInt)0) -#define MOST_BITS (ALL_BITS >> 1) +#define MOST_BITS (UWIDE_MAX >> 1) /* * Initialize bytes to start of the object's string rep if the caller @@ -694,24 +693,33 @@ TclParseNumber( if (!octalSignificandOverflow) { /* - * Shifting by more bits than are in the value being - * shifted is at least de facto nonportable. Check for - * too large shifts first. + * Shifting by as many or more bits than are in the + * value being shifted is undefined behavior. Check + * for too large shifts first. */ if ((octalSignificandWide != 0) && (((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt)) || (octalSignificandWide > - (~(Tcl_WideUInt)0 >> shift)))) { + (UWIDE_MAX >> shift)))) { octalSignificandOverflow = 1; TclBNInitBignumFromWideUInt(&octalSignificandBig, octalSignificandWide); } } if (!octalSignificandOverflow) { - octalSignificandWide = - (octalSignificandWide << shift) + (c - '0'); + /* + * When the significand is 0, it is possible for the + * amount to be shifted to equal or exceed the width + * of the significand. Do not shift when the + * significand is 0 to avoid undefined behavior. + */ + + if (octalSignificandWide != 0) { + octalSignificandWide <<= shift; + } + octalSignificandWide += c - '0'; } else { mp_mul_2d(&octalSignificandBig, shift, &octalSignificandBig); @@ -813,21 +821,31 @@ TclParseNumber( shift = 4 * (numTrailZeros + 1); if (!significandOverflow) { /* - * Shifting by more bits than are in the value being - * shifted is at least de facto nonportable. Check for too - * large shifts first. + * Shifting by as many or more bits than are in the + * value being shifted is undefined behavior. Check + * for too large shifts first. */ if (significandWide != 0 && ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) || - significandWide > (~(Tcl_WideUInt)0 >> shift))) { + significandWide > (UWIDE_MAX >> shift))) { significandOverflow = 1; TclBNInitBignumFromWideUInt(&significandBig, significandWide); } } if (!significandOverflow) { - significandWide = (significandWide << shift) + d; + /* + * When the significand is 0, it is possible for the + * amount to be shifted to equal or exceed the width + * of the significand. Do not shift when the + * significand is 0 to avoid undefined behavior. + */ + + if (significandWide != 0) { + significandWide <<= shift; + } + significandWide += d; } else { mp_mul_2d(&significandBig, shift, &significandBig); mp_add_d(&significandBig, (mp_digit) d, &significandBig); @@ -855,21 +873,31 @@ TclParseNumber( shift = numTrailZeros + 1; if (!significandOverflow) { /* - * Shifting by more bits than are in the value being - * shifted is at least de facto nonportable. Check for too - * large shifts first. + * Shifting by as many or more bits than are in the + * value being shifted is undefined behavior. Check + * for too large shifts first. */ if (significandWide != 0 && ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) || - significandWide > (~(Tcl_WideUInt)0 >> shift))) { + significandWide > (UWIDE_MAX >> shift))) { significandOverflow = 1; TclBNInitBignumFromWideUInt(&significandBig, significandWide); } } if (!significandOverflow) { - significandWide = (significandWide << shift) + 1; + /* + * When the significand is 0, it is possible for the + * amount to be shifted to equal or exceed the width + * of the significand. Do not shift when the + * significand is 0 to avoid undefined behavior. + */ + + if (significandWide != 0) { + significandWide <<= shift; + } + significandWide += 1; } else { mp_mul_2d(&significandBig, shift, &significandBig); mp_add_d(&significandBig, (mp_digit) 1, &significandBig); @@ -1202,7 +1230,15 @@ TclParseNumber( } if (shift) { if (!significandOverflow) { - significandWide <<= shift; + /* + * When the significand is 0, it is possible for the + * amount to be shifted to equal or exceed the width + * of the significand. Do not shift when the + * significand is 0 to avoid undefined behavior. + */ + if (significandWide != 0) { + significandWide <<= shift; + } } else { mp_mul_2d(&significandBig, shift, &significandBig); } @@ -1223,7 +1259,15 @@ TclParseNumber( } if (shift) { if (!significandOverflow) { - significandWide <<= shift; + /* + * When the significand is 0, it is possible for the + * amount to be shifted to equal or exceed the width + * of the significand. Do not shift when the + * significand is 0 to avoid undefined behavior. + */ + if (significandWide != 0) { + significandWide <<= shift; + } } else { mp_mul_2d(&significandBig, shift, &significandBig); } @@ -1245,7 +1289,15 @@ TclParseNumber( } if (shift) { if (!octalSignificandOverflow) { - octalSignificandWide <<= shift; + /* + * When the significand is 0, it is possible for the + * amount to be shifted to equal or exceed the width + * of the significand. Do not shift when the + * significand is 0 to avoid undefined behavior. + */ + if (octalSignificandWide != 0) { + octalSignificandWide <<= shift; + } } else { mp_mul_2d(&octalSignificandBig, shift, &octalSignificandBig); @@ -1259,7 +1311,7 @@ TclParseNumber( objPtr->typePtr = &tclWideIntType; if (signum) { objPtr->internalRep.wideValue = - - (Tcl_WideInt) octalSignificandWide; + (Tcl_WideInt) (-octalSignificandWide); } else { objPtr->internalRep.wideValue = (Tcl_WideInt) octalSignificandWide; @@ -1274,7 +1326,7 @@ TclParseNumber( objPtr->typePtr = &tclIntType; if (signum) { objPtr->internalRep.longValue = - - (long) octalSignificandWide; + (long) (-octalSignificandWide); } else { objPtr->internalRep.longValue = (long) octalSignificandWide; @@ -1306,7 +1358,7 @@ TclParseNumber( objPtr->typePtr = &tclWideIntType; if (signum) { objPtr->internalRep.wideValue = - - (Tcl_WideInt) significandWide; + (Tcl_WideInt) (-significandWide); } else { objPtr->internalRep.wideValue = (Tcl_WideInt) significandWide; @@ -1321,7 +1373,7 @@ TclParseNumber( objPtr->typePtr = &tclIntType; if (signum) { objPtr->internalRep.longValue = - - (long) significandWide; + (long) (-significandWide); } else { objPtr->internalRep.longValue = (long) significandWide; @@ -1492,7 +1544,7 @@ AccumulateDecimalDigit( *wideRepPtr = digit; return 0; } else if (numZeros >= maxpow10_wide - || w > ((~(Tcl_WideUInt)0)-digit)/pow10_wide[numZeros+1]) { + || w > (UWIDE_MAX-digit)/pow10_wide[numZeros+1]) { /* * Wide multiplication will overflow. Expand the number to a * bignum and fall through into the bignum case. diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 22e025c..b81e711 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -151,7 +151,7 @@ GrowStringBuffer( if (flag == 0 || stringPtr->allocated > 0) { if (needed <= INT_MAX / 2) { attempt = 2 * needed; - ptr = (char *)attemptckrealloc(objPtr->bytes, attempt + 1); + ptr = (char *)attemptckrealloc(objPtr->bytes, attempt + 1U); } if (ptr == NULL) { /* @@ -164,7 +164,7 @@ GrowStringBuffer( int growth = (int) ((extra > limit) ? limit : extra); attempt = needed + growth; - ptr = (char *)attemptckrealloc(objPtr->bytes, attempt + 1); + ptr = (char *)attemptckrealloc(objPtr->bytes, attempt + 1U); } } if (ptr == NULL) { @@ -173,7 +173,7 @@ GrowStringBuffer( */ attempt = needed; - ptr = (char *)ckrealloc(objPtr->bytes, attempt + 1); + ptr = (char *)ckrealloc(objPtr->bytes, attempt + 1U); } objPtr->bytes = ptr; stringPtr->allocated = attempt; @@ -501,7 +501,7 @@ TclCheckEmptyString ( } if (TclIsPureList(objPtr)) { - Tcl_ListObjLength(NULL, objPtr, &length); + TclListObjLength(NULL, objPtr, &length); return length == 0; } @@ -576,7 +576,7 @@ Tcl_GetUniChar( TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length); } if (stringPtr->numChars == objPtr->length) { - return (Tcl_UniChar) objPtr->bytes[index]; + return (unsigned char) objPtr->bytes[index]; } FillUnicodeRep(objPtr); stringPtr = GET_STRING(objPtr); @@ -632,7 +632,7 @@ TclGetUCS4( TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length); } if (stringPtr->numChars == objPtr->length) { - return (Tcl_UniChar) objPtr->bytes[index]; + return (unsigned char) objPtr->bytes[index]; } FillUnicodeRep(objPtr); stringPtr = GET_STRING(objPtr); @@ -739,8 +739,7 @@ Tcl_GetUnicodeFromObj( * * Create a Tcl Object that contains the chars between first and last of * the object indicated by "objPtr". If the object is not already a - * String object, convert it to one. The first and last indices are - * assumed to be in the appropriate range. + * String object, convert it to one. * * Results: * Returns a new Tcl Object of the String type. @@ -773,11 +772,12 @@ Tcl_GetRange( if (TclIsPureByteArray(objPtr)) { unsigned char *bytes = Tcl_GetByteArrayFromObj(objPtr, &length); - if (last >= length) { + if (last < 0 || last >= length) { last = length - 1; } if (last < first) { - return Tcl_NewObj(); + TclNewObj(newObjPtr); + return newObjPtr; } return Tcl_NewByteArrayObj(bytes + first, last - first + 1); } @@ -798,13 +798,14 @@ Tcl_GetRange( TclNumUtfChars(stringPtr->numChars, objPtr->bytes, objPtr->length); } if (stringPtr->numChars == objPtr->length) { - if (last >= stringPtr->numChars) { + if (last < 0 || last >= stringPtr->numChars) { last = stringPtr->numChars - 1; } if (last < first) { - return Tcl_NewObj(); + TclNewObj(newObjPtr); + return newObjPtr; } - newObjPtr = Tcl_NewStringObj(objPtr->bytes + first, last-first+1); + newObjPtr = Tcl_NewStringObj(objPtr->bytes + first, last - first + 1); /* * Since we know the char length of the result, store it. @@ -818,21 +819,23 @@ Tcl_GetRange( FillUnicodeRep(objPtr); stringPtr = GET_STRING(objPtr); } - if (last > stringPtr->numChars) { - last = stringPtr->numChars; + + if (last < 0 || last >= stringPtr->numChars) { + last = stringPtr->numChars - 1; } if (last < first) { - return Tcl_NewObj(); + TclNewObj(newObjPtr); + return newObjPtr; } #if TCL_UTF_MAX == 4 /* See: bug [11ae2be95dac9417] */ if ((first > 0) && ((stringPtr->unicode[first] & 0xFC00) == 0xDC00) - && ((stringPtr->unicode[first-1] & 0xFC00) == 0xD800)) { + && ((stringPtr->unicode[first-1] & 0xFC00) == 0xD800)) { ++first; } if ((last + 1 < stringPtr->numChars) - && ((stringPtr->unicode[last+1] & 0xFC00) == 0xDC00) - && ((stringPtr->unicode[last] & 0xFC00) == 0xD800)) { + && ((stringPtr->unicode[last+1] & 0xFC00) == 0xDC00) + && ((stringPtr->unicode[last] & 0xFC00) == 0xD800)) { ++last; } #endif @@ -953,9 +956,9 @@ Tcl_SetObjLength( * Need to enlarge the buffer. */ if (objPtr->bytes == tclEmptyStringRep) { - objPtr->bytes = (char *)ckalloc(length + 1); + objPtr->bytes = (char *)ckalloc((unsigned int)length + 1U); } else { - objPtr->bytes = (char *)ckrealloc(objPtr->bytes, length + 1); + objPtr->bytes = (char *)ckrealloc(objPtr->bytes, (unsigned int)length + 1U); } stringPtr->allocated = length; } @@ -1059,9 +1062,9 @@ Tcl_AttemptSetObjLength( char *newBytes; if (objPtr->bytes == tclEmptyStringRep) { - newBytes = (char *)attemptckalloc(length + 1); + newBytes = (char *)attemptckalloc((unsigned int)length + 1U); } else { - newBytes = (char *)attemptckrealloc(objPtr->bytes, length + 1); + newBytes = (char *)attemptckrealloc(objPtr->bytes, (unsigned int)length + 1U); } if (newBytes == NULL) { return 0; @@ -1722,10 +1725,10 @@ AppendUtfToUtfRep( objPtr->length = 0; } oldLength = objPtr->length; - newLength = numBytes + oldLength; - if (newLength < 0) { + if (numBytes > INT_MAX - oldLength) { Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); } + newLength = numBytes + oldLength; stringPtr = GET_STRING(objPtr); if (newLength > stringPtr->allocated) { @@ -1737,8 +1740,8 @@ AppendUtfToUtfRep( * the reallocs below. */ - if (bytes && bytes >= objPtr->bytes - && bytes <= objPtr->bytes + objPtr->length) { + if (bytes && objPtr->bytes && (bytes >= objPtr->bytes) + && (bytes <= objPtr->bytes + objPtr->length)) { offset = bytes - objPtr->bytes; } @@ -2114,7 +2117,11 @@ Tcl_AppendFormatToObj( if (gotPrecision) { numChars = Tcl_GetCharLength(segment); if (precision < numChars) { - segment = Tcl_GetRange(segment, 0, precision - 1); + if (precision < 1) { + TclNewObj(segment); + } else { + segment = Tcl_GetRange(segment, 0, precision - 1); + } numChars = precision; Tcl_IncrRefCount(segment); allocSegment = 1; @@ -3334,7 +3341,7 @@ ExtendStringRepWithUnicode( } for (i = 0; i < numChars && size >= 0; i++) { - size += Tcl_UniCharToUtf((int) unicode[i], buf); + size += (unsigned int)Tcl_UniCharToUtf((int) unicode[i], buf); } if (size < 0) { Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); diff --git a/generic/tclStringRep.h b/generic/tclStringRep.h index 25b854e..dc33f4b 100644 --- a/generic/tclStringRep.h +++ b/generic/tclStringRep.h @@ -65,9 +65,9 @@ typedef struct String { } String; #define STRING_MAXCHARS \ - (int)(((size_t)UINT_MAX - 1 - TclOffset(String, unicode))/sizeof(Tcl_UniChar)) + (int)(((size_t)UINT_MAX - TclOffset(String, unicode))/sizeof(Tcl_UniChar) - 1) #define STRING_SIZE(numChars) \ - (TclOffset(String, unicode) + ((numChars + 1) * sizeof(Tcl_UniChar))) + (TclOffset(String, unicode) + sizeof(Tcl_UniChar) + ((numChars) * sizeof(Tcl_UniChar))) #define stringCheckLimits(numChars) \ do { \ if ((numChars) < 0 || (numChars) > STRING_MAXCHARS) { \ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 14440c4..3a7db04 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -1649,7 +1649,20 @@ const TclStubs tclStubs = { 0, /* 657 */ 0, /* 658 */ 0, /* 659 */ - TclUnusedStubEntry, /* 660 */ + 0, /* 660 */ + 0, /* 661 */ + 0, /* 662 */ + 0, /* 663 */ + 0, /* 664 */ + 0, /* 665 */ + 0, /* 666 */ + 0, /* 667 */ + 0, /* 668 */ + 0, /* 669 */ + 0, /* 670 */ + 0, /* 671 */ + 0, /* 672 */ + TclUnusedStubEntry, /* 673 */ }; /* !END!: Do not edit above this line. */ diff --git a/generic/tclTest.c b/generic/tclTest.c index a759e74..8f12715 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -326,7 +326,7 @@ static Tcl_NRPostProc NREUnwind_callback; static Tcl_ObjCmdProc TestNREUnwind; static Tcl_ObjCmdProc TestNRELevels; static Tcl_ObjCmdProc TestInterpResolverCmd; -#if defined(HAVE_CPUID) || defined(_WIN32) +#if defined(HAVE_CPUID) && !defined(MAC_OSX_TCL) static Tcl_ObjCmdProc TestcpuidCmd; #endif @@ -600,7 +600,7 @@ Tcltest_Init( NULL, NULL); Tcl_CreateCommand(interp, "testexitmainloop", TestexitmainloopCmd, NULL, NULL); -#if defined(HAVE_CPUID) || defined(_WIN32) +#if defined(HAVE_CPUID) && !defined(MAC_OSX_TCL) Tcl_CreateObjCommand(interp, "testcpuid", TestcpuidCmd, NULL, NULL); #endif @@ -1622,7 +1622,7 @@ TestdoubledigitsObjCmd(ClientData unused, Tcl_Obj* const objv[]) /* Parameter vector */ { - static const char* options[] = { + static const char *options[] = { "shortest", "Steele", "e", @@ -1643,8 +1643,8 @@ TestdoubledigitsObjCmd(ClientData unused, int type; int decpt; int signum; - char* str; - char* endPtr; + char * str; + char *endPtr; Tcl_Obj* strObj; Tcl_Obj* retval; @@ -1759,7 +1759,7 @@ TestdstringCmd( strcpy(s, "This is a malloc-ed string"); Tcl_SetResult(interp, s, TCL_DYNAMIC); } else if (strcmp(argv[2], "special") == 0) { - char *s = (char*)ckalloc(100) + 16; + char *s = (char *)ckalloc(100) + 16; strcpy(s, "This is a specially-allocated string"); Tcl_SetResult(interp, s, SpecialFree); } else { @@ -3596,8 +3596,9 @@ PrintParse( Tcl_NewIntObj(tokenPtr->numComponents)); } Tcl_ListObjAppendElement(NULL, objPtr, + parsePtr->commandStart ? Tcl_NewStringObj(parsePtr->commandStart + parsePtr->commandSize, - -1)); + -1) : Tcl_NewObj()); } /* @@ -3917,7 +3918,7 @@ TestregexpObjCmd( if (ii == -1) { TclRegExpRangeUniChar(regExpr, ii, &start, &end); newPtr = Tcl_GetRange(objPtr, start, end); - } else if (ii > info.nsubs) { + } else if (ii > info.nsubs || info.matches[ii].end <= 0) { newPtr = Tcl_NewObj(); } else { newPtr = Tcl_GetRange(objPtr, info.matches[ii].start, @@ -6176,19 +6177,22 @@ TestGetIndexFromObjStructObjCmd( Tcl_Obj *const objv[]) /* Argument objects. */ { const char *const ary[] = { - "a", "b", "c", "d", "e", "f", NULL, NULL + "a", "b", "c", "d", "ee", "ff", NULL, NULL }; - int idx,target; + int idx,target, flags = 0; - if (objc != 3) { - Tcl_WrongNumArgs(interp, 1, objv, "argument targetvalue"); + if (objc != 3 && objc != 4) { + Tcl_WrongNumArgs(interp, 1, objv, "argument targetvalue ?flags?"); + return TCL_ERROR; + } + if (Tcl_GetIntFromObj(interp, objv[2], &target) != TCL_OK) { return TCL_ERROR; } - if (Tcl_GetIndexFromObjStruct(interp, objv[1], ary, 2*sizeof(char *), - "dummy", 0, &idx) != TCL_OK) { + if ((objc > 3) && (Tcl_GetIntFromObj(interp, objv[3], &flags) != TCL_OK)) { return TCL_ERROR; } - if (Tcl_GetIntFromObj(interp, objv[2], &target) != TCL_OK) { + if (Tcl_GetIndexFromObjStruct(interp, (Tcl_GetString(objv[1])[0] ? objv[1] : NULL), ary, 2*sizeof(char *), + "dummy", flags, &idx) != TCL_OK) { return TCL_ERROR; } if (idx != target) { @@ -6200,7 +6204,7 @@ TestGetIndexFromObjStructObjCmd( Tcl_AppendResult(interp, " when ", buffer, " expected", NULL); return TCL_ERROR; } - Tcl_WrongNumArgs(interp, 3, objv, NULL); + Tcl_WrongNumArgs(interp, objc, objv, NULL); return TCL_OK; } @@ -6951,7 +6955,7 @@ TestFindLastCmd( return TCL_OK; } -#if defined(HAVE_CPUID) || defined(_WIN32) +#if defined(HAVE_CPUID) && !defined(MAC_OSX_TCL) /* *---------------------------------------------------------------------- * diff --git a/generic/tclTimer.c b/generic/tclTimer.c index d30879f..500a75e 100644 --- a/generic/tclTimer.c +++ b/generic/tclTimer.c @@ -949,13 +949,14 @@ Tcl_AfterObjCmd( break; case AFTER_INFO: if (objc == 2) { - Tcl_Obj *resultObj = Tcl_NewObj(); + Tcl_Obj *resultObj; + TclNewObj(resultObj); for (afterPtr = assocPtr->firstAfterPtr; afterPtr != NULL; afterPtr = afterPtr->nextPtr) { if (assocPtr->interp == interp) { - Tcl_ListObjAppendElement(NULL, resultObj, Tcl_ObjPrintf( - "after#%d", afterPtr->id)); + Tcl_ListObjAppendElement(NULL, resultObj, Tcl_ObjPrintf( + "after#%d", afterPtr->id)); } } Tcl_SetObjResult(interp, resultObj); @@ -974,14 +975,15 @@ Tcl_AfterObjCmd( Tcl_SetErrorCode(interp, "TCL","LOOKUP","EVENT", eventStr, NULL); return TCL_ERROR; } else { - Tcl_Obj *resultListPtr = Tcl_NewObj(); + Tcl_Obj *resultListPtr; - Tcl_ListObjAppendElement(interp, resultListPtr, - afterPtr->commandPtr); - Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj( + TclNewObj(resultListPtr); + Tcl_ListObjAppendElement(interp, resultListPtr, + afterPtr->commandPtr); + Tcl_ListObjAppendElement(interp, resultListPtr, Tcl_NewStringObj( (afterPtr->token == NULL) ? "idle" : "timer", -1)); Tcl_SetObjResult(interp, resultListPtr); - } + } break; default: Tcl_Panic("Tcl_AfterObjCmd: bad subcommand index to afterSubCmds"); diff --git a/generic/tclTrace.c b/generic/tclTrace.c index c82fc14..0ed57c1 100644 --- a/generic/tclTrace.c +++ b/generic/tclTrace.c @@ -160,8 +160,8 @@ typedef struct StringTraceData { #define FOREACH_COMMAND_TRACE(interp, name, clientData) \ (clientData) = NULL; \ - while ((clientData = Tcl_CommandTraceInfo(interp, name, 0, \ - TraceCommandProc, clientData)) != NULL) + while (((clientData) = Tcl_CommandTraceInfo((interp), (name), 0, \ + TraceCommandProc, (clientData))) != NULL) /* *---------------------------------------------------------------------- @@ -434,7 +434,7 @@ TraceExecutionObjCmd( * pointer to its array of element pointers. */ - result = Tcl_ListObjGetElements(interp, objv[4], &listLen, &elemPtrs); + result = TclListObjGetElements(interp, objv[4], &listLen, &elemPtrs); if (result != TCL_OK) { return result; } @@ -604,7 +604,7 @@ TraceExecutionObjCmd( TclNewLiteralStringObj(opObj, "leavestep"); Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj); } - Tcl_ListObjLength(NULL, elemObjPtr, &numOps); + TclListObjLength(NULL, elemObjPtr, &numOps); if (0 == numOps) { Tcl_DecrRefCount(elemObjPtr); continue; @@ -675,7 +675,7 @@ TraceCommandObjCmd( * pointer to its array of element pointers. */ - result = Tcl_ListObjGetElements(interp, objv[4], &listLen, &elemPtrs); + result = TclListObjGetElements(interp, objv[4], &listLen, &elemPtrs); if (result != TCL_OK) { return result; } @@ -799,7 +799,7 @@ TraceCommandObjCmd( TclNewLiteralStringObj(opObj, "delete"); Tcl_ListObjAppendElement(NULL, elemObjPtr, opObj); } - Tcl_ListObjLength(NULL, elemObjPtr, &numOps); + TclListObjLength(NULL, elemObjPtr, &numOps); if (0 == numOps) { Tcl_DecrRefCount(elemObjPtr); continue; @@ -874,7 +874,7 @@ TraceVariableObjCmd( * pointer to its array of element pointers. */ - result = Tcl_ListObjGetElements(interp, objv[4], &listLen, &elemPtrs); + result = TclListObjGetElements(interp, objv[4], &listLen, &elemPtrs); if (result != TCL_OK) { return result; } diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 858163e..8d2347b 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -3730,7 +3730,8 @@ UpdateStringOfEndOffset( memcpy(buffer, "end", 4); if (objPtr->internalRep.longValue != 0) { buffer[len++] = '-'; - len += TclFormatInt(buffer+len, -(objPtr->internalRep.longValue)); + len += TclFormatInt(buffer+len, + (long)(-(unsigned long)(objPtr->internalRep.longValue))); } objPtr->bytes = (char *)ckalloc(len+1); memcpy(objPtr->bytes, buffer, len+1); @@ -3842,8 +3843,7 @@ SetEndOffsetFromAny( } if (bytes[3] == '-') { - /* TODO: Review overflow concerns here! */ - offset = -offset; + offset = (int)(-(unsigned int)offset); } } else { /* diff --git a/generic/tclVar.c b/generic/tclVar.c index 566e543..a8d6664 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -3433,7 +3433,7 @@ ArrayGetCmd( */ TclNewObj(tmpResObj); - result = Tcl_ListObjGetElements(interp, nameLstObj, &count, &nameObjPtr); + result = TclListObjGetElements(interp, nameLstObj, &count, &nameObjPtr); if (result != TCL_OK) { goto errorInArrayGet; } diff --git a/generic/tclZlib.c b/generic/tclZlib.c index ac19449..63a25fa 100644 --- a/generic/tclZlib.c +++ b/generic/tclZlib.c @@ -1355,7 +1355,7 @@ Tcl_ZlibStreamGet( Tcl_DecrRefCount(zshPtr->currentInput); zshPtr->currentInput = NULL; } - Tcl_ListObjLength(NULL, zshPtr->inData, &listLen); + TclListObjLength(NULL, zshPtr->inData, &listLen); if (listLen > 0) { /* * There is more input available, get it from the list and @@ -1404,7 +1404,7 @@ Tcl_ZlibStreamGet( e = inflate(&zshPtr->stream, zshPtr->flush); } }; - Tcl_ListObjLength(NULL, zshPtr->inData, &listLen); + TclListObjLength(NULL, zshPtr->inData, &listLen); while ((zshPtr->stream.avail_out > 0) && (e == Z_OK || e == Z_BUF_ERROR) && (listLen > 0)) { @@ -1484,7 +1484,7 @@ Tcl_ZlibStreamGet( inflateEnd(&zshPtr->stream); } } else { - Tcl_ListObjLength(NULL, zshPtr->outData, &listLen); + TclListObjLength(NULL, zshPtr->outData, &listLen); if (count == -1) { count = 0; for (i=0; i<listLen; i++) { @@ -1506,7 +1506,7 @@ Tcl_ZlibStreamGet( dataPtr += existing; while ((count > dataPos) && - (Tcl_ListObjLength(NULL, zshPtr->outData, &listLen) == TCL_OK) + (TclListObjLength(NULL, zshPtr->outData, &listLen) == TCL_OK) && (listLen > 0)) { /* * Get the next chunk off our list of chunks and grab the data out |