summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--doc/expr.n38
-rw-r--r--generic/regexec.c2
-rw-r--r--generic/tclAssembly.c1
-rw-r--r--generic/tclBinary.c301
-rw-r--r--generic/tclDisassemble.c2
-rw-r--r--generic/tclExecute.c75
-rw-r--r--generic/tclInt.h56
-rw-r--r--generic/tclLiteral.c50
-rw-r--r--generic/tclRegexp.c10
-rw-r--r--tools/tcltk-man2html-utils.tcl4
-rwxr-xr-xtools/tcltk-man2html.tcl87
11 files changed, 349 insertions, 277 deletions
diff --git a/doc/expr.n b/doc/expr.n
index 1b3cf9a..cd546c1 100644
--- a/doc/expr.n
+++ b/doc/expr.n
@@ -97,7 +97,7 @@ and the value of \fBb\fR is 6. The command on the left side of each line
produces the value on the right side.
.PP
.CS
-.ta 6c
+.ta 8c
\fBexpr\fR 3.1 + $a \fI6.1\fR
\fBexpr\fR 2 + "$a.$b" \fI5.6\fR
\fBexpr\fR 4*[llength "6 2"] \fI8\fR
@@ -190,16 +190,20 @@ Bit-wise OR. Valid for integer operands.
\fB&&\fR
.
Logical AND. If both operands are true, the result is 1, or 0 otherwise.
-
+This operator evaluates lazily; it only evaluates its second operand if it
+must in order to determine its result.
.TP 20
\fB||\fR
.
Logical OR. If both operands are false, the result is 0, or 1 otherwise.
+This operator evaluates lazily; it only evaluates its second operand if it
+must in order to determine its result.
.TP 20
-\fIx\fB?\fIy\fB:\fIz\fR
+\fIx \fB?\fI y \fB:\fI z\fR
.
If-then-else, as in C. If \fIx\fR is false , the result is the value of
\fIy\fR. Otherwise the result is the value of \fIz\fR.
+This operator evaluates lazily; it evaluates only one of \fIy\fR or \fIz\fR.
.PP
The exponentiation operator promotes types in the same way that the multiply
and divide operators do, and the result is is the same as the result of
@@ -339,33 +343,55 @@ substitution on the value before \fBexpr\fR is called.
In the following example, the value of the expression is 11 because the Tcl parser first
substitutes \fB$b\fR and \fBexpr\fR then substitutes \fB$a\fR. Enclosing the
expression in braces would result in a syntax error.
+.PP
.CS
set a 3
set b {$a + 2}
\fBexpr\fR $b*4
.CE
.PP
-
-When an expression is generated at runtime, like the one above is, the bytcode
+When an expression is generated at runtime, like the one above is, the bytecode
compiler must ensure that new code is generated each time the expression
is evaluated. This is the most costly kind of expression from a performance
perspective. In such cases, consider directly using the commands described in
the \fBmathfunc\fR(n) or \fBmathop\fR(n) documentation instead of \fBexpr\fR.
-
+.PP
Most expressions are not formed at runtime, but are literal strings or contain
substitutions that don't introduce other substitutions. To allow the bytecode
compiler to work with an expression as a string literal at compilation time,
ensure that it contains no substitutions or that it is enclosed in braces or
otherwise quoted to prevent Tcl from performing substitutions, allowing
\fBexpr\fR to perform them instead.
+.PP
+If it is necessary to include a non-constant expression string within the
+wider context of an otherwise-constant expression, the most efficient
+technique is to put the varying part inside a recursive \fBexpr\fR, as this at
+least allows for the compilation of the outer part, though it does mean that
+the varying part must itself be evaluated as a separate expression. Thus, in
+this example the result is 20 and the outer expression benefits from fully
+cached bytecode compilation.
+.PP
+.CS
+set a 3
+set b {$a + 2}
+\fBexpr\fR {[\fBexpr\fR $b] * 4}
+.CE
+.PP
+In general, you should enclose your expression in braces wherever possible,
+and where not possible, the argument to \fBexpr\fR should be an expression
+defined elsewhere as simply as possible. It is usually more efficient and
+safer to use other techniques (e.g., the commands in the \fBtcl::mathop\fR
+namespace) than it is to do complex expression generation.
.SH EXAMPLES
.PP
A numeric comparison whose result is 1:
+.PP
.CS
\fBexpr\fR {"0x03" > "2"}
.CE
.PP
A string comparison whose result is 1:
+.PP
.CS
\fBexpr\fR {"0y" > "0x12"}
.CE
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/tclAssembly.c b/generic/tclAssembly.c
index 47f7100..3615f33 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -517,6 +517,7 @@ static const unsigned char NonThrowingByteCodes[] = {
INST_PUSH1, INST_PUSH4, INST_POP, INST_DUP, /* 1-4 */
INST_JUMP1, INST_JUMP4, /* 34-35 */
INST_END_CATCH, INST_PUSH_RESULT, INST_PUSH_RETURN_CODE, /* 70-72 */
+ INST_STR_EQ, INST_STR_NEQ, INST_STR_CMP, INST_STR_LEN, /* 73-76 */
INST_LIST, /* 79 */
INST_OVER, /* 95 */
INST_PUSH_RETURN_OPTIONS, /* 108 */
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..dbddb91 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 */
/*
@@ -4029,39 +4029,21 @@ MODULE_SCOPE int TclDivOpCmd(ClientData clientData,
MODULE_SCOPE int TclCompileDivOpCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
-MODULE_SCOPE int TclLessOpCmd(ClientData clientData,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *const objv[]);
MODULE_SCOPE int TclCompileLessOpCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
-MODULE_SCOPE int TclLeqOpCmd(ClientData clientData,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *const objv[]);
MODULE_SCOPE int TclCompileLeqOpCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
-MODULE_SCOPE int TclGreaterOpCmd(ClientData clientData,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *const objv[]);
MODULE_SCOPE int TclCompileGreaterOpCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
-MODULE_SCOPE int TclGeqOpCmd(ClientData clientData,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *const objv[]);
MODULE_SCOPE int TclCompileGeqOpCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
-MODULE_SCOPE int TclEqOpCmd(ClientData clientData,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *const objv[]);
MODULE_SCOPE int TclCompileEqOpCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
-MODULE_SCOPE int TclStreqOpCmd(ClientData clientData,
- Tcl_Interp *interp, int objc,
- Tcl_Obj *const objv[]);
MODULE_SCOPE int TclCompileStreqOpCmd(Tcl_Interp *interp,
Tcl_Parse *parsePtr, Command *cmdPtr,
struct CompileEnv *envPtr);
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&REG_EXPECT) && index == -1) {
+ if ((regexpPtr->flags&REG_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;
diff --git a/tools/tcltk-man2html-utils.tcl b/tools/tcltk-man2html-utils.tcl
index 5a4550b..e851047 100644
--- a/tools/tcltk-man2html-utils.tcl
+++ b/tools/tcltk-man2html-utils.tcl
@@ -1566,6 +1566,10 @@ proc make-manpage-section {outputDir sectionDescriptor} {
puts stderr ""
}
+ if {![llength $manual(wing-toc)]} {
+ fatal "not table of contents."
+ }
+
#
# make the wing table of contents for the section
#
diff --git a/tools/tcltk-man2html.tcl b/tools/tcltk-man2html.tcl
index e4cf3e9..08f3d28 100755
--- a/tools/tcltk-man2html.tcl
+++ b/tools/tcltk-man2html.tcl
@@ -31,36 +31,50 @@ set ::CSSFILE "docs.css"
##
source [file join [file dirname [info script]] tcltk-man2html-utils.tcl]
+proc getversion {tclh {name {}}} {
+ if {[file exists $tclh]} {
+ set chan [open $tclh]
+ set data [read $chan]
+ close $chan
+ if {$name eq ""} {
+ set name [string toupper [file root [file tail $tclh]]]
+ }
+ # backslash isn't required in front of quote, but it keeps syntax
+ # highlighting straight in some editors
+ if {[regexp -lineanchor \
+ [string map [list @name@ $name] \
+ {^#define\s+@name@_VERSION\s+\"([^.])+\.([^.\"]+)}] \
+ $data -> major minor]} {
+ return [list $major $minor]
+ }
+ }
+}
proc findversion {top name useversion} {
+ # Default search version is a glob pattern, switch it for string match:
+ if {$useversion eq {{,[8-9].[0-9]{,[.ab][0-9]{,[0-9]}}}}} {
+ set useversion {[8-9].[0-9]}
+ }
+ # Search:
set upper [string toupper $name]
foreach top1 [list $top $top/..] sub {{} generic} {
foreach dirname [
glob -nocomplain -tails -type d -directory $top1 *] {
- set tclh [join [list $top1 $dirname {*}$sub $name.h] /]
- if {[file exists $tclh]} {
- set chan [open $tclh]
- set data [read $chan]
- close $chan
- # backslash isn't required in front of quote, but it keeps syntax
- # highlighting straight in some editors
- if {[regexp -lineanchor \
- [string map [list @name@ $upper] \
- {^#define\s+@name@_VERSION\s+\"([^.])+\.([^.\"]+)}] \
- $data -> major minor]} {
- # to do
- # use glob matching instead of string matching or add
- # brace handling to [string matcch]
- if {$useversion eq {} || [string match $useversion $major.$minor]} {
- set top [file dirname [file dirname $tclh]]
- set prefix [file dirname $top]
- return [list $prefix [file tail $top] $major $minor]
- }
+ set tclh [join [list $top1 $dirname {*}$sub ${name}.h] /]
+ set v [getversion $tclh $upper]
+ if {[llength $v]} {
+ lassign $v major minor
+ # to do
+ # use glob matching instead of string matching or add
+ # brace handling to [string matcch]
+ if {$useversion eq {} || [string match $useversion $major.$minor]} {
+ set top [file dirname [file dirname $tclh]]
+ set prefix [file dirname $top]
+ return [list $prefix [file tail $top] $major $minor]
}
}
}
}
- return
}
proc parse_command_line {} {
@@ -151,9 +165,19 @@ proc parse_command_line {} {
set build_tk 1
}
+ set major ""
+ set minor ""
+
if {$build_tcl} {
- # Find Tcl.
- lassign [findversion $tcltkdir tcl $useversion] tcltkdir tcldir major minor
+ # Find Tcl (firstly using glob pattern / backwards compatible way)
+ set tcldir [lindex [lsort [glob -nocomplain -tails -type d \
+ -directory $tcltkdir tcl$useversion]] end]
+ if {$tcldir ne {}} {
+ # obtain version from generic header if we can:
+ lassign [getversion [file join $tcltkdir $tcldir generic tcl.h]] major minor
+ } else {
+ lassign [findversion $tcltkdir tcl $useversion] tcltkdir tcldir major minor
+ }
if {$tcldir eq {} && $opt_build_tcl} {
puts stderr "tcltk-man-html: couldn't find Tcl below $tcltkdir"
exit 1
@@ -163,8 +187,17 @@ proc parse_command_line {} {
if {$build_tk} {
- # Find Tk.
- lassign [findversion $tcltkdir tk $useversion] tcltkdir tkdir major minor
+ # Find Tk (firstly using glob pattern / backwards compatible way)
+ set tkdir [lindex [lsort [glob -nocomplain -tails -type d \
+ -directory $tcltkdir tk$useversion]] end]
+ if {$tkdir ne {}} {
+ if {$major eq ""} {
+ # obtain version from generic header if we can:
+ lassign [getversion [file join $tcltkdir $tcldir generic tk.h]] major minor
+ }
+ } else {
+ lassign [findversion $tcltkdir tk $useversion] tcltkdir tkdir major minor
+ }
if {$tkdir eq {} && $opt_build_tk} {
puts stderr "tcltk-man-html: couldn't find Tk below $tcltkdir"
exit 1
@@ -178,7 +211,11 @@ proc parse_command_line {} {
global overall_title
set overall_title ""
if {$build_tcl} {
- append overall_title "Tcl $major.$minor"
+ if {$major ne ""} {
+ append overall_title "Tcl $major.$minor"
+ } else {
+ append overall_title "Tcl [capitalize $tcldir]"
+ }
}
if {$build_tcl && $build_tk} {
append overall_title "/"
generated by cgit v0.12 at 2024-11-13 07:56:40 (GMT)