diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/regexec.c | 2 | ||||
| -rw-r--r-- | generic/tclBinary.c | 301 | ||||
| -rw-r--r-- | generic/tclDisassemble.c | 2 | ||||
| -rw-r--r-- | generic/tclExecute.c | 75 | ||||
| -rw-r--r-- | generic/tclInt.h | 38 | ||||
| -rw-r--r-- | generic/tclLiteral.c | 50 | ||||
| -rw-r--r-- | generic/tclRegexp.c | 10 |
7 files changed, 250 insertions, 228 deletions
diff --git a/generic/regexec.c b/generic/regexec.c index c57f42c..1a3e114 100644 --- a/generic/regexec.c +++ b/generic/regexec.c @@ -889,7 +889,7 @@ cbrdissect( MDEBUG(("cbackref n%d %d{%d-%d}\n", t->id, n, min, max)); /* get the backreferenced string */ - if (v->pmatch[n].rm_so == -1) { + if (v->pmatch[n].rm_so == TCL_INDEX_NONE) { return REG_NOMATCH; } brstring = v->start + v->pmatch[n].rm_so; diff --git a/generic/tclBinary.c b/generic/tclBinary.c index 246c371..831a427 100644 --- a/generic/tclBinary.c +++ b/generic/tclBinary.c @@ -159,93 +159,88 @@ static const EnsembleImplMap decodeMap[] = { }; /* - * The following object types represent an array of bytes. The intent is - * to allow arbitrary binary data to pass through Tcl as a Tcl value - * without loss or damage. Such values are useful for things like - * encoded strings or Tk images to name just two. - * - * It's strange to have two Tcl_ObjTypes in place for this task when - * one would do, so a bit of detail and history how we got to this point - * and where we might go from here. - * - * A bytearray is an ordered sequence of bytes. Each byte is an integer - * value in the range [0-255]. To be a Tcl value type, we need a way to - * encode each value in the value set as a Tcl string. The simplest - * encoding is to represent each byte value as the same codepoint value. - * A bytearray of N bytes is encoded into a Tcl string of N characters - * where the codepoint of each character is the value of corresponding byte. - * This approach creates a one-to-one map between all bytearray values - * and a subset of Tcl string values. + * The following object types represent an array of bytes. The intent is to + * allow arbitrary binary data to pass through Tcl as a Tcl value without loss + * or damage. Such values are useful for things like encoded strings or Tk + * images to name just two. + * + * It's strange to have two Tcl_ObjTypes in place for this task when one would + * do, so a bit of detail and history how we got to this point and where we + * might go from here. + * + * A bytearray is an ordered sequence of bytes. Each byte is an integer value + * in the range [0-255]. To be a Tcl value type, we need a way to encode each + * value in the value set as a Tcl string. The simplest encoding is to + * represent each byte value as the same codepoint value. A bytearray of N + * bytes is encoded into a Tcl string of N characters where the codepoint of + * each character is the value of corresponding byte. This approach creates a + * one-to-one map between all bytearray values and a subset of Tcl string + * values. * * When converting a Tcl string value to the bytearray internal rep, the * question arises what to do with strings outside that subset? That is, - * those Tcl strings containing at least one codepoint greater than 255? - * The obviously correct answer is to raise an error! That string value - * does not represent any valid bytearray value. Full Stop. The - * setFromAnyProc signature has a completion code return value for just - * this reason, to reject invalid inputs. - * - * Unfortunately this was not the path taken by the authors of the - * original tclByteArrayType. They chose to accept all Tcl string values - * as acceptable string encodings of the bytearray values that result - * from masking away the high bits of any codepoint value at all. This - * meant that every bytearray value had multiple accepted string - * representations. - * - * The implications of this choice are truly ugly. When a Tcl value has - * a string representation, we are required to accept that as the true - * value. Bytearray values that possess a string representation cannot - * be processed as bytearrays because we cannot know which true value - * that bytearray represents. The consequence is that we drag around - * an internal rep that we cannot make any use of. This painful price - * is extracted at any point after a string rep happens to be generated - * for the value. This happens even when the troublesome codepoints - * outside the byte range never show up. This happens rather routinely - * in normal Tcl operations unless we burden the script writer with the - * cognitive burden of avoiding it. The price is also paid by callers - * of the C interface. The routine + * those Tcl strings containing at least one codepoint greater than 255? The + * obviously correct answer is to raise an error! That string value does not + * represent any valid bytearray value. Full Stop. The setFromAnyProc + * signature has a completion code return value for just this reason, to + * reject invalid inputs. + * + * Unfortunately this was not the path taken by the authors of the original + * tclByteArrayType. They chose to accept all Tcl string values as acceptable + * string encodings of the bytearray values that result from masking away the + * high bits of any codepoint value at all. This meant that every bytearray + * value had multiple accepted string representations. + * + * The implications of this choice are truly ugly. When a Tcl value has a + * string representation, we are required to accept that as the true value. + * Bytearray values that possess a string representation cannot be processed + * as bytearrays because we cannot know which true value that bytearray + * represents. The consequence is that we drag around an internal rep that we + * cannot make any use of. This painful price is extracted at any point after + * a string rep happens to be generated for the value. This happens even when + * the troublesome codepoints outside the byte range never show up. This + * happens rather routinely in normal Tcl operations unless we burden the + * script writer with the cognitive burden of avoiding it. The price is also + * paid by callers of the C interface. The routine * * unsigned char *Tcl_GetByteArrayFromObj(objPtr, lenPtr) * - * has a guarantee to always return a non-NULL value, but that value - * points to a byte sequence that cannot be used by the caller to - * process the Tcl value absent some sideband testing that objPtr - * is "pure". Tcl offers no public interface to perform this test, - * so callers either break encapsulation or are unavoidably buggy. Tcl - * has defined a public interface that cannot be used correctly. The - * Tcl source code itself suffers the same problem, and has been buggy, - * but progressively less so as more and more portions of the code have - * been retrofitted with the required "purity testing". The set of values - * able to pass the purity test can be increased via the introduction of - * a "canonical" flag marker, but the only way the broken interface itself + * has a guarantee to always return a non-NULL value, but that value points to + * a byte sequence that cannot be used by the caller to process the Tcl value + * absent some sideband testing that objPtr is "pure". Tcl offers no public + * interface to perform this test, so callers either break encapsulation or + * are unavoidably buggy. Tcl has defined a public interface that cannot be + * used correctly. The Tcl source code itself suffers the same problem, and + * has been buggy, but progressively less so as more and more portions of the + * code have been retrofitted with the required "purity testing". The set of + * values able to pass the purity test can be increased via the introduction + * of a "canonical" flag marker, but the only way the broken interface itself * can be discarded is to start over and define the Tcl_ObjType properly. - * Bytearrays should simply be usable as bytearrays without a kabuki - * dance of testing. - * - * The Tcl_ObjType "properByteArrayType" is (nearly) a correct - * implementation of bytearrays. Any Tcl value with the type - * properByteArrayType can have its bytearray value fetched and - * used with confidence that acting on that value is equivalent to - * acting on the true Tcl string value. This still implies a side - * testing burden -- past mistakes will not let us avoid that - * immediately, but it is at least a conventional test of type, and - * can be implemented entirely by examining the objPtr fields, with - * no need to query the intrep, as a canonical flag would require. - * - * Until Tcl_GetByteArrayFromObj() and Tcl_SetByteArrayLength() can - * be revised to admit the possibility of returning NULL when the true - * value is not a valid bytearray, we need a mechanism to retain - * compatibility with the deployed callers of the broken interface. - * That's what the retained "tclByteArrayType" provides. In those - * unusual circumstances where we convert an invalid bytearray value - * to a bytearray type, it is to this legacy type. Essentially any - * time this legacy type gets used, it's a signal of a bug being ignored. - * A TIP should be drafted to remove this connection to the broken past - * so that Tcl 9 will no longer have any trace of it. Prescribing a - * migration path will be the key element of that work. The internal - * changes now in place are the limit of what can be done short of - * interface repair. They provide a great expansion of the histories - * over which bytearray values can be useful in the meanwhile. + * Bytearrays should simply be usable as bytearrays without a kabuki dance of + * testing. + * + * The Tcl_ObjType "properByteArrayType" is (nearly) a correct implementation + * of bytearrays. Any Tcl value with the type properByteArrayType can have + * its bytearray value fetched and used with confidence that acting on that + * value is equivalent to acting on the true Tcl string value. This still + * implies a side testing burden -- past mistakes will not let us avoid that + * immediately, but it is at least a conventional test of type, and can be + * implemented entirely by examining the objPtr fields, with no need to query + * the intrep, as a canonical flag would require. + * + * Until Tcl_GetByteArrayFromObj() and Tcl_SetByteArrayLength() can be revised + * to admit the possibility of returning NULL when the true value is not a + * valid bytearray, we need a mechanism to retain compatibility with the + * deployed callers of the broken interface. That's what the retained + * "tclByteArrayType" provides. In those unusual circumstances where we + * convert an invalid bytearray value to a bytearray type, it is to this + * legacy type. Essentially any time this legacy type gets used, it's a + * signal of a bug being ignored. A TIP should be drafted to remove this + * connection to the broken past so that Tcl 9 will no longer have any trace + * of it. Prescribing a migration path will be the key element of that work. + * The internal changes now in place are the limit of what can be done short + * of interface repair. They provide a great expansion of the histories over + * which bytearray values can be useful in the meanwhile. */ static const Tcl_ObjType properByteArrayType = { @@ -400,10 +395,10 @@ Tcl_DbNewByteArrayObj( void Tcl_SetByteArrayObj( Tcl_Obj *objPtr, /* Object to initialize as a ByteArray. */ - const unsigned char *bytes, /* The array of bytes to use as the new - value. May be NULL even if length > 0. */ + const unsigned char *bytes, /* The array of bytes to use as the new value. + * May be NULL even if length > 0. */ int length) /* Length of the array of bytes, which must - be >= 0. */ + * be >= 0. */ { ByteArray *byteArrayPtr; Tcl_ObjIntRep ir; @@ -723,14 +718,16 @@ UpdateStringOfByteArray( if (size == length) { char *dst = Tcl_InitStringRep(objPtr, (char *)src, size); + TclOOM(dst, size); } else { char *dst = Tcl_InitStringRep(objPtr, NULL, size); + TclOOM(dst, size); for (i = 0; i < length; i++) { dst += Tcl_UniCharToUtf(src[i], dst); } - (void)Tcl_InitStringRep(objPtr, NULL, size); + (void) Tcl_InitStringRep(objPtr, NULL, size); } } @@ -778,7 +775,7 @@ TclAppendBytesToByteArray( return; } - length = (unsigned int)len; + length = (unsigned int) len; irPtr = TclFetchIntRep(objPtr, &properByteArrayType); if (irPtr == NULL) { @@ -807,12 +804,18 @@ TclAppendBytesToByteArray( unsigned int attempt; if (needed <= INT_MAX/2) { - /* Try to allocate double the total space that is needed. */ + /* + * Try to allocate double the total space that is needed. + */ + attempt = 2 * needed; ptr = attemptckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt)); } if (ptr == NULL) { - /* Try to allocate double the increment that is needed (plus). */ + /* + * Try to allocate double the increment that is needed (plus). + */ + unsigned int limit = INT_MAX - needed; unsigned int extra = length + TCL_MIN_GROWTH; int growth = (int) ((extra > limit) ? limit : extra); @@ -821,7 +824,10 @@ TclAppendBytesToByteArray( ptr = attemptckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt)); } if (ptr == NULL) { - /* Last chance: Try to allocate exactly what is needed. */ + /* + * Last chance: Try to allocate exactly what is needed. + */ + attempt = needed; ptr = ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt)); } @@ -896,7 +902,7 @@ BinaryFormatCmd( int count; /* Count associated with current format * character. */ int flags; /* Format field flags */ - const char *format; /* Pointer to current position in format + const char *format; /* Pointer to current position in format * string. */ Tcl_Obj *resultPtr = NULL; /* Object holding result buffer. */ unsigned char *buffer; /* Start of result buffer. */ @@ -1082,9 +1088,9 @@ BinaryFormatCmd( memset(buffer, 0, length); /* - * Pack the data into the result object. Note that we can skip the - * error checking during this pass, since we have already parsed the - * string once. + * Pack the data into the result object. Note that we can skip the error + * checking during this pass, since we have already parsed the string + * once. */ arg = 2; @@ -1297,7 +1303,7 @@ BinaryFormatCmd( } arg++; for (i = 0; i < count; i++) { - if (FormatNumber(interp, cmd, listv[i], &cursor)!=TCL_OK) { + if (FormatNumber(interp, cmd, listv[i], &cursor) != TCL_OK) { Tcl_DecrRefCount(resultPtr); return TCL_ERROR; } @@ -1401,7 +1407,7 @@ BinaryScanCmd( int count; /* Count associated with current format * character. */ int flags; /* Format field flags */ - const char *format; /* Pointer to current position in format + const char *format; /* Pointer to current position in format * string. */ Tcl_Obj *resultPtr = NULL; /* Object holding result buffer. */ unsigned char *buffer; /* Start of result buffer. */ @@ -1460,7 +1466,7 @@ BinaryScanCmd( if (cmd == 'A') { while (size > 0) { - if (src[size-1] != '\0' && src[size-1] != ' ') { + if (src[size - 1] != '\0' && src[size - 1] != ' ') { break; } size--; @@ -2055,6 +2061,7 @@ FormatNumber( if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) { const Tcl_ObjIntRep *irPtr = TclFetchIntRep(src, &tclDoubleType); + if (irPtr == NULL) { return TCL_ERROR; } @@ -2067,7 +2074,7 @@ FormatNumber( * valid range for float. */ - if (fabs(dvalue) > (double)FLT_MAX) { + if (fabs(dvalue) > (double) FLT_MAX) { fvalue = (dvalue >= 0.0) ? FLT_MAX : -FLT_MAX; } else { fvalue = (float) dvalue; @@ -2188,9 +2195,9 @@ ScanNumber( int type, /* Format character from "binary scan" */ int flags, /* Format field flags */ Tcl_HashTable **numberCachePtrPtr) - /* Place to look for cache of scanned - * value objects, or NULL if too many - * different numbers have been scanned. */ + /* Place to look for cache of scanned value + * objects, or NULL if too many different + * numbers have been scanned. */ { long value; float fvalue; @@ -2264,6 +2271,7 @@ ScanNumber( /* * Check to see if the value was sign extended properly on systems * where an int is more than 32-bits. + * * We avoid caching unsigned integers as we cannot distinguish between * 32bit signed and unsigned in the hash (short and char are ok). */ @@ -2271,9 +2279,9 @@ ScanNumber( if (flags & BINARY_UNSIGNED) { return Tcl_NewWideIntObj((Tcl_WideInt)(unsigned long)value); } - if ((value & (((unsigned) 1)<<31)) && (value > 0)) { - value -= (((unsigned) 1)<<31); - value -= (((unsigned) 1)<<31); + if ((value & (((unsigned) 1) << 31)) && (value > 0)) { + value -= (((unsigned) 1) << 31); + value -= (((unsigned) 1) << 31); } returnNumericObject: @@ -2473,8 +2481,8 @@ BinaryEncodeHex( data = Tcl_GetByteArrayFromObj(objv[1], &count); cursor = Tcl_SetByteArrayLength(resultObj, count * 2); for (offset = 0; offset < count; ++offset) { - *cursor++ = HexDigits[((data[offset] >> 4) & 0x0f)]; - *cursor++ = HexDigits[(data[offset] & 0x0f)]; + *cursor++ = HexDigits[(data[offset] >> 4) & 0x0f]; + *cursor++ = HexDigits[data[offset] & 0x0f]; } Tcl_SetObjResult(interp, resultObj); return TCL_OK; @@ -2514,7 +2522,7 @@ BinaryDecodeHex( Tcl_WrongNumArgs(interp, 1, objv, "?options? data"); return TCL_ERROR; } - for (i = 1; i < objc-1; ++i) { + for (i = 1; i < objc - 1; ++i) { if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option", TCL_EXACT, &index) != TCL_OK) { return TCL_ERROR; @@ -2528,13 +2536,13 @@ BinaryDecodeHex( TclNewObj(resultObj); datastart = data = (unsigned char *) - TclGetStringFromObj(objv[objc-1], &count); + TclGetStringFromObj(objv[objc - 1], &count); dataend = data + count; size = (count + 1) / 2; begin = cursor = Tcl_SetByteArrayLength(resultObj, size); while (data < dataend) { value = 0; - for (i=0 ; i<2 ; i++) { + for (i = 0 ; i < 2 ; i++) { if (data >= dataend) { value <<= 4; break; @@ -2557,7 +2565,7 @@ BinaryDecodeHex( if (c > 16) { c += ('A' - 'a'); } - value |= (c & 0xf); + value |= c & 0xf; } if (i < 2) { cut++; @@ -2628,22 +2636,22 @@ BinaryEncode64( const char *wrapchar = "\n"; int wrapcharlen = 1; int offset, i, index, size, outindex = 0, count = 0; - enum {OPT_MAXLEN, OPT_WRAPCHAR }; + enum { OPT_MAXLEN, OPT_WRAPCHAR }; static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL }; - if (objc < 2 || objc%2 != 0) { + if (objc < 2 || objc % 2 != 0) { Tcl_WrongNumArgs(interp, 1, objv, "?-maxlen len? ?-wrapchar char? data"); return TCL_ERROR; } - for (i = 1; i < objc-1; i += 2) { + for (i = 1; i < objc - 1; i += 2) { if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option", TCL_EXACT, &index) != TCL_OK) { return TCL_ERROR; } switch (index) { case OPT_MAXLEN: - if (Tcl_GetIntFromObj(interp, objv[i+1], &maxlen) != TCL_OK) { + if (Tcl_GetIntFromObj(interp, objv[i + 1], &maxlen) != TCL_OK) { return TCL_ERROR; } if (maxlen < 0) { @@ -2655,7 +2663,7 @@ BinaryEncode64( } break; case OPT_WRAPCHAR: - wrapchar = TclGetStringFromObj(objv[i+1], &wrapcharlen); + wrapchar = TclGetStringFromObj(objv[i + 1], &wrapcharlen); if (wrapcharlen == 0) { maxlen = 0; } @@ -2664,9 +2672,9 @@ BinaryEncode64( } resultObj = Tcl_NewObj(); - data = Tcl_GetByteArrayFromObj(objv[objc-1], &count); + data = Tcl_GetByteArrayFromObj(objv[objc - 1], &count); if (count > 0) { - size = (((count * 4) / 3) + 3) & ~3; /* ensure 4 byte chunks */ + size = (((count * 4) / 3) + 3) & ~3; /* ensure 4 byte chunks */ if (maxlen > 0 && size > maxlen) { int adjusted = size + (wrapcharlen * (size / maxlen)); @@ -2677,15 +2685,15 @@ BinaryEncode64( } cursor = Tcl_SetByteArrayLength(resultObj, size); limit = cursor + size; - for (offset = 0; offset < count; offset+=3) { + for (offset = 0; offset < count; offset += 3) { unsigned char d[3] = {0, 0, 0}; - for (i = 0; i < 3 && offset+i < count; ++i) { + for (i = 0; i < 3 && offset + i < count; ++i) { d[i] = data[offset + i]; } OUTPUT(B64Digits[d[0] >> 2]); OUTPUT(B64Digits[((d[0] & 0x03) << 4) | (d[1] >> 4)]); - if (offset+1 < count) { + if (offset + 1 < count) { OUTPUT(B64Digits[((d[1] & 0x0f) << 2) | (d[2] >> 6)]); } else { OUTPUT(B64Digits[64]); @@ -2738,19 +2746,20 @@ BinaryEncodeUu( enum { OPT_MAXLEN, OPT_WRAPCHAR }; static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL }; - if (objc < 2 || objc%2 != 0) { + if (objc < 2 || objc % 2 != 0) { Tcl_WrongNumArgs(interp, 1, objv, "?-maxlen len? ?-wrapchar char? data"); return TCL_ERROR; } - for (i = 1; i < objc-1; i += 2) { + for (i = 1; i < objc - 1; i += 2) { if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option", TCL_EXACT, &index) != TCL_OK) { return TCL_ERROR; } switch (index) { case OPT_MAXLEN: - if (Tcl_GetIntFromObj(interp, objv[i+1], &lineLength) != TCL_OK) { + if (Tcl_GetIntFromObj(interp, objv[i + 1], + &lineLength) != TCL_OK) { return TCL_ERROR; } if (lineLength < 3 || lineLength > 85) { @@ -2762,7 +2771,7 @@ BinaryEncodeUu( } break; case OPT_WRAPCHAR: - wrapchar = Tcl_GetByteArrayFromObj(objv[i+1], &wrapcharlen); + wrapchar = Tcl_GetByteArrayFromObj(objv[i + 1], &wrapcharlen); break; } } @@ -2774,7 +2783,7 @@ BinaryEncodeUu( resultObj = Tcl_NewObj(); offset = 0; - data = Tcl_GetByteArrayFromObj(objv[objc-1], &count); + data = Tcl_GetByteArrayFromObj(objv[objc - 1], &count); rawLength = (lineLength - 1) * 3 / 4; start = cursor = Tcl_SetByteArrayLength(resultObj, (lineLength + wrapcharlen) * @@ -2795,11 +2804,11 @@ BinaryEncodeUu( lineLen = rawLength; } *cursor++ = UueDigits[lineLen]; - for (i=0 ; i<lineLen ; i++) { + for (i = 0 ; i < lineLen ; i++) { n <<= 8; n |= data[offset++]; for (bits += 8; bits > 6 ; bits -= 6) { - *cursor++ = UueDigits[(n >> (bits-6)) & 0x3f]; + *cursor++ = UueDigits[(n >> (bits - 6)) & 0x3f]; } } if (bits > 0) { @@ -2807,7 +2816,7 @@ BinaryEncodeUu( *cursor++ = UueDigits[(n >> (bits + 2)) & 0x3f]; bits = 0; } - for (j=0 ; j<wrapcharlen ; ++j) { + for (j = 0 ; j < wrapcharlen ; ++j) { *cursor++ = wrapchar[j]; } } @@ -2816,7 +2825,7 @@ BinaryEncodeUu( * Fix the length of the output bytearray. */ - Tcl_SetByteArrayLength(resultObj, cursor-start); + Tcl_SetByteArrayLength(resultObj, cursor - start); Tcl_SetObjResult(interp, resultObj); return TCL_OK; } @@ -2849,14 +2858,14 @@ BinaryDecodeUu( unsigned char *begin, *cursor; int i, index, size, count = 0, strict = 0, lineLen; unsigned char c; - enum {OPT_STRICT }; + enum { OPT_STRICT }; static const char *const optStrings[] = { "-strict", NULL }; if (objc < 2 || objc > 3) { Tcl_WrongNumArgs(interp, 1, objv, "?options? data"); return TCL_ERROR; } - for (i = 1; i < objc-1; ++i) { + for (i = 1; i < objc - 1; ++i) { if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option", TCL_EXACT, &index) != TCL_OK) { return TCL_ERROR; @@ -2870,7 +2879,7 @@ BinaryDecodeUu( TclNewObj(resultObj); datastart = data = (unsigned char *) - TclGetStringFromObj(objv[objc-1], &count); + TclGetStringFromObj(objv[objc - 1], &count); dataend = data + count; size = ((count + 3) & ~3) * 3 / 4; begin = cursor = Tcl_SetByteArrayLength(resultObj, size); @@ -2902,7 +2911,7 @@ BinaryDecodeUu( * Now we read a four-character grouping. */ - for (i=0 ; i<4 ; i++) { + for (i = 0 ; i < 4 ; i++) { if (data < dataend) { d[i] = c = *data++; if (c < 32 || c > 96) { @@ -3020,7 +3029,7 @@ BinaryDecode64( Tcl_WrongNumArgs(interp, 1, objv, "?options? data"); return TCL_ERROR; } - for (i = 1; i < objc-1; ++i) { + for (i = 1; i < objc - 1; ++i) { if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option", TCL_EXACT, &index) != TCL_OK) { return TCL_ERROR; @@ -3034,7 +3043,7 @@ BinaryDecode64( TclNewObj(resultObj); datastart = data = (unsigned char *) - TclGetStringFromObj(objv[objc-1], &count); + TclGetStringFromObj(objv[objc - 1], &count); dataend = data + count; size = ((count + 3) & ~3) * 3 / 4; begin = cursor = Tcl_SetByteArrayLength(resultObj, size); @@ -3062,8 +3071,11 @@ BinaryDecode64( c = '='; } else { if (strict && i <= 1) { - /* single resp. unfulfilled char (each 4th next single char) - * is rather bad64 error case in strict mode */ + /* + * Single resp. unfulfilled char (each 4th next single + * char) is rather bad64 error case in strict mode. + */ + goto bad64; } cut += 3; @@ -3079,10 +3091,10 @@ BinaryDecode64( if (cut) { if (c == '=' && i > 1) { - value <<= 6; - cut++; + value <<= 6; + cut++; } else if (!strict && TclIsSpaceProc(c)) { - i--; + i--; } else { goto bad64; } @@ -3096,11 +3108,15 @@ BinaryDecode64( value = (value << 6) | 0x3e; } else if (c == '/') { value = (value << 6) | 0x3f; - } else if (c == '=' && ( - !strict || i > 1) /* "=" and "a=" is rather bad64 error case in strict mode */ - ) { + } else if (c == '=' && (!strict || i > 1)) { + /* + * "=" and "a=" is rather bad64 error case in strict mode. + */ + value <<= 6; - if (i) cut++; + if (i) { + cut++; + } } else if (strict || !TclIsSpaceProc(c)) { goto bad64; } else { @@ -3147,4 +3163,3 @@ BinaryDecode64( * fill-column: 78 * End: */ - diff --git a/generic/tclDisassemble.c b/generic/tclDisassemble.c index e5fce72..76a4d46 100644 --- a/generic/tclDisassemble.c +++ b/generic/tclDisassemble.c @@ -837,7 +837,7 @@ UpdateStringOfInstName( if (inst > LAST_INST_OPCODE) { dst = Tcl_InitStringRep(objPtr, NULL, TCL_INTEGER_SPACE + 5); TclOOM(dst, TCL_INTEGER_SPACE + 5); - sprintf(dst, "inst_%" TCL_Z_MODIFIER "d", inst); + sprintf(dst, "inst_%" TCL_Z_MODIFIER "u", inst); (void) Tcl_InitStringRep(objPtr, NULL, strlen(dst)); } else { const char *s = tclInstructionTable[inst].name; diff --git a/generic/tclExecute.c b/generic/tclExecute.c index a2eed3f..6b69d97 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -97,9 +97,9 @@ static const char *const resultStrings[] = { */ #ifdef TCL_COMPILE_STATS -long tclObjsAlloced = 0; -long tclObjsFreed = 0; -long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 }; +size_t tclObjsAlloced = 0; +size_t tclObjsFreed = 0; +size_t tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 }; #endif /* TCL_COMPILE_STATS */ /* @@ -6471,7 +6471,7 @@ TEBCresume( listTmpIndex++; } } - TRACE_APPEND(("%d lists, iter %" TCL_Z_MODIFIER "d, %s loop\n", + TRACE_APPEND(("%d lists, iter %" TCL_Z_MODIFIER "u, %s loop\n", numLists, iterNum, (continueLoop? "continue" : "exit"))); /* @@ -8947,19 +8947,19 @@ ValidatePcAndStackTop( { int stackUpperBound = codePtr->maxStackDepth; /* Greatest legal value for stackTop. */ - unsigned relativePc = (unsigned) (pc - codePtr->codeStart); - unsigned long codeStart = (unsigned long) codePtr->codeStart; - unsigned long codeEnd = (unsigned long) + size_t relativePc = (size_t) (pc - codePtr->codeStart); + size_t codeStart = (size_t) codePtr->codeStart; + size_t codeEnd = (size_t) (codePtr->codeStart + codePtr->numCodeBytes); unsigned char opCode = *pc; - if (((unsigned long) pc < codeStart) || ((unsigned long) pc > codeEnd)) { + if (((size_t) pc < codeStart) || ((size_t) pc > codeEnd)) { fprintf(stderr, "\nBad instruction pc 0x%p in TclNRExecuteByteCode\n", pc); Tcl_Panic("TclNRExecuteByteCode execution failure: bad pc"); } if ((unsigned) opCode > LAST_INST_OPCODE) { - fprintf(stderr, "\nBad opcode %d at pc %u in TclNRExecuteByteCode\n", + fprintf(stderr, "\nBad opcode %d at pc %" TCL_Z_MODIFIER "u in TclNRExecuteByteCode\n", (unsigned) opCode, relativePc); Tcl_Panic("TclNRExecuteByteCode execution failure: bad opcode"); } @@ -8968,7 +8968,7 @@ ValidatePcAndStackTop( int numChars; const char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars, NULL, NULL); - fprintf(stderr, "\nBad stack top %d at pc %u in TclNRExecuteByteCode (min 0, max %i)", + fprintf(stderr, "\nBad stack top %d at pc %" TCL_Z_MODIFIER "u in TclNRExecuteByteCode (min 0, max %i)", stackTop, relativePc, stackUpperBound); if (cmd != NULL) { Tcl_Obj *message; @@ -9510,10 +9510,10 @@ EvalStatsCmd( double objBytesIfUnshared, strBytesIfUnshared, sharingBytesSaved; double strBytesSharedMultX, strBytesSharedOnce; double numInstructions, currentHeaderBytes; - long numCurrentByteCodes, numByteCodeLits; - long refCountSum, literalMgmtBytes, sum; - int numSharedMultX, numSharedOnce; - int decadeHigh, minSizeDecade, maxSizeDecade, length, i; + size_t numCurrentByteCodes, numByteCodeLits; + size_t refCountSum, literalMgmtBytes, sum; + size_t numSharedMultX, numSharedOnce, minSizeDecade, maxSizeDecade, i; + int decadeHigh, length; char *litTableStats; LiteralEntry *entryPtr; Tcl_Obj *objPtr; @@ -9555,12 +9555,12 @@ EvalStatsCmd( Tcl_AppendPrintfToObj(objPtr, "\n----------------------------------------------------------------\n"); Tcl_AppendPrintfToObj(objPtr, - "Compilation and execution statistics for interpreter %#lx\n", - (long int)iPtr); + "Compilation and execution statistics for interpreter %#" TCL_Z_MODIFIER "x\n", + (size_t)iPtr); - Tcl_AppendPrintfToObj(objPtr, "\nNumber ByteCodes executed\t%ld\n", + Tcl_AppendPrintfToObj(objPtr, "\nNumber ByteCodes executed\t%" TCL_Z_MODIFIER "u\n", statsPtr->numExecutions); - Tcl_AppendPrintfToObj(objPtr, "Number ByteCodes compiled\t%ld\n", + Tcl_AppendPrintfToObj(objPtr, "Number ByteCodes compiled\t%" TCL_Z_MODIFIER "u\n", statsPtr->numCompilations); Tcl_AppendPrintfToObj(objPtr, " Mean executions/compile\t%.1f\n", statsPtr->numExecutions / (float)statsPtr->numCompilations); @@ -9572,7 +9572,7 @@ EvalStatsCmd( Tcl_AppendPrintfToObj(objPtr, " Mean inst/execution\t\t%.0f\n", numInstructions / statsPtr->numExecutions); - Tcl_AppendPrintfToObj(objPtr, "\nTotal ByteCodes\t\t\t%ld\n", + Tcl_AppendPrintfToObj(objPtr, "\nTotal ByteCodes\t\t\t%" TCL_Z_MODIFIER "u\n", statsPtr->numCompilations); Tcl_AppendPrintfToObj(objPtr, " Source bytes\t\t\t%.6g\n", statsPtr->totalSrcBytes); @@ -9582,18 +9582,18 @@ EvalStatsCmd( statsPtr->totalByteCodeBytes); Tcl_AppendPrintfToObj(objPtr, " Literal bytes\t\t%.6g\n", totalLiteralBytes); - Tcl_AppendPrintfToObj(objPtr, " table %lu + bkts %lu + entries %lu + objects %lu + strings %.6g\n", - (unsigned long) sizeof(LiteralTable), - (unsigned long) (iPtr->literalTable.numBuckets * sizeof(LiteralEntry *)), - (unsigned long) (statsPtr->numLiteralsCreated * sizeof(LiteralEntry)), - (unsigned long) (statsPtr->numLiteralsCreated * sizeof(Tcl_Obj)), + Tcl_AppendPrintfToObj(objPtr, " table %" TCL_Z_MODIFIER "u + bkts %" TCL_Z_MODIFIER "u + entries %" TCL_Z_MODIFIER "u + objects %" TCL_Z_MODIFIER "u + strings %.6g\n", + sizeof(LiteralTable), + iPtr->literalTable.numBuckets * sizeof(LiteralEntry *), + statsPtr->numLiteralsCreated * sizeof(LiteralEntry), + statsPtr->numLiteralsCreated * sizeof(Tcl_Obj), statsPtr->totalLitStringBytes); Tcl_AppendPrintfToObj(objPtr, " Mean code/compile\t\t%.1f\n", totalCodeBytes / statsPtr->numCompilations); Tcl_AppendPrintfToObj(objPtr, " Mean code/source\t\t%.1f\n", totalCodeBytes / statsPtr->totalSrcBytes); - Tcl_AppendPrintfToObj(objPtr, "\nCurrent (active) ByteCodes\t%ld\n", + Tcl_AppendPrintfToObj(objPtr, "\nCurrent (active) ByteCodes\t%" TCL_Z_MODIFIER "u\n", numCurrentByteCodes); Tcl_AppendPrintfToObj(objPtr, " Source bytes\t\t\t%.6g\n", statsPtr->currentSrcBytes); @@ -9624,17 +9624,17 @@ EvalStatsCmd( numSharedMultX = 0; Tcl_AppendPrintfToObj(objPtr, "\nTcl_IsShared object check (all objects):\n"); - Tcl_AppendPrintfToObj(objPtr, " Object had refcount <=1 (not shared)\t%ld\n", + Tcl_AppendPrintfToObj(objPtr, " Object had refcount <=1 (not shared)\t%" TCL_Z_MODIFIER "u\n", tclObjsShared[1]); for (i = 2; i < TCL_MAX_SHARED_OBJ_STATS; i++) { - Tcl_AppendPrintfToObj(objPtr, " refcount ==%d\t\t%ld\n", + Tcl_AppendPrintfToObj(objPtr, " refcount ==%" TCL_Z_MODIFIER "u\t\t%" TCL_Z_MODIFIER "u\n", i, tclObjsShared[i]); numSharedMultX += tclObjsShared[i]; } - Tcl_AppendPrintfToObj(objPtr, " refcount >=%d\t\t%ld\n", + Tcl_AppendPrintfToObj(objPtr, " refcount >=%" TCL_Z_MODIFIER "u\t\t%" TCL_Z_MODIFIER "u\n", i, tclObjsShared[0]); numSharedMultX += tclObjsShared[0]; - Tcl_AppendPrintfToObj(objPtr, " Total shared objects\t\t\t%d\n", + Tcl_AppendPrintfToObj(objPtr, " Total shared objects\t\t\t%" TCL_Z_MODIFIER "u\n", numSharedMultX); /* @@ -9671,20 +9671,20 @@ EvalStatsCmd( sharingBytesSaved = (objBytesIfUnshared + strBytesIfUnshared) - currentLiteralBytes; - Tcl_AppendPrintfToObj(objPtr, "\nTotal objects (all interps)\t%ld\n", + Tcl_AppendPrintfToObj(objPtr, "\nTotal objects (all interps)\t%" TCL_Z_MODIFIER "u\n", tclObjsAlloced); - Tcl_AppendPrintfToObj(objPtr, "Current objects\t\t\t%ld\n", + Tcl_AppendPrintfToObj(objPtr, "Current objects\t\t\t%" TCL_Z_MODIFIER "u\n", (tclObjsAlloced - tclObjsFreed)); - Tcl_AppendPrintfToObj(objPtr, "Total literal objects\t\t%ld\n", + Tcl_AppendPrintfToObj(objPtr, "Total literal objects\t\t%" TCL_Z_MODIFIER "u\n", statsPtr->numLiteralsCreated); Tcl_AppendPrintfToObj(objPtr, "\nCurrent literal objects\t\t%d (%0.1f%% of current objects)\n", globalTablePtr->numEntries, Percent(globalTablePtr->numEntries, tclObjsAlloced-tclObjsFreed)); - Tcl_AppendPrintfToObj(objPtr, " ByteCode literals\t\t%ld (%0.1f%% of current literals)\n", + Tcl_AppendPrintfToObj(objPtr, " ByteCode literals\t\t%" TCL_Z_MODIFIER "u (%0.1f%% of current literals)\n", numByteCodeLits, Percent(numByteCodeLits, globalTablePtr->numEntries)); - Tcl_AppendPrintfToObj(objPtr, " Literals reused > 1x\t\t%d\n", + Tcl_AppendPrintfToObj(objPtr, " Literals reused > 1x\t\t%" TCL_Z_MODIFIER "u\n", numSharedMultX); Tcl_AppendPrintfToObj(objPtr, " Mean reference count\t\t%.2f\n", ((double) refCountSum) / globalTablePtr->numEntries); @@ -9709,7 +9709,7 @@ EvalStatsCmd( Tcl_AppendPrintfToObj(objPtr, " String sharing savings \t%.6g = unshared %.6g - shared %.6g\n", (strBytesIfUnshared - statsPtr->currentLitStringBytes), strBytesIfUnshared, statsPtr->currentLitStringBytes); - Tcl_AppendPrintfToObj(objPtr, " Literal mgmt overhead\t\t%ld (%0.1f%% of bytes with sharing)\n", + Tcl_AppendPrintfToObj(objPtr, " Literal mgmt overhead\t\t%" TCL_Z_MODIFIER "u (%0.1f%% of bytes with sharing)\n", literalMgmtBytes, Percent(literalMgmtBytes, currentLiteralBytes)); Tcl_AppendPrintfToObj(objPtr, " table %lu + buckets %lu + entries %lu\n", @@ -9759,7 +9759,8 @@ EvalStatsCmd( Tcl_AppendPrintfToObj(objPtr, "\nLiteral string sizes:\n"); Tcl_AppendPrintfToObj(objPtr, "\t Up to length\t\tPercentage\n"); maxSizeDecade = 0; - for (i = 31; i >= 0; i--) { + i = 32; + while (i-- > 0) { if (statsPtr->literalCount[i] > 0) { maxSizeDecade = i; break; @@ -9857,7 +9858,7 @@ EvalStatsCmd( Tcl_AppendPrintfToObj(objPtr, "\nInstruction counts:\n"); for (i = 0; i <= LAST_INST_OPCODE; i++) { - Tcl_AppendPrintfToObj(objPtr, "%20s %8ld ", + Tcl_AppendPrintfToObj(objPtr, "%20s %8" TCL_Z_MODIFIER "u ", tclInstructionTable[i].name, statsPtr->instructionCount[i]); if (statsPtr->instructionCount[i]) { Tcl_AppendPrintfToObj(objPtr, "%6.1f%%\n", diff --git a/generic/tclInt.h b/generic/tclInt.h index 933280a..edf92c5 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -569,7 +569,7 @@ typedef struct CommandTrace { struct CommandTrace *nextPtr; /* Next in list of traces associated with a * particular command. */ - size_t refCount; /* Used to ensure this structure is not + unsigned int refCount; /* Used to ensure this structure is not * deleted too early. Keeps track of how many * pieces of code have a pointer to this * structure. */ @@ -1519,11 +1519,11 @@ typedef struct LiteralEntry { * NULL if end of chain. */ Tcl_Obj *objPtr; /* Points to Tcl object that holds the * literal's bytes and length. */ - size_t refCount; /* If in an interpreter's global literal + unsigned int refCount; /* If in an interpreter's global literal * table, the number of ByteCode structures * that share the literal object; the literal * entry can be freed when refCount drops to - * 0. If in a local literal table, (size_t)-1. */ + * 0. If in a local literal table, (unsigned)-1. */ Namespace *nsPtr; /* Namespace in which this literal is used. We * try to avoid sharing literal non-FQ command * names among different namespaces to reduce @@ -1537,11 +1537,11 @@ typedef struct LiteralTable { LiteralEntry *staticBuckets[TCL_SMALL_HASH_TABLE]; /* Bucket array used for small tables to avoid * mallocs and frees. */ - int numBuckets; /* Total number of buckets allocated at + unsigned int numBuckets; /* Total number of buckets allocated at * **buckets. */ - int numEntries; /* Total number of entries present in + unsigned int numEntries; /* Total number of entries present in * table. */ - int rebuildSize; /* Enlarge table when numEntries gets to be + unsigned int rebuildSize; /* Enlarge table when numEntries gets to be * this large. */ unsigned int mask; /* Mask value used in hashing function. */ } LiteralTable; @@ -1554,10 +1554,10 @@ typedef struct LiteralTable { #ifdef TCL_COMPILE_STATS typedef struct ByteCodeStats { - long numExecutions; /* Number of ByteCodes executed. */ - long numCompilations; /* Number of ByteCodes created. */ - long numByteCodesFreed; /* Number of ByteCodes destroyed. */ - long instructionCount[256]; /* Number of times each instruction was + size_t numExecutions; /* Number of ByteCodes executed. */ + size_t numCompilations; /* Number of ByteCodes created. */ + size_t numByteCodesFreed; /* Number of ByteCodes destroyed. */ + size_t instructionCount[256]; /* Number of times each instruction was * executed. */ double totalSrcBytes; /* Total source bytes ever compiled. */ @@ -1565,10 +1565,10 @@ typedef struct ByteCodeStats { double currentSrcBytes; /* Src bytes for all current ByteCodes. */ double currentByteCodeBytes;/* Code bytes in all current ByteCodes. */ - long srcCount[32]; /* Source size distribution: # of srcs of + size_t srcCount[32]; /* Source size distribution: # of srcs of * size [2**(n-1)..2**n), n in [0..32). */ - long byteCodeCount[32]; /* ByteCode size distribution. */ - long lifetimeCount[32]; /* ByteCode lifetime distribution (ms). */ + size_t byteCodeCount[32]; /* ByteCode size distribution. */ + size_t lifetimeCount[32]; /* ByteCode lifetime distribution (ms). */ double currentInstBytes; /* Instruction bytes-current ByteCodes. */ double currentLitBytes; /* Current literal bytes. */ @@ -1576,11 +1576,11 @@ typedef struct ByteCodeStats { double currentAuxBytes; /* Current auxiliary information bytes. */ double currentCmdMapBytes; /* Current src<->code map bytes. */ - long numLiteralsCreated; /* Total literal objects ever compiled. */ + size_t numLiteralsCreated; /* Total literal objects ever compiled. */ double totalLitStringBytes; /* Total string bytes in all literals. */ double currentLitStringBytes; /* String bytes in current literals. */ - long literalCount[32]; /* Distribution of literal string sizes. */ + size_t literalCount[32]; /* Distribution of literal string sizes. */ } ByteCodeStats; #endif /* TCL_COMPILE_STATS */ @@ -2513,7 +2513,7 @@ typedef struct List { (((objPtr)->typePtr == &tclIntType \ && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(INT_MAX)) \ ? ((*(idxPtr) = ((objPtr)->internalRep.wideValue >= 0) \ - ? (int)(objPtr)->internalRep.wideValue : -1), TCL_OK) \ + ? (int)(objPtr)->internalRep.wideValue : TCL_INDEX_NONE), TCL_OK) \ : Tcl_GetIntForIndex((interp), (objPtr), (endValue), (idxPtr))) /* @@ -2776,10 +2776,10 @@ MODULE_SCOPE const Tcl_HashKeyType tclObjHashKeyType; MODULE_SCOPE Tcl_Obj * tclFreeObjList; #ifdef TCL_COMPILE_STATS -MODULE_SCOPE long tclObjsAlloced; -MODULE_SCOPE long tclObjsFreed; +MODULE_SCOPE size_t tclObjsAlloced; +MODULE_SCOPE size_t tclObjsFreed; #define TCL_MAX_SHARED_OBJ_STATS 5 -MODULE_SCOPE long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS]; +MODULE_SCOPE size_t tclObjsShared[TCL_MAX_SHARED_OBJ_STATS]; #endif /* TCL_COMPILE_STATS */ /* diff --git a/generic/tclLiteral.c b/generic/tclLiteral.c index 464f565..2f93200 100644 --- a/generic/tclLiteral.c +++ b/generic/tclLiteral.c @@ -104,7 +104,7 @@ TclDeleteLiteralTable( { LiteralEntry *entryPtr, *nextPtr; Tcl_Obj *objPtr; - int i; + size_t i; /* * Release remaining literals in the table. Note that releasing a literal @@ -227,7 +227,9 @@ TclCreateLiteral( if (flags & LITERAL_ON_HEAP) { ckfree(bytes); } - globalPtr->refCount++; + if (globalPtr->refCount != (unsigned) -1) { + globalPtr->refCount++; + } return objPtr; } } @@ -296,7 +298,8 @@ TclCreateLiteral( TclVerifyGlobalLiteralTable(iPtr); { LiteralEntry *entryPtr; - int found, i; + int found; + size_t i; found = 0; for (i=0 ; i<globalTablePtr->numBuckets ; i++) { @@ -464,7 +467,7 @@ TclRegisterLiteral( objIndex = AddLocalLiteralEntry(envPtr, objPtr, localHash); #ifdef TCL_COMPILE_DEBUG - if (globalPtr != NULL && globalPtr->refCount < 1) { + if (globalPtr != NULL && globalPtr->refCount + 1 < 2) { Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %d", "TclRegisterLiteral", (length>60? 60 : length), bytes, globalPtr->refCount); @@ -625,7 +628,7 @@ TclAddLiteralObj( lPtr = &envPtr->literalArrayPtr[objIndex]; lPtr->objPtr = objPtr; Tcl_IncrRefCount(objPtr); - lPtr->refCount = (size_t)-1; /* i.e., unused */ + lPtr->refCount = (unsigned) -1; /* i.e., unused */ lPtr->nextPtr = NULL; if (litPtrPtr) { @@ -687,7 +690,8 @@ AddLocalLiteralEntry( TclVerifyLocalLiteralTable(envPtr); { char *bytes; - int length, found, i; + int length, found; + size_t i; found = 0; for (i=0 ; i<localTablePtr->numBuckets ; i++) { @@ -741,15 +745,15 @@ ExpandLocalLiteralArray( */ LiteralTable *localTablePtr = &envPtr->localLitTable; - int currElems = envPtr->literalArrayNext; + size_t currElems = envPtr->literalArrayNext; size_t currBytes = (currElems * sizeof(LiteralEntry)); LiteralEntry *currArrayPtr = envPtr->literalArrayPtr; LiteralEntry *newArrayPtr; - int i; - unsigned int newSize = (currBytes <= UINT_MAX / 2) ? 2*currBytes : UINT_MAX; + size_t i; + size_t newSize = (currBytes <= UINT_MAX / 2) ? 2*currBytes : UINT_MAX; if (currBytes == newSize) { - Tcl_Panic("max size of Tcl literal array (%d literals) exceeded", + Tcl_Panic("max size of Tcl literal array (%" TCL_Z_MODIFIER "u literals) exceeded", currElems); } @@ -848,7 +852,7 @@ TclReleaseLiteral( * literal table entry (decrement the ref count of the object). */ - if (entryPtr->refCount-- <= 1) { + if ((entryPtr->refCount != (unsigned)-1) && (entryPtr->refCount-- <= 1)) { if (prevPtr == NULL) { globalTablePtr->buckets[index] = entryPtr->nextPtr; } else { @@ -1090,7 +1094,9 @@ TclLiteralStats( LiteralTable *tablePtr) /* Table for which to produce stats. */ { #define NUM_COUNTERS 10 - int count[NUM_COUNTERS], overflow, i, j; + size_t count[NUM_COUNTERS]; + int overflow; + size_t i, j; double average, tmp; register LiteralEntry *entryPtr; char *result, *p; @@ -1129,7 +1135,7 @@ TclLiteralStats( tablePtr->numEntries, tablePtr->numBuckets); p = result + strlen(result); for (i=0 ; i<NUM_COUNTERS ; i++) { - sprintf(p, "number of buckets with %d entries: %d\n", + sprintf(p, "number of buckets with %" TCL_Z_MODIFIER "u entries: %" TCL_Z_MODIFIER "u\n", i, count[i]); p += strlen(p); } @@ -1166,17 +1172,17 @@ TclVerifyLocalLiteralTable( register LiteralTable *localTablePtr = &envPtr->localLitTable; register LiteralEntry *localPtr; char *bytes; - register int i; - int length, count; + size_t i, count; + int length; count = 0; for (i=0 ; i<localTablePtr->numBuckets ; i++) { for (localPtr=localTablePtr->buckets[i] ; localPtr!=NULL; localPtr=localPtr->nextPtr) { count++; - if (localPtr->refCount != -1) { + if (localPtr->refCount != (unsigned)-1) { bytes = TclGetStringFromObj(localPtr->objPtr, &length); - Tcl_Panic("%s: local literal \"%.*s\" had bad refCount %d", + Tcl_Panic("%s: local literal \"%.*s\" had bad refCount %u", "TclVerifyLocalLiteralTable", (length>60? 60 : length), bytes, localPtr->refCount); } @@ -1187,7 +1193,7 @@ TclVerifyLocalLiteralTable( } } if (count != localTablePtr->numEntries) { - Tcl_Panic("%s: local literal table had %d entries, should be %d", + Tcl_Panic("%s: local literal table had %" TCL_Z_MODIFIER "u entries, should be %u", "TclVerifyLocalLiteralTable", count, localTablePtr->numEntries); } @@ -1217,15 +1223,15 @@ TclVerifyGlobalLiteralTable( register LiteralTable *globalTablePtr = &iPtr->literalTable; register LiteralEntry *globalPtr; char *bytes; - register int i; - int length, count; + size_t i, count; + int length; count = 0; for (i=0 ; i<globalTablePtr->numBuckets ; i++) { for (globalPtr=globalTablePtr->buckets[i] ; globalPtr!=NULL; globalPtr=globalPtr->nextPtr) { count++; - if (globalPtr->refCount < 1) { + if (globalPtr->refCount + 1 < 2) { bytes = TclGetStringFromObj(globalPtr->objPtr, &length); Tcl_Panic("%s: global literal \"%.*s\" had bad refCount %d", "TclVerifyGlobalLiteralTable", @@ -1238,7 +1244,7 @@ TclVerifyGlobalLiteralTable( } } if (count != globalTablePtr->numEntries) { - Tcl_Panic("%s: global literal table had %d entries, should be %d", + Tcl_Panic("%s: global literal table had %" TCL_Z_MODIFIER "u entries, should be %u", "TclVerifyGlobalLiteralTable", count, globalTablePtr->numEntries); } diff --git a/generic/tclRegexp.c b/generic/tclRegexp.c index 804b117..d3f7428 100644 --- a/generic/tclRegexp.c +++ b/generic/tclRegexp.c @@ -263,7 +263,7 @@ Tcl_RegExpRange( if ((size_t) index > regexpPtr->re.re_nsub) { *startPtr = *endPtr = NULL; - } else if (regexpPtr->matches[index].rm_so < 0) { + } else if (regexpPtr->matches[index].rm_so == TCL_INDEX_NONE) { *startPtr = *endPtr = NULL; } else { if (regexpPtr->objPtr) { @@ -364,7 +364,7 @@ TclRegExpRangeUniChar( * passed to Tcl_RegExpExec. */ int index, /* 0 means give the range of the entire match, * > 0 means give the range of a matching - * subrange, -1 means the range of the + * subrange, TCL_INDEX_NONE means the range of the * rm_extend field. */ int *startPtr, /* Store address of first character in * (sub-)range here. */ @@ -373,12 +373,12 @@ TclRegExpRangeUniChar( { TclRegexp *regexpPtr = (TclRegexp *) re; - if ((regexpPtr->flags®_EXPECT) && index == -1) { + if ((regexpPtr->flags®_EXPECT) && (index == TCL_INDEX_NONE)) { *startPtr = regexpPtr->details.rm_extend.rm_so; *endPtr = regexpPtr->details.rm_extend.rm_eo; } else if ((size_t) index > regexpPtr->re.re_nsub) { - *startPtr = -1; - *endPtr = -1; + *startPtr = TCL_INDEX_NONE; + *endPtr = TCL_INDEX_NONE; } else { *startPtr = regexpPtr->matches[index].rm_so; *endPtr = regexpPtr->matches[index].rm_eo; |