Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
| Comment: | Fix travis build (.travis.yml), and merge 8.7 |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | tip-549 |
| Files: | files | file ages | folders |
| SHA3-256: |
ed3800e114e500c9b08ab38c27d189cb |
| User & Date: | jan.nijtmans 2019-06-14 14:04:22 |
Context
|
2019-06-14
| ||
| 14:04 | Fix travis build (.travis.yml), and merge 8.7 Leaf check-in: ed3800e114 user: jan.nijtmans tags: tip-549 | |
|
2019-06-12
| ||
| 15:26 | Eliminate (internal) TclOffset() usage, just use offsetof() in stead. check-in: f0c76dd6a8 user: jan.nijtmans tags: core-8-branch | |
|
2019-06-07
| ||
| 16:54 | New TIP implementation: Make configure --enable-64bit the default check-in: 93a999f923 user: jan.nijtmans tags: tip-549 | |
Changes
Changes to .travis.yml.
140 140 - binutils-mingw-w64-i686 141 141 - gcc-mingw-w64-i686 142 142 - gcc-mingw-w64 143 143 - gcc-multilib 144 144 - wine 145 145 env: 146 146 - BUILD_DIR=win 147 - - CFGOPT=--host=i686-w64-mingw32 147 + - CFGOPT="--host=i686-w64-mingw32 --disable-64bit" 148 148 - NO_DIRECT_TEST=1 149 149 - os: linux 150 150 dist: xenial 151 151 compiler: i686-w64-mingw32-gcc 152 152 addons: 153 153 apt: 154 154 packages:
Changes to doc/expr.n.
93 93 \fBTcl\fR. 94 94 .PP 95 95 Below are some examples of simple expressions where the value of \fBa\fR is 3 96 96 and the value of \fBb\fR is 6. The command on the left side of each line 97 97 produces the value on the right side. 98 98 .PP 99 99 .CS 100 -.ta 6c 100 +.ta 9c 101 101 \fBexpr\fR 3.1 + $a \fI6.1\fR 102 102 \fBexpr\fR 2 + "$a.$b" \fI5.6\fR 103 103 \fBexpr\fR 4*[llength "6 2"] \fI8\fR 104 104 \fBexpr\fR {{word one} < "word $a"} \fI0\fR 105 105 .CE 106 106 .SS OPERATORS 107 107 .PP ................................................................................ 186 186 \fB|\fR 187 187 . 188 188 Bit-wise OR. Valid for integer operands. 189 189 .TP 20 190 190 \fB&&\fR 191 191 . 192 192 Logical AND. If both operands are true, the result is 1, or 0 otherwise. 193 - 193 +This operator evaluates lazily; it only evaluates its second operand if it 194 +must in order to determine its result. 195 +This operator evaluates lazily; it only evaluates its second operand if it 196 +must in order to determine its result. 194 197 .TP 20 195 198 \fB||\fR 196 199 . 197 200 Logical OR. If both operands are false, the result is 0, or 1 otherwise. 201 +This operator evaluates lazily; it only evaluates its second operand if it 202 +must in order to determine its result. 198 203 .TP 20 199 -\fIx\fB?\fIy\fB:\fIz\fR 204 +\fIx \fB?\fI y \fB:\fI z\fR 200 205 . 201 206 If-then-else, as in C. If \fIx\fR is false , the result is the value of 202 207 \fIy\fR. Otherwise the result is the value of \fIz\fR. 208 +This operator evaluates lazily; it evaluates only one of \fIy\fR or \fIz\fR. 203 209 .PP 204 210 The exponentiation operator promotes types in the same way that the multiply 205 211 and divide operators do, and the result is is the same as the result of 206 212 \fBpow\fR. 207 213 Exponentiation groups right-to-left within a precedence level. Other binary 208 214 operators group left-to-right. For example, the value of 215 +.PP 209 216 .PP 210 217 .CS 211 218 \fBexpr\fR {4*2 < 7} 212 219 .CE 213 220 .PP 214 221 is 0, while the value of 215 222 .PP ................................................................................ 333 340 substitutions on, enclosing an expression in braces or otherwise quoting it 334 341 so that it's a static value allows the Tcl compiler to generate bytecode for 335 342 the expression, resulting in better speed and smaller storage requirements. 336 343 This also avoids issues that can arise if Tcl is allowed to perform 337 344 substitution on the value before \fBexpr\fR is called. 338 345 .PP 339 346 In the following example, the value of the expression is 11 because the Tcl parser first 340 -substitutes \fB$b\fR and \fBexpr\fR then substitutes \fB$a\fR. Enclosing the 341 -expression in braces would result in a syntax error. 347 +substitutes \fB$b\fR and \fBexpr\fR then substitutes \fB$a\fR as part 348 +of evaluating the expression 349 +.QW "$a + 2*4" . 350 +Enclosing the 351 +expression in braces would result in a syntax error as \fB$b\fR does 352 +not evaluate to a numeric value. 353 +.PP 342 354 .CS 343 355 set a 3 344 356 set b {$a + 2} 345 357 \fBexpr\fR $b*4 346 358 .CE 347 359 .PP 348 - 349 -When an expression is generated at runtime, like the one above is, the bytcode 360 +When an expression is generated at runtime, like the one above is, the bytecode 350 361 compiler must ensure that new code is generated each time the expression 351 362 is evaluated. This is the most costly kind of expression from a performance 352 363 perspective. In such cases, consider directly using the commands described in 353 364 the \fBmathfunc\fR(n) or \fBmathop\fR(n) documentation instead of \fBexpr\fR. 354 - 365 +.PP 355 366 Most expressions are not formed at runtime, but are literal strings or contain 356 367 substitutions that don't introduce other substitutions. To allow the bytecode 357 368 compiler to work with an expression as a string literal at compilation time, 358 369 ensure that it contains no substitutions or that it is enclosed in braces or 359 370 otherwise quoted to prevent Tcl from performing substitutions, allowing 360 371 \fBexpr\fR to perform them instead. 372 +.PP 373 +If it is necessary to include a non-constant expression string within the 374 +wider context of an otherwise-constant expression, the most efficient 375 +technique is to put the varying part inside a recursive \fBexpr\fR, as this at 376 +least allows for the compilation of the outer part, though it does mean that 377 +the varying part must itself be evaluated as a separate expression. Thus, in 378 +this example the result is 20 and the outer expression benefits from fully 379 +cached bytecode compilation. 380 +.PP 381 +.CS 382 +set a 3 383 +set b {$a + 2} 384 +\fBexpr\fR {[\fBexpr\fR $b] * 4} 385 +.CE 386 +.PP 387 +In general, you should enclose your expression in braces wherever possible, 388 +and where not possible, the argument to \fBexpr\fR should be an expression 389 +defined elsewhere as simply as possible. It is usually more efficient and 390 +safer to use other techniques (e.g., the commands in the \fBtcl::mathop\fR 391 +namespace) than it is to do complex expression generation. 361 392 .SH EXAMPLES 362 393 .PP 363 394 A numeric comparison whose result is 1: 395 +.PP 364 396 .CS 365 397 \fBexpr\fR {"0x03" > "2"} 366 398 .CE 367 399 .PP 368 400 A string comparison whose result is 1: 401 +.PP 369 402 .CS 370 403 \fBexpr\fR {"0y" > "0x12"} 371 404 .CE 372 405 .PP 373 406 Define a procedure that computes an 374 407 .QW interesting 375 408 mathematical function:
Changes to generic/tclAssembly.c.
513 513 * The instructions must be in ascending order by numeric operation code. 514 514 */ 515 515 516 516 static const unsigned char NonThrowingByteCodes[] = { 517 517 INST_PUSH1, INST_PUSH4, INST_POP, INST_DUP, /* 1-4 */ 518 518 INST_JUMP1, INST_JUMP4, /* 34-35 */ 519 519 INST_END_CATCH, INST_PUSH_RESULT, INST_PUSH_RETURN_CODE, /* 70-72 */ 520 + INST_STR_EQ, INST_STR_NEQ, INST_STR_CMP, INST_STR_LEN, /* 73-76 */ 520 521 INST_LIST, /* 79 */ 521 522 INST_OVER, /* 95 */ 522 523 INST_PUSH_RETURN_OPTIONS, /* 108 */ 523 524 INST_REVERSE, /* 126 */ 524 525 INST_NOP, /* 132 */ 525 526 INST_STR_MAP, /* 143 */ 526 527 INST_STR_FIND, /* 144 */
Changes to generic/tclBasic.c.
596 596 } 597 597 598 598 #if defined(_WIN32) && !defined(_WIN64) 599 599 if (sizeof(time_t) != 4) { 600 600 /*NOTREACHED*/ 601 601 Tcl_Panic("<time.h> is not compatible with MSVC"); 602 602 } 603 - if ((TclOffset(Tcl_StatBuf,st_atime) != 32) 604 - || (TclOffset(Tcl_StatBuf,st_ctime) != 40)) { 603 + if ((offsetof(Tcl_StatBuf,st_atime) != 32) 604 + || (offsetof(Tcl_StatBuf,st_ctime) != 40)) { 605 605 /*NOTREACHED*/ 606 606 Tcl_Panic("<sys/stat.h> is not compatible with MSVC"); 607 607 } 608 608 #endif 609 609 610 610 if (cancelTableInitialized == 0) { 611 611 Tcl_MutexLock(&cancelLock);
Changes to generic/tclBinary.c.
155 155 { "hex", BinaryDecodeHex, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 }, 156 156 { "uuencode", BinaryDecodeUu, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 }, 157 157 { "base64", BinaryDecode64, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0 }, 158 158 { NULL, NULL, NULL, NULL, NULL, 0 } 159 159 }; 160 160 161 161 /* 162 - * The following object types represent an array of bytes. The intent is 163 - * to allow arbitrary binary data to pass through Tcl as a Tcl value 164 - * without loss or damage. Such values are useful for things like 165 - * encoded strings or Tk images to name just two. 162 + * The following object types represent an array of bytes. The intent is to 163 + * allow arbitrary binary data to pass through Tcl as a Tcl value without loss 164 + * or damage. Such values are useful for things like encoded strings or Tk 165 + * images to name just two. 166 166 * 167 - * It's strange to have two Tcl_ObjTypes in place for this task when 168 - * one would do, so a bit of detail and history how we got to this point 169 - * and where we might go from here. 167 + * It's strange to have two Tcl_ObjTypes in place for this task when one would 168 + * do, so a bit of detail and history how we got to this point and where we 169 + * might go from here. 170 170 * 171 - * A bytearray is an ordered sequence of bytes. Each byte is an integer 172 - * value in the range [0-255]. To be a Tcl value type, we need a way to 173 - * encode each value in the value set as a Tcl string. The simplest 174 - * encoding is to represent each byte value as the same codepoint value. 175 - * A bytearray of N bytes is encoded into a Tcl string of N characters 176 - * where the codepoint of each character is the value of corresponding byte. 177 - * This approach creates a one-to-one map between all bytearray values 178 - * and a subset of Tcl string values. 171 + * A bytearray is an ordered sequence of bytes. Each byte is an integer value 172 + * in the range [0-255]. To be a Tcl value type, we need a way to encode each 173 + * value in the value set as a Tcl string. The simplest encoding is to 174 + * represent each byte value as the same codepoint value. A bytearray of N 175 + * bytes is encoded into a Tcl string of N characters where the codepoint of 176 + * each character is the value of corresponding byte. This approach creates a 177 + * one-to-one map between all bytearray values and a subset of Tcl string 178 + * values. 179 179 * 180 180 * When converting a Tcl string value to the bytearray internal rep, the 181 181 * question arises what to do with strings outside that subset? That is, 182 - * those Tcl strings containing at least one codepoint greater than 255? 183 - * The obviously correct answer is to raise an error! That string value 184 - * does not represent any valid bytearray value. Full Stop. The 185 - * setFromAnyProc signature has a completion code return value for just 186 - * this reason, to reject invalid inputs. 187 - * 188 - * Unfortunately this was not the path taken by the authors of the 189 - * original tclByteArrayType. They chose to accept all Tcl string values 190 - * as acceptable string encodings of the bytearray values that result 191 - * from masking away the high bits of any codepoint value at all. This 192 - * meant that every bytearray value had multiple accepted string 193 - * representations. 194 - * 195 - * The implications of this choice are truly ugly. When a Tcl value has 196 - * a string representation, we are required to accept that as the true 197 - * value. Bytearray values that possess a string representation cannot 198 - * be processed as bytearrays because we cannot know which true value 199 - * that bytearray represents. The consequence is that we drag around 200 - * an internal rep that we cannot make any use of. This painful price 201 - * is extracted at any point after a string rep happens to be generated 202 - * for the value. This happens even when the troublesome codepoints 203 - * outside the byte range never show up. This happens rather routinely 204 - * in normal Tcl operations unless we burden the script writer with the 205 - * cognitive burden of avoiding it. The price is also paid by callers 206 - * of the C interface. The routine 182 + * those Tcl strings containing at least one codepoint greater than 255? The 183 + * obviously correct answer is to raise an error! That string value does not 184 + * represent any valid bytearray value. Full Stop. The setFromAnyProc 185 + * signature has a completion code return value for just this reason, to 186 + * reject invalid inputs. 187 + * 188 + * Unfortunately this was not the path taken by the authors of the original 189 + * tclByteArrayType. They chose to accept all Tcl string values as acceptable 190 + * string encodings of the bytearray values that result from masking away the 191 + * high bits of any codepoint value at all. This meant that every bytearray 192 + * value had multiple accepted string representations. 193 + * 194 + * The implications of this choice are truly ugly. When a Tcl value has a 195 + * string representation, we are required to accept that as the true value. 196 + * Bytearray values that possess a string representation cannot be processed 197 + * as bytearrays because we cannot know which true value that bytearray 198 + * represents. The consequence is that we drag around an internal rep that we 199 + * cannot make any use of. This painful price is extracted at any point after 200 + * a string rep happens to be generated for the value. This happens even when 201 + * the troublesome codepoints outside the byte range never show up. This 202 + * happens rather routinely in normal Tcl operations unless we burden the 203 + * script writer with the cognitive burden of avoiding it. The price is also 204 + * paid by callers of the C interface. The routine 207 205 * 208 206 * unsigned char *Tcl_GetByteArrayFromObj(objPtr, lenPtr) 209 207 * 210 - * has a guarantee to always return a non-NULL value, but that value 211 - * points to a byte sequence that cannot be used by the caller to 212 - * process the Tcl value absent some sideband testing that objPtr 213 - * is "pure". Tcl offers no public interface to perform this test, 214 - * so callers either break encapsulation or are unavoidably buggy. Tcl 215 - * has defined a public interface that cannot be used correctly. The 216 - * Tcl source code itself suffers the same problem, and has been buggy, 217 - * but progressively less so as more and more portions of the code have 218 - * been retrofitted with the required "purity testing". The set of values 219 - * able to pass the purity test can be increased via the introduction of 220 - * a "canonical" flag marker, but the only way the broken interface itself 208 + * has a guarantee to always return a non-NULL value, but that value points to 209 + * a byte sequence that cannot be used by the caller to process the Tcl value 210 + * absent some sideband testing that objPtr is "pure". Tcl offers no public 211 + * interface to perform this test, so callers either break encapsulation or 212 + * are unavoidably buggy. Tcl has defined a public interface that cannot be 213 + * used correctly. The Tcl source code itself suffers the same problem, and 214 + * has been buggy, but progressively less so as more and more portions of the 215 + * code have been retrofitted with the required "purity testing". The set of 216 + * values able to pass the purity test can be increased via the introduction 217 + * of a "canonical" flag marker, but the only way the broken interface itself 221 218 * can be discarded is to start over and define the Tcl_ObjType properly. 222 - * Bytearrays should simply be usable as bytearrays without a kabuki 223 - * dance of testing. 224 - * 225 - * The Tcl_ObjType "properByteArrayType" is (nearly) a correct 226 - * implementation of bytearrays. Any Tcl value with the type 227 - * properByteArrayType can have its bytearray value fetched and 228 - * used with confidence that acting on that value is equivalent to 229 - * acting on the true Tcl string value. This still implies a side 230 - * testing burden -- past mistakes will not let us avoid that 231 - * immediately, but it is at least a conventional test of type, and 232 - * can be implemented entirely by examining the objPtr fields, with 233 - * no need to query the intrep, as a canonical flag would require. 234 - * 235 - * Until Tcl_GetByteArrayFromObj() and Tcl_SetByteArrayLength() can 236 - * be revised to admit the possibility of returning NULL when the true 237 - * value is not a valid bytearray, we need a mechanism to retain 238 - * compatibility with the deployed callers of the broken interface. 239 - * That's what the retained "tclByteArrayType" provides. In those 240 - * unusual circumstances where we convert an invalid bytearray value 241 - * to a bytearray type, it is to this legacy type. Essentially any 242 - * time this legacy type gets used, it's a signal of a bug being ignored. 243 - * A TIP should be drafted to remove this connection to the broken past 244 - * so that Tcl 9 will no longer have any trace of it. Prescribing a 245 - * migration path will be the key element of that work. The internal 246 - * changes now in place are the limit of what can be done short of 247 - * interface repair. They provide a great expansion of the histories 248 - * over which bytearray values can be useful in the meanwhile. 219 + * Bytearrays should simply be usable as bytearrays without a kabuki dance of 220 + * testing. 221 + * 222 + * The Tcl_ObjType "properByteArrayType" is (nearly) a correct implementation 223 + * of bytearrays. Any Tcl value with the type properByteArrayType can have 224 + * its bytearray value fetched and used with confidence that acting on that 225 + * value is equivalent to acting on the true Tcl string value. This still 226 + * implies a side testing burden -- past mistakes will not let us avoid that 227 + * immediately, but it is at least a conventional test of type, and can be 228 + * implemented entirely by examining the objPtr fields, with no need to query 229 + * the intrep, as a canonical flag would require. 230 + * 231 + * Until Tcl_GetByteArrayFromObj() and Tcl_SetByteArrayLength() can be revised 232 + * to admit the possibility of returning NULL when the true value is not a 233 + * valid bytearray, we need a mechanism to retain compatibility with the 234 + * deployed callers of the broken interface. That's what the retained 235 + * "tclByteArrayType" provides. In those unusual circumstances where we 236 + * convert an invalid bytearray value to a bytearray type, it is to this 237 + * legacy type. Essentially any time this legacy type gets used, it's a 238 + * signal of a bug being ignored. A TIP should be drafted to remove this 239 + * connection to the broken past so that Tcl 9 will no longer have any trace 240 + * of it. Prescribing a migration path will be the key element of that work. 241 + * The internal changes now in place are the limit of what can be done short 242 + * of interface repair. They provide a great expansion of the histories over 243 + * which bytearray values can be useful in the meanwhile. 249 244 */ 250 245 251 246 static const Tcl_ObjType properByteArrayType = { 252 247 "bytearray", 253 248 FreeProperByteArrayInternalRep, 254 249 DupProperByteArrayInternalRep, 255 250 UpdateStringOfByteArray, ................................................................................ 278 273 * minus 1 byte. */ 279 274 unsigned char bytes[1]; /* The array of bytes. The actual size of this 280 275 * field depends on the 'allocated' field 281 276 * above. */ 282 277 } ByteArray; 283 278 284 279 #define BYTEARRAY_SIZE(len) \ 285 - ((unsigned) (TclOffset(ByteArray, bytes) + (len))) 280 + (offsetof(ByteArray, bytes) + (len)) 286 281 #define GET_BYTEARRAY(irPtr) ((ByteArray *) (irPtr)->twoPtrValue.ptr1) 287 282 #define SET_BYTEARRAY(irPtr, baPtr) \ 288 283 (irPtr)->twoPtrValue.ptr1 = (void *) (baPtr) 289 284 290 285 int 291 286 TclIsPureByteArray( 292 287 Tcl_Obj * objPtr) ................................................................................ 396 391 * 397 392 *---------------------------------------------------------------------- 398 393 */ 399 394 400 395 void 401 396 Tcl_SetByteArrayObj( 402 397 Tcl_Obj *objPtr, /* Object to initialize as a ByteArray. */ 403 - const unsigned char *bytes, /* The array of bytes to use as the new 404 - value. May be NULL even if length > 0. */ 398 + const unsigned char *bytes, /* The array of bytes to use as the new value. 399 + * May be NULL even if length > 0. */ 405 400 int length) /* Length of the array of bytes, which must 406 - be >= 0. */ 401 + * be >= 0. */ 407 402 { 408 403 ByteArray *byteArrayPtr; 409 404 Tcl_ObjIntRep ir; 410 405 411 406 if (Tcl_IsShared(objPtr)) { 412 407 Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayObj"); 413 408 } ................................................................................ 719 714 } 720 715 if (size > INT_MAX) { 721 716 Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX); 722 717 } 723 718 724 719 if (size == length) { 725 720 char *dst = Tcl_InitStringRep(objPtr, (char *)src, size); 721 + 726 722 TclOOM(dst, size); 727 723 } else { 728 724 char *dst = Tcl_InitStringRep(objPtr, NULL, size); 725 + 729 726 TclOOM(dst, size); 730 727 for (i = 0; i < length; i++) { 731 728 dst += Tcl_UniCharToUtf(src[i], dst); 732 729 } 733 - (void)Tcl_InitStringRep(objPtr, NULL, size); 730 + (void) Tcl_InitStringRep(objPtr, NULL, size); 734 731 } 735 732 } 736 733 737 734 /* 738 735 *---------------------------------------------------------------------- 739 736 * 740 737 * TclAppendBytesToByteArray -- ................................................................................ 774 771 /* 775 772 * Append zero bytes is a no-op. 776 773 */ 777 774 778 775 return; 779 776 } 780 777 781 - length = (unsigned int)len; 778 + length = (unsigned int) len; 782 779 783 780 irPtr = TclFetchIntRep(objPtr, &properByteArrayType); 784 781 if (irPtr == NULL) { 785 782 irPtr = TclFetchIntRep(objPtr, &tclByteArrayType); 786 783 if (irPtr == NULL) { 787 784 SetByteArrayFromAny(NULL, objPtr); 788 785 irPtr = TclFetchIntRep(objPtr, &properByteArrayType); ................................................................................ 803 800 */ 804 801 805 802 if (needed > byteArrayPtr->allocated) { 806 803 ByteArray *ptr = NULL; 807 804 unsigned int attempt; 808 805 809 806 if (needed <= INT_MAX/2) { 810 - /* Try to allocate double the total space that is needed. */ 807 + /* 808 + * Try to allocate double the total space that is needed. 809 + */ 810 + 811 811 attempt = 2 * needed; 812 812 ptr = attemptckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt)); 813 813 } 814 814 if (ptr == NULL) { 815 - /* Try to allocate double the increment that is needed (plus). */ 815 + /* 816 + * Try to allocate double the increment that is needed (plus). 817 + */ 818 + 816 819 unsigned int limit = INT_MAX - needed; 817 820 unsigned int extra = length + TCL_MIN_GROWTH; 818 821 int growth = (int) ((extra > limit) ? limit : extra); 819 822 820 823 attempt = needed + growth; 821 824 ptr = attemptckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt)); 822 825 } 823 826 if (ptr == NULL) { 824 - /* Last chance: Try to allocate exactly what is needed. */ 827 + /* 828 + * Last chance: Try to allocate exactly what is needed. 829 + */ 830 + 825 831 attempt = needed; 826 832 ptr = ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(attempt)); 827 833 } 828 834 byteArrayPtr = ptr; 829 835 byteArrayPtr->allocated = attempt; 830 836 SET_BYTEARRAY(irPtr, byteArrayPtr); 831 837 } ................................................................................ 892 898 int arg; /* Index of next argument to consume. */ 893 899 int value = 0; /* Current integer value to be packed. 894 900 * Initialized to avoid compiler warning. */ 895 901 char cmd; /* Current format character. */ 896 902 int count; /* Count associated with current format 897 903 * character. */ 898 904 int flags; /* Format field flags */ 899 - const char *format; /* Pointer to current position in format 905 + const char *format; /* Pointer to current position in format 900 906 * string. */ 901 907 Tcl_Obj *resultPtr = NULL; /* Object holding result buffer. */ 902 908 unsigned char *buffer; /* Start of result buffer. */ 903 909 unsigned char *cursor; /* Current position within result buffer. */ 904 910 unsigned char *maxPos; /* Greatest position within result buffer that 905 911 * cursor has visited.*/ 906 912 const char *errorString; ................................................................................ 1078 1084 */ 1079 1085 1080 1086 resultPtr = Tcl_NewObj(); 1081 1087 buffer = Tcl_SetByteArrayLength(resultPtr, length); 1082 1088 memset(buffer, 0, length); 1083 1089 1084 1090 /* 1085 - * Pack the data into the result object. Note that we can skip the 1086 - * error checking during this pass, since we have already parsed the 1087 - * string once. 1091 + * Pack the data into the result object. Note that we can skip the error 1092 + * checking during this pass, since we have already parsed the string 1093 + * once. 1088 1094 */ 1089 1095 1090 1096 arg = 2; 1091 1097 format = TclGetString(objv[1]); 1092 1098 cursor = buffer; 1093 1099 maxPos = cursor; 1094 1100 while (*format != 0) { ................................................................................ 1293 1299 TclListObjGetElements(interp, objv[arg], &listc, &listv); 1294 1300 if (count == BINARY_ALL) { 1295 1301 count = listc; 1296 1302 } 1297 1303 } 1298 1304 arg++; 1299 1305 for (i = 0; i < count; i++) { 1300 - if (FormatNumber(interp, cmd, listv[i], &cursor)!=TCL_OK) { 1306 + if (FormatNumber(interp, cmd, listv[i], &cursor) != TCL_OK) { 1301 1307 Tcl_DecrRefCount(resultPtr); 1302 1308 return TCL_ERROR; 1303 1309 } 1304 1310 } 1305 1311 break; 1306 1312 } 1307 1313 case 'x': ................................................................................ 1397 1403 int arg; /* Index of next argument to consume. */ 1398 1404 int value = 0; /* Current integer value to be packed. 1399 1405 * Initialized to avoid compiler warning. */ 1400 1406 char cmd; /* Current format character. */ 1401 1407 int count; /* Count associated with current format 1402 1408 * character. */ 1403 1409 int flags; /* Format field flags */ 1404 - const char *format; /* Pointer to current position in format 1410 + const char *format; /* Pointer to current position in format 1405 1411 * string. */ 1406 1412 Tcl_Obj *resultPtr = NULL; /* Object holding result buffer. */ 1407 1413 unsigned char *buffer; /* Start of result buffer. */ 1408 1414 const char *errorString; 1409 1415 const char *str; 1410 1416 int offset, size, length; 1411 1417 ................................................................................ 1456 1462 1457 1463 /* 1458 1464 * Trim trailing nulls and spaces, if necessary. 1459 1465 */ 1460 1466 1461 1467 if (cmd == 'A') { 1462 1468 while (size > 0) { 1463 - if (src[size-1] != '\0' && src[size-1] != ' ') { 1469 + if (src[size - 1] != '\0' && src[size - 1] != ' ') { 1464 1470 break; 1465 1471 } 1466 1472 size--; 1467 1473 } 1468 1474 } 1469 1475 1470 1476 /* ................................................................................ 2051 2057 * Single-precision floating point values. Tcl_GetDoubleFromObj 2052 2058 * returns TCL_ERROR for NaN, but we can check by comparing the 2053 2059 * object's type pointer. 2054 2060 */ 2055 2061 2056 2062 if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) { 2057 2063 const Tcl_ObjIntRep *irPtr = TclFetchIntRep(src, &tclDoubleType); 2064 + 2058 2065 if (irPtr == NULL) { 2059 2066 return TCL_ERROR; 2060 2067 } 2061 2068 dvalue = irPtr->doubleValue; 2062 2069 } 2063 2070 2064 2071 /* 2065 2072 * Because some compilers will generate floating point exceptions on 2066 2073 * an overflow cast (e.g. Borland), we restrict the values to the 2067 2074 * valid range for float. 2068 2075 */ 2069 2076 2070 - if (fabs(dvalue) > (double)FLT_MAX) { 2077 + if (fabs(dvalue) > (double) FLT_MAX) { 2071 2078 fvalue = (dvalue >= 0.0) ? FLT_MAX : -FLT_MAX; 2072 2079 } else { 2073 2080 fvalue = (float) dvalue; 2074 2081 } 2075 2082 CopyNumber(&fvalue, *cursorPtr, sizeof(float), type); 2076 2083 *cursorPtr += sizeof(float); 2077 2084 return TCL_OK; ................................................................................ 2184 2191 2185 2192 static Tcl_Obj * 2186 2193 ScanNumber( 2187 2194 unsigned char *buffer, /* Buffer to scan number from. */ 2188 2195 int type, /* Format character from "binary scan" */ 2189 2196 int flags, /* Format field flags */ 2190 2197 Tcl_HashTable **numberCachePtrPtr) 2191 - /* Place to look for cache of scanned 2192 - * value objects, or NULL if too many 2193 - * different numbers have been scanned. */ 2198 + /* Place to look for cache of scanned value 2199 + * objects, or NULL if too many different 2200 + * numbers have been scanned. */ 2194 2201 { 2195 2202 long value; 2196 2203 float fvalue; 2197 2204 double dvalue; 2198 2205 Tcl_WideUInt uwvalue; 2199 2206 2200 2207 /* ................................................................................ 2260 2267 + (buffer[1] << 16) 2261 2268 + (((long) buffer[0]) << 24)); 2262 2269 } 2263 2270 2264 2271 /* 2265 2272 * Check to see if the value was sign extended properly on systems 2266 2273 * where an int is more than 32-bits. 2274 + * 2267 2275 * We avoid caching unsigned integers as we cannot distinguish between 2268 2276 * 32bit signed and unsigned in the hash (short and char are ok). 2269 2277 */ 2270 2278 2271 2279 if (flags & BINARY_UNSIGNED) { 2272 2280 return Tcl_NewWideIntObj((Tcl_WideInt)(unsigned long)value); 2273 2281 } 2274 - if ((value & (((unsigned) 1)<<31)) && (value > 0)) { 2275 - value -= (((unsigned) 1)<<31); 2276 - value -= (((unsigned) 1)<<31); 2282 + if ((value & (((unsigned) 1) << 31)) && (value > 0)) { 2283 + value -= (((unsigned) 1) << 31); 2284 + value -= (((unsigned) 1) << 31); 2277 2285 } 2278 2286 2279 2287 returnNumericObject: 2280 2288 if (*numberCachePtrPtr == NULL) { 2281 2289 return Tcl_NewWideIntObj(value); 2282 2290 } else { 2283 2291 register Tcl_HashTable *tablePtr = *numberCachePtrPtr; ................................................................................ 2469 2477 return TCL_ERROR; 2470 2478 } 2471 2479 2472 2480 TclNewObj(resultObj); 2473 2481 data = Tcl_GetByteArrayFromObj(objv[1], &count); 2474 2482 cursor = Tcl_SetByteArrayLength(resultObj, count * 2); 2475 2483 for (offset = 0; offset < count; ++offset) { 2476 - *cursor++ = HexDigits[((data[offset] >> 4) & 0x0f)]; 2477 - *cursor++ = HexDigits[(data[offset] & 0x0f)]; 2484 + *cursor++ = HexDigits[(data[offset] >> 4) & 0x0f]; 2485 + *cursor++ = HexDigits[data[offset] & 0x0f]; 2478 2486 } 2479 2487 Tcl_SetObjResult(interp, resultObj); 2480 2488 return TCL_OK; 2481 2489 } 2482 2490 2483 2491 /* 2484 2492 *---------------------------------------------------------------------- ................................................................................ 2510 2518 enum {OPT_STRICT }; 2511 2519 static const char *const optStrings[] = { "-strict", NULL }; 2512 2520 2513 2521 if (objc < 2 || objc > 3) { 2514 2522 Tcl_WrongNumArgs(interp, 1, objv, "?options? data"); 2515 2523 return TCL_ERROR; 2516 2524 } 2517 - for (i = 1; i < objc-1; ++i) { 2525 + for (i = 1; i < objc - 1; ++i) { 2518 2526 if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option", 2519 2527 TCL_EXACT, &index) != TCL_OK) { 2520 2528 return TCL_ERROR; 2521 2529 } 2522 2530 switch (index) { 2523 2531 case OPT_STRICT: 2524 2532 strict = 1; 2525 2533 break; 2526 2534 } 2527 2535 } 2528 2536 2529 2537 TclNewObj(resultObj); 2530 2538 datastart = data = (unsigned char *) 2531 - TclGetStringFromObj(objv[objc-1], &count); 2539 + TclGetStringFromObj(objv[objc - 1], &count); 2532 2540 dataend = data + count; 2533 2541 size = (count + 1) / 2; 2534 2542 begin = cursor = Tcl_SetByteArrayLength(resultObj, size); 2535 2543 while (data < dataend) { 2536 2544 value = 0; 2537 - for (i=0 ; i<2 ; i++) { 2545 + for (i = 0 ; i < 2 ; i++) { 2538 2546 if (data >= dataend) { 2539 2547 value <<= 4; 2540 2548 break; 2541 2549 } 2542 2550 2543 2551 c = *data++; 2544 2552 if (!isxdigit(UCHAR(c))) { ................................................................................ 2553 2561 c -= '0'; 2554 2562 if (c > 9) { 2555 2563 c += ('0' - 'A') + 10; 2556 2564 } 2557 2565 if (c > 16) { 2558 2566 c += ('A' - 'a'); 2559 2567 } 2560 - value |= (c & 0xf); 2568 + value |= c & 0xf; 2561 2569 } 2562 2570 if (i < 2) { 2563 2571 cut++; 2564 2572 } 2565 2573 *cursor++ = UCHAR(value); 2566 2574 value = 0; 2567 2575 } ................................................................................ 2624 2632 { 2625 2633 Tcl_Obj *resultObj; 2626 2634 unsigned char *data, *cursor, *limit; 2627 2635 int maxlen = 0; 2628 2636 const char *wrapchar = "\n"; 2629 2637 int wrapcharlen = 1; 2630 2638 int offset, i, index, size, outindex = 0, count = 0; 2631 - enum {OPT_MAXLEN, OPT_WRAPCHAR }; 2639 + enum { OPT_MAXLEN, OPT_WRAPCHAR }; 2632 2640 static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL }; 2633 2641 2634 - if (objc < 2 || objc%2 != 0) { 2642 + if (objc < 2 || objc % 2 != 0) { 2635 2643 Tcl_WrongNumArgs(interp, 1, objv, 2636 2644 "?-maxlen len? ?-wrapchar char? data"); 2637 2645 return TCL_ERROR; 2638 2646 } 2639 - for (i = 1; i < objc-1; i += 2) { 2647 + for (i = 1; i < objc - 1; i += 2) { 2640 2648 if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option", 2641 2649 TCL_EXACT, &index) != TCL_OK) { 2642 2650 return TCL_ERROR; 2643 2651 } 2644 2652 switch (index) { 2645 2653 case OPT_MAXLEN: 2646 - if (Tcl_GetIntFromObj(interp, objv[i+1], &maxlen) != TCL_OK) { 2654 + if (Tcl_GetIntFromObj(interp, objv[i + 1], &maxlen) != TCL_OK) { 2647 2655 return TCL_ERROR; 2648 2656 } 2649 2657 if (maxlen < 0) { 2650 2658 Tcl_SetObjResult(interp, Tcl_NewStringObj( 2651 2659 "line length out of range", -1)); 2652 2660 Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE", 2653 2661 "LINE_LENGTH", NULL); 2654 2662 return TCL_ERROR; 2655 2663 } 2656 2664 break; 2657 2665 case OPT_WRAPCHAR: 2658 - wrapchar = TclGetStringFromObj(objv[i+1], &wrapcharlen); 2666 + wrapchar = TclGetStringFromObj(objv[i + 1], &wrapcharlen); 2659 2667 if (wrapcharlen == 0) { 2660 2668 maxlen = 0; 2661 2669 } 2662 2670 break; 2663 2671 } 2664 2672 } 2665 2673 2666 2674 resultObj = Tcl_NewObj(); 2667 - data = Tcl_GetByteArrayFromObj(objv[objc-1], &count); 2675 + data = Tcl_GetByteArrayFromObj(objv[objc - 1], &count); 2668 2676 if (count > 0) { 2669 - size = (((count * 4) / 3) + 3) & ~3; /* ensure 4 byte chunks */ 2677 + size = (((count * 4) / 3) + 3) & ~3; /* ensure 4 byte chunks */ 2670 2678 if (maxlen > 0 && size > maxlen) { 2671 2679 int adjusted = size + (wrapcharlen * (size / maxlen)); 2672 2680 2673 2681 if (size % maxlen == 0) { 2674 2682 adjusted -= wrapcharlen; 2675 2683 } 2676 2684 size = adjusted; 2677 2685 } 2678 2686 cursor = Tcl_SetByteArrayLength(resultObj, size); 2679 2687 limit = cursor + size; 2680 - for (offset = 0; offset < count; offset+=3) { 2688 + for (offset = 0; offset < count; offset += 3) { 2681 2689 unsigned char d[3] = {0, 0, 0}; 2682 2690 2683 - for (i = 0; i < 3 && offset+i < count; ++i) { 2691 + for (i = 0; i < 3 && offset + i < count; ++i) { 2684 2692 d[i] = data[offset + i]; 2685 2693 } 2686 2694 OUTPUT(B64Digits[d[0] >> 2]); 2687 2695 OUTPUT(B64Digits[((d[0] & 0x03) << 4) | (d[1] >> 4)]); 2688 - if (offset+1 < count) { 2696 + if (offset + 1 < count) { 2689 2697 OUTPUT(B64Digits[((d[1] & 0x0f) << 2) | (d[2] >> 6)]); 2690 2698 } else { 2691 2699 OUTPUT(B64Digits[64]); 2692 2700 } 2693 2701 if (offset+2 < count) { 2694 2702 OUTPUT(B64Digits[d[2] & 0x3f]); 2695 2703 } else { ................................................................................ 2734 2742 int lineLength = 61; 2735 2743 const unsigned char SingleNewline[] = { (unsigned char) '\n' }; 2736 2744 const unsigned char *wrapchar = SingleNewline; 2737 2745 int wrapcharlen = sizeof(SingleNewline); 2738 2746 enum { OPT_MAXLEN, OPT_WRAPCHAR }; 2739 2747 static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL }; 2740 2748 2741 - if (objc < 2 || objc%2 != 0) { 2749 + if (objc < 2 || objc % 2 != 0) { 2742 2750 Tcl_WrongNumArgs(interp, 1, objv, 2743 2751 "?-maxlen len? ?-wrapchar char? data"); 2744 2752 return TCL_ERROR; 2745 2753 } 2746 - for (i = 1; i < objc-1; i += 2) { 2754 + for (i = 1; i < objc - 1; i += 2) { 2747 2755 if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option", 2748 2756 TCL_EXACT, &index) != TCL_OK) { 2749 2757 return TCL_ERROR; 2750 2758 } 2751 2759 switch (index) { 2752 2760 case OPT_MAXLEN: 2753 - if (Tcl_GetIntFromObj(interp, objv[i+1], &lineLength) != TCL_OK) { 2761 + if (Tcl_GetIntFromObj(interp, objv[i + 1], 2762 + &lineLength) != TCL_OK) { 2754 2763 return TCL_ERROR; 2755 2764 } 2756 2765 if (lineLength < 3 || lineLength > 85) { 2757 2766 Tcl_SetObjResult(interp, Tcl_NewStringObj( 2758 2767 "line length out of range", -1)); 2759 2768 Tcl_SetErrorCode(interp, "TCL", "BINARY", "ENCODE", 2760 2769 "LINE_LENGTH", NULL); 2761 2770 return TCL_ERROR; 2762 2771 } 2763 2772 break; 2764 2773 case OPT_WRAPCHAR: 2765 - wrapchar = Tcl_GetByteArrayFromObj(objv[i+1], &wrapcharlen); 2774 + wrapchar = Tcl_GetByteArrayFromObj(objv[i + 1], &wrapcharlen); 2766 2775 break; 2767 2776 } 2768 2777 } 2769 2778 2770 2779 /* 2771 2780 * Allocate the buffer. This is a little bit too long, but is "good 2772 2781 * enough". 2773 2782 */ 2774 2783 2775 2784 resultObj = Tcl_NewObj(); 2776 2785 offset = 0; 2777 - data = Tcl_GetByteArrayFromObj(objv[objc-1], &count); 2786 + data = Tcl_GetByteArrayFromObj(objv[objc - 1], &count); 2778 2787 rawLength = (lineLength - 1) * 3 / 4; 2779 2788 start = cursor = Tcl_SetByteArrayLength(resultObj, 2780 2789 (lineLength + wrapcharlen) * 2781 2790 ((count + (rawLength - 1)) / rawLength)); 2782 2791 n = bits = 0; 2783 2792 2784 2793 /* ................................................................................ 2791 2800 while (offset < count) { 2792 2801 int lineLen = count - offset; 2793 2802 2794 2803 if (lineLen > rawLength) { 2795 2804 lineLen = rawLength; 2796 2805 } 2797 2806 *cursor++ = UueDigits[lineLen]; 2798 - for (i=0 ; i<lineLen ; i++) { 2807 + for (i = 0 ; i < lineLen ; i++) { 2799 2808 n <<= 8; 2800 2809 n |= data[offset++]; 2801 2810 for (bits += 8; bits > 6 ; bits -= 6) { 2802 - *cursor++ = UueDigits[(n >> (bits-6)) & 0x3f]; 2811 + *cursor++ = UueDigits[(n >> (bits - 6)) & 0x3f]; 2803 2812 } 2804 2813 } 2805 2814 if (bits > 0) { 2806 2815 n <<= 8; 2807 2816 *cursor++ = UueDigits[(n >> (bits + 2)) & 0x3f]; 2808 2817 bits = 0; 2809 2818 } 2810 - for (j=0 ; j<wrapcharlen ; ++j) { 2819 + for (j = 0 ; j < wrapcharlen ; ++j) { 2811 2820 *cursor++ = wrapchar[j]; 2812 2821 } 2813 2822 } 2814 2823 2815 2824 /* 2816 2825 * Fix the length of the output bytearray. 2817 2826 */ 2818 2827 2819 - Tcl_SetByteArrayLength(resultObj, cursor-start); 2828 + Tcl_SetByteArrayLength(resultObj, cursor - start); 2820 2829 Tcl_SetObjResult(interp, resultObj); 2821 2830 return TCL_OK; 2822 2831 } 2823 2832 2824 2833 /* 2825 2834 *---------------------------------------------------------------------- 2826 2835 * ................................................................................ 2845 2854 Tcl_Obj *const objv[]) 2846 2855 { 2847 2856 Tcl_Obj *resultObj = NULL; 2848 2857 unsigned char *data, *datastart, *dataend; 2849 2858 unsigned char *begin, *cursor; 2850 2859 int i, index, size, count = 0, strict = 0, lineLen; 2851 2860 unsigned char c; 2852 - enum {OPT_STRICT }; 2861 + enum { OPT_STRICT }; 2853 2862 static const char *const optStrings[] = { "-strict", NULL }; 2854 2863 2855 2864 if (objc < 2 || objc > 3) { 2856 2865 Tcl_WrongNumArgs(interp, 1, objv, "?options? data"); 2857 2866 return TCL_ERROR; 2858 2867 } 2859 - for (i = 1; i < objc-1; ++i) { 2868 + for (i = 1; i < objc - 1; ++i) { 2860 2869 if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option", 2861 2870 TCL_EXACT, &index) != TCL_OK) { 2862 2871 return TCL_ERROR; 2863 2872 } 2864 2873 switch (index) { 2865 2874 case OPT_STRICT: 2866 2875 strict = 1; 2867 2876 break; 2868 2877 } 2869 2878 } 2870 2879 2871 2880 TclNewObj(resultObj); 2872 2881 datastart = data = (unsigned char *) 2873 - TclGetStringFromObj(objv[objc-1], &count); 2882 + TclGetStringFromObj(objv[objc - 1], &count); 2874 2883 dataend = data + count; 2875 2884 size = ((count + 3) & ~3) * 3 / 4; 2876 2885 begin = cursor = Tcl_SetByteArrayLength(resultObj, size); 2877 2886 lineLen = -1; 2878 2887 2879 2888 /* 2880 2889 * The decoding loop. First, we get the length of line (strictly, the ................................................................................ 2898 2907 lineLen = (c - 32) & 0x3f; 2899 2908 } 2900 2909 2901 2910 /* 2902 2911 * Now we read a four-character grouping. 2903 2912 */ 2904 2913 2905 - for (i=0 ; i<4 ; i++) { 2914 + for (i = 0 ; i < 4 ; i++) { 2906 2915 if (data < dataend) { 2907 2916 d[i] = c = *data++; 2908 2917 if (c < 32 || c > 96) { 2909 2918 if (strict) { 2910 2919 if (!TclIsSpaceProc(c)) { 2911 2920 goto badUu; 2912 2921 } else if (c == '\n') { ................................................................................ 3016 3025 enum { OPT_STRICT }; 3017 3026 static const char *const optStrings[] = { "-strict", NULL }; 3018 3027 3019 3028 if (objc < 2 || objc > 3) { 3020 3029 Tcl_WrongNumArgs(interp, 1, objv, "?options? data"); 3021 3030 return TCL_ERROR; 3022 3031 } 3023 - for (i = 1; i < objc-1; ++i) { 3032 + for (i = 1; i < objc - 1; ++i) { 3024 3033 if (Tcl_GetIndexFromObj(interp, objv[i], optStrings, "option", 3025 3034 TCL_EXACT, &index) != TCL_OK) { 3026 3035 return TCL_ERROR; 3027 3036 } 3028 3037 switch (index) { 3029 3038 case OPT_STRICT: 3030 3039 strict = 1; 3031 3040 break; 3032 3041 } 3033 3042 } 3034 3043 3035 3044 TclNewObj(resultObj); 3036 3045 datastart = data = (unsigned char *) 3037 - TclGetStringFromObj(objv[objc-1], &count); 3046 + TclGetStringFromObj(objv[objc - 1], &count); 3038 3047 dataend = data + count; 3039 3048 size = ((count + 3) & ~3) * 3 / 4; 3040 3049 begin = cursor = Tcl_SetByteArrayLength(resultObj, size); 3041 3050 while (data < dataend) { 3042 3051 unsigned long value = 0; 3043 3052 3044 3053 /* ................................................................................ 3058 3067 3059 3068 if (data < dataend) { 3060 3069 c = *data++; 3061 3070 } else if (i > 1) { 3062 3071 c = '='; 3063 3072 } else { 3064 3073 if (strict && i <= 1) { 3065 - /* single resp. unfulfilled char (each 4th next single char) 3066 - * is rather bad64 error case in strict mode */ 3074 + /* 3075 + * Single resp. unfulfilled char (each 4th next single 3076 + * char) is rather bad64 error case in strict mode. 3077 + */ 3078 + 3067 3079 goto bad64; 3068 3080 } 3069 3081 cut += 3; 3070 3082 break; 3071 3083 } 3072 3084 3073 3085 /* ................................................................................ 3075 3087 * because they're only valid as the last character or two of the 3076 3088 * final block of input. Unless strict mode is enabled, skip any 3077 3089 * input whitespace characters. 3078 3090 */ 3079 3091 3080 3092 if (cut) { 3081 3093 if (c == '=' && i > 1) { 3082 - value <<= 6; 3083 - cut++; 3094 + value <<= 6; 3095 + cut++; 3084 3096 } else if (!strict && TclIsSpaceProc(c)) { 3085 - i--; 3097 + i--; 3086 3098 } else { 3087 3099 goto bad64; 3088 3100 } 3089 3101 } else if (c >= 'A' && c <= 'Z') { 3090 3102 value = (value << 6) | ((c - 'A') & 0x3f); 3091 3103 } else if (c >= 'a' && c <= 'z') { 3092 3104 value = (value << 6) | ((c - 'a' + 26) & 0x3f); 3093 3105 } else if (c >= '0' && c <= '9') { 3094 3106 value = (value << 6) | ((c - '0' + 52) & 0x3f); 3095 3107 } else if (c == '+') { 3096 3108 value = (value << 6) | 0x3e; 3097 3109 } else if (c == '/') { 3098 3110 value = (value << 6) | 0x3f; 3099 - } else if (c == '=' && ( 3100 - !strict || i > 1) /* "=" and "a=" is rather bad64 error case in strict mode */ 3101 - ) { 3111 + } else if (c == '=' && (!strict || i > 1)) { 3112 + /* 3113 + * "=" and "a=" is rather bad64 error case in strict mode. 3114 + */ 3115 + 3102 3116 value <<= 6; 3103 - if (i) cut++; 3117 + if (i) { 3118 + cut++; 3119 + } 3104 3120 } else if (strict || !TclIsSpaceProc(c)) { 3105 3121 goto bad64; 3106 3122 } else { 3107 3123 i--; 3108 3124 } 3109 3125 } 3110 3126 *cursor++ = UCHAR((value >> 16) & 0xff); ................................................................................ 3143 3159 /* 3144 3160 * Local Variables: 3145 3161 * mode: c 3146 3162 * c-basic-offset: 4 3147 3163 * fill-column: 78 3148 3164 * End: 3149 3165 */ 3150 -
Changes to generic/tclCkalloc.c.
37 37 size_t refCount; /* Number of mem_headers referencing this 38 38 * tag. */ 39 39 char string[1]; /* Actual size of string will be as large as 40 40 * needed for actual tag. This must be the 41 41 * last field in the structure. */ 42 42 } MemTag; 43 43 44 -#define TAG_SIZE(bytesInString) ((TclOffset(MemTag, string) + 1) + bytesInString) 44 +#define TAG_SIZE(bytesInString) ((offsetof(MemTag, string) + 1) + bytesInString) 45 45 46 46 static MemTag *curTagPtr = NULL;/* Tag to use in all future mem_headers (set 47 47 * by "memory tag" command). */ 48 48 49 49 /* 50 50 * One of the following structures is allocated just before each dynamically 51 51 * allocated chunk of memory, both to record information about the chunk and
Changes to generic/tclCompile.c.
3026 3026 3027 3027 /* 3028 3028 * Create a new variable if appropriate. 3029 3029 */ 3030 3030 3031 3031 if (create || (name == NULL)) { 3032 3032 localVar = procPtr->numCompiledLocals; 3033 - localPtr = ckalloc(TclOffset(CompiledLocal, name) + nameBytes + 1); 3033 + localPtr = ckalloc(offsetof(CompiledLocal, name) + nameBytes + 1); 3034 3034 if (procPtr->firstLocalPtr == NULL) { 3035 3035 procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr; 3036 3036 } else { 3037 3037 procPtr->lastLocalPtr->nextPtr = localPtr; 3038 3038 procPtr->lastLocalPtr = localPtr; 3039 3039 } 3040 3040 localPtr->nextPtr = NULL;
Changes to generic/tclExecute.c.
207 207 } while (0) 208 208 209 209 /* 210 210 * These variable-access macros have to coincide with those in tclVar.c 211 211 */ 212 212 213 213 #define VarHashGetValue(hPtr) \ 214 - ((Var *) ((char *)hPtr - TclOffset(VarInHash, entry))) 214 + ((Var *) ((char *)hPtr - offsetof(VarInHash, entry))) 215 215 216 216 static inline Var * 217 217 VarHashCreateVar( 218 218 TclVarHashTable *tablePtr, 219 219 Tcl_Obj *key, 220 220 int *newPtr) 221 221 {
Changes to generic/tclHash.c.
805 805 Tcl_HashEntry *hPtr; 806 806 unsigned int size, allocsize; 807 807 808 808 allocsize = size = strlen(string) + 1; 809 809 if (size < sizeof(hPtr->key)) { 810 810 allocsize = sizeof(hPtr->key); 811 811 } 812 - hPtr = ckalloc(TclOffset(Tcl_HashEntry, key) + allocsize); 812 + hPtr = ckalloc(offsetof(Tcl_HashEntry, key) + allocsize); 813 813 memcpy(hPtr->key.string, string, size); 814 814 hPtr->clientData = 0; 815 815 return hPtr; 816 816 } 817 817 818 818 /* 819 819 *----------------------------------------------------------------------
Changes to generic/tclIO.h.
46 46 /* Next buffer in chain. */ 47 47 char buf[1]; /* Placeholder for real buffer. The real 48 48 * buffer occuppies this space + bufSize-1 49 49 * bytes. This must be the last field in the 50 50 * structure. */ 51 51 } ChannelBuffer; 52 52 53 -#define CHANNELBUFFER_HEADER_SIZE TclOffset(ChannelBuffer, buf) 53 +#define CHANNELBUFFER_HEADER_SIZE offsetof(ChannelBuffer, buf) 54 54 55 55 /* 56 56 * How much extra space to allocate in buffer to hold bytes from previous 57 57 * buffer (when converting to UTF-8) or to hold bytes that will go to next 58 58 * buffer (when converting from UTF-8). 59 59 */ 60 60
Changes to generic/tclInt.h.
75 75 #endif 76 76 #ifdef NO_STRING_H 77 77 #include "../compat/string.h" 78 78 #else 79 79 #include <string.h> 80 80 #endif 81 81 #if defined(STDC_HEADERS) || defined(__STDC__) || defined(__C99__FUNC__) \ 82 - || defined(__cplusplus) || defined(_MSC_VER) 82 + || defined(__cplusplus) || defined(_MSC_VER) || defined(__ICC) 83 83 #include <stddef.h> 84 84 #else 85 85 typedef int ptrdiff_t; 86 86 #endif 87 87 88 88 /* 89 89 * Ensure WORDS_BIGENDIAN is defined correctly: ................................................................................ 4025 4025 struct CompileEnv *envPtr); 4026 4026 MODULE_SCOPE int TclDivOpCmd(ClientData clientData, 4027 4027 Tcl_Interp *interp, int objc, 4028 4028 Tcl_Obj *const objv[]); 4029 4029 MODULE_SCOPE int TclCompileDivOpCmd(Tcl_Interp *interp, 4030 4030 Tcl_Parse *parsePtr, Command *cmdPtr, 4031 4031 struct CompileEnv *envPtr); 4032 -MODULE_SCOPE int TclLessOpCmd(ClientData clientData, 4033 - Tcl_Interp *interp, int objc, 4034 - Tcl_Obj *const objv[]); 4035 4032 MODULE_SCOPE int TclCompileLessOpCmd(Tcl_Interp *interp, 4036 4033 Tcl_Parse *parsePtr, Command *cmdPtr, 4037 4034 struct CompileEnv *envPtr); 4038 -MODULE_SCOPE int TclLeqOpCmd(ClientData clientData, 4039 - Tcl_Interp *interp, int objc, 4040 - Tcl_Obj *const objv[]); 4041 4035 MODULE_SCOPE int TclCompileLeqOpCmd(Tcl_Interp *interp, 4042 4036 Tcl_Parse *parsePtr, Command *cmdPtr, 4043 4037 struct CompileEnv *envPtr); 4044 -MODULE_SCOPE int TclGreaterOpCmd(ClientData clientData, 4045 - Tcl_Interp *interp, int objc, 4046 - Tcl_Obj *const objv[]); 4047 4038 MODULE_SCOPE int TclCompileGreaterOpCmd(Tcl_Interp *interp, 4048 4039 Tcl_Parse *parsePtr, Command *cmdPtr, 4049 4040 struct CompileEnv *envPtr); 4050 -MODULE_SCOPE int TclGeqOpCmd(ClientData clientData, 4051 - Tcl_Interp *interp, int objc, 4052 - Tcl_Obj *const objv[]); 4053 4041 MODULE_SCOPE int TclCompileGeqOpCmd(Tcl_Interp *interp, 4054 4042 Tcl_Parse *parsePtr, Command *cmdPtr, 4055 4043 struct CompileEnv *envPtr); 4056 -MODULE_SCOPE int TclEqOpCmd(ClientData clientData, 4057 - Tcl_Interp *interp, int objc, 4058 - Tcl_Obj *const objv[]); 4059 4044 MODULE_SCOPE int TclCompileEqOpCmd(Tcl_Interp *interp, 4060 4045 Tcl_Parse *parsePtr, Command *cmdPtr, 4061 4046 struct CompileEnv *envPtr); 4062 -MODULE_SCOPE int TclStreqOpCmd(ClientData clientData, 4063 - Tcl_Interp *interp, int objc, 4064 - Tcl_Obj *const objv[]); 4065 4047 MODULE_SCOPE int TclCompileStreqOpCmd(Tcl_Interp *interp, 4066 4048 Tcl_Parse *parsePtr, Command *cmdPtr, 4067 4049 struct CompileEnv *envPtr); 4068 4050 4069 4051 MODULE_SCOPE int TclCompileAssembleCmd(Tcl_Interp *interp, 4070 4052 Tcl_Parse *parsePtr, Command *cmdPtr, 4071 4053 struct CompileEnv *envPtr); ................................................................................ 4882 4864 # define TclIsNaN(d) ((d) != (d)) 4883 4865 # else 4884 4866 # define TclIsNaN(d) (isnan(d)) 4885 4867 # endif 4886 4868 #endif 4887 4869 4888 4870 /* 4889 - * ---------------------------------------------------------------------- 4890 - * Macro to use to find the offset of a field in a structure. Computes number 4891 - * of bytes from beginning of structure to a given field. 4871 + * Macro to use to find the offset of a field in astructure. 4872 + * Computes number of bytes from beginning of structure to a given field. 4892 4873 */ 4893 4874 4894 -#ifdef offsetof 4895 -#define TclOffset(type, field) ((int) offsetof(type, field)) 4896 -#else 4897 -#define TclOffset(type, field) ((int) ((char *) &((type *) 0)->field)) 4875 +#ifndef TCL_NO_DEPRECATED 4876 +# define TclOffset(type, field) ((int) offsetof(type, field)) 4877 +#endif 4878 +/* Workaround for platforms missing offsetof(), e.g. VC++ 6.0 */ 4879 +#ifndef offsetof 4880 +# define offsetof(type, field) ((size_t) ((char *) &((type *) 0)->field)) 4898 4881 #endif 4899 4882 4900 4883 /* 4901 4884 *---------------------------------------------------------------- 4902 4885 * Inline version of Tcl_GetCurrentNamespace and Tcl_GetGlobalNamespace. 4903 4886 */ 4904 4887
Changes to generic/tclOOMethod.c.
117 117 /* 118 118 * Helper macros (derived from things private to tclVar.c) 119 119 */ 120 120 121 121 #define TclVarTable(contextNs) \ 122 122 ((Tcl_HashTable *) (&((Namespace *) (contextNs))->varTable)) 123 123 #define TclVarHashGetValue(hPtr) \ 124 - ((Tcl_Var) ((char *)hPtr - TclOffset(VarInHash, entry))) 124 + ((Tcl_Var) ((char *)hPtr - offsetof(VarInHash, entry))) 125 125 126 126 /* 127 127 * ---------------------------------------------------------------------- 128 128 * 129 129 * Tcl_NewInstanceMethod -- 130 130 * 131 131 * Attach a method to an object instance.
Changes to generic/tclProc.c.
630 630 localPtr = localPtr->nextPtr; 631 631 } else { 632 632 /* 633 633 * Allocate an entry in the runtime procedure frame's array of 634 634 * local variables for the argument. 635 635 */ 636 636 637 - localPtr = ckalloc(TclOffset(CompiledLocal, name) + fieldValues[0]->length +1); 637 + localPtr = ckalloc(offsetof(CompiledLocal, name) + fieldValues[0]->length +1); 638 638 if (procPtr->firstLocalPtr == NULL) { 639 639 procPtr->firstLocalPtr = procPtr->lastLocalPtr = localPtr; 640 640 } else { 641 641 procPtr->lastLocalPtr->nextPtr = localPtr; 642 642 procPtr->lastLocalPtr = localPtr; 643 643 } 644 644 localPtr->nextPtr = NULL;
Changes to generic/tclTest.c.
7706 7706 if (resVarInfo->var) { 7707 7707 HashVarFree(resVarInfo->var); 7708 7708 } 7709 7709 ckfree(vInfoPtr); 7710 7710 } 7711 7711 7712 7712 #define TclVarHashGetValue(hPtr) \ 7713 - ((Var *) ((char *)hPtr - TclOffset(VarInHash, entry))) 7713 + ((Var *) ((char *)hPtr - offsetof(VarInHash, entry))) 7714 7714 7715 7715 static Tcl_Var 7716 7716 MyCompiledVarFetch( 7717 7717 Tcl_Interp *interp, 7718 7718 Tcl_ResolvedVarInfo *vinfoPtr) 7719 7719 { 7720 7720 MyResolvedVarInfo *resVarInfo = (MyResolvedVarInfo *) vinfoPtr;
Changes to generic/tclTrace.c.
466 466 break; 467 467 } 468 468 } 469 469 command = TclGetStringFromObj(objv[5], &commandLength); 470 470 length = (size_t) commandLength; 471 471 if ((enum traceOptions) optionIndex == TRACE_ADD) { 472 472 TraceCommandInfo *tcmdPtr = ckalloc( 473 - TclOffset(TraceCommandInfo, command) + 1 + length); 473 + offsetof(TraceCommandInfo, command) + 1 + length); 474 474 475 475 tcmdPtr->flags = flags; 476 476 tcmdPtr->stepTrace = NULL; 477 477 tcmdPtr->startLevel = 0; 478 478 tcmdPtr->startCmd = NULL; 479 479 tcmdPtr->length = length; 480 480 tcmdPtr->refCount = 1; ................................................................................ 703 703 } 704 704 } 705 705 706 706 command = TclGetStringFromObj(objv[5], &commandLength); 707 707 length = (size_t) commandLength; 708 708 if ((enum traceOptions) optionIndex == TRACE_ADD) { 709 709 TraceCommandInfo *tcmdPtr = ckalloc( 710 - TclOffset(TraceCommandInfo, command) + 1 + length); 710 + offsetof(TraceCommandInfo, command) + 1 + length); 711 711 712 712 tcmdPtr->flags = flags; 713 713 tcmdPtr->stepTrace = NULL; 714 714 tcmdPtr->startLevel = 0; 715 715 tcmdPtr->startCmd = NULL; 716 716 tcmdPtr->length = length; 717 717 tcmdPtr->refCount = 1; ................................................................................ 906 906 break; 907 907 } 908 908 } 909 909 command = TclGetStringFromObj(objv[5], &commandLength); 910 910 length = (size_t) commandLength; 911 911 if ((enum traceOptions) optionIndex == TRACE_ADD) { 912 912 CombinedTraceVarInfo *ctvarPtr = ckalloc( 913 - TclOffset(CombinedTraceVarInfo, traceCmdInfo.command) 913 + offsetof(CombinedTraceVarInfo, traceCmdInfo.command) 914 914 + 1 + length); 915 915 916 916 ctvarPtr->traceCmdInfo.flags = flags; 917 917 #ifndef TCL_REMOVE_OBSOLETE_TRACES 918 918 if (objv[0] == NULL) { 919 919 ctvarPtr->traceCmdInfo.flags |= TCL_TRACE_OLD_STYLE; 920 920 }
Changes to generic/tclVar.c.
41 41 Tcl_Obj *key, int *newPtr); 42 42 static inline Var * VarHashFirstVar(TclVarHashTable *tablePtr, 43 43 Tcl_HashSearch *searchPtr); 44 44 static inline Var * VarHashNextVar(Tcl_HashSearch *searchPtr); 45 45 static inline void CleanupVar(Var *varPtr, Var *arrayPtr); 46 46 47 47 #define VarHashGetValue(hPtr) \ 48 - ((Var *) ((char *)hPtr - TclOffset(VarInHash, entry))) 48 + ((Var *) ((char *)hPtr - offsetof(VarInHash, entry))) 49 49 50 50 /* 51 51 * NOTE: VarHashCreateVar increments the recount of its key argument. 52 52 * All callers that will call Tcl_DecrRefCount on that argument must 53 53 * call Tcl_IncrRefCount on it before passing it in. This requirement 54 54 * can bubble up to callers of callers .... etc. 55 55 */
Changes to tools/tcltk-man2html-utils.tcl.
1561 1561 # 1562 1562 set manual(toc-$manual(wing-file)-$manual(name)) \ 1563 1563 [concat <DL> $manual(section-toc) </DL>] 1564 1564 } 1565 1565 if {!$verbose} { 1566 1566 puts stderr "" 1567 1567 } 1568 + 1569 + if {![llength $manual(wing-toc)]} { 1570 + fatal "not table of contents." 1571 + } 1568 1572 1569 1573 # 1570 1574 # make the wing table of contents for the section 1571 1575 # 1572 1576 set width 0 1573 1577 foreach name $manual(wing-toc) { 1574 1578 if {[string length $name] > $width} {
Changes to tools/tcltk-man2html.tcl.
27 27 28 28 ## 29 29 ## Source the utility functions that provide most of the 30 30 ## implementation of the transformation from nroff to html. 31 31 ## 32 32 source [file join [file dirname [info script]] tcltk-man2html-utils.tcl] 33 33 34 +proc getversion {tclh {name {}}} { 35 + if {[file exists $tclh]} { 36 + set chan [open $tclh] 37 + set data [read $chan] 38 + close $chan 39 + if {$name eq ""} { 40 + set name [string toupper [file root [file tail $tclh]]] 41 + } 42 + # backslash isn't required in front of quote, but it keeps syntax 43 + # highlighting straight in some editors 44 + if {[regexp -lineanchor \ 45 + [string map [list @[email protected] $name] \ 46 + {^#define\[email protected]@_VERSION\s+\"([^.])+\.([^.\"]+)}] \ 47 + $data -> major minor]} { 48 + return [list $major $minor] 49 + } 50 + } 51 +} 34 52 proc findversion {top name useversion} { 53 + # Default search version is a glob pattern, switch it for string match: 54 + if {$useversion eq {{,[8-9].[0-9]{,[.ab][0-9]{,[0-9]}}}}} { 55 + set useversion {[8-9].[0-9]} 56 + } 57 + # Search: 35 58 set upper [string toupper $name] 36 59 foreach top1 [list $top $top/..] sub {{} generic} { 37 60 foreach dirname [ 38 61 glob -nocomplain -tails -type d -directory $top1 *] { 39 62 40 - set tclh [join [list $top1 $dirname {*}$sub $name.h] /] 41 - if {[file exists $tclh]} { 42 - set chan [open $tclh] 43 - set data [read $chan] 44 - close $chan 45 - # backslash isn't required in front of quote, but it keeps syntax 46 - # highlighting straight in some editors 47 - if {[regexp -lineanchor \ 48 - [string map [list @[email protected] $upper] \ 49 - {^#define\[email protected]@_VERSION\s+\"([^.])+\.([^.\"]+)}] \ 50 - $data -> major minor]} { 51 - # to do 52 - # use glob matching instead of string matching or add 53 - # brace handling to [string matcch] 54 - if {$useversion eq {} || [string match $useversion $major.$minor]} { 55 - set top [file dirname [file dirname $tclh]] 56 - set prefix [file dirname $top] 57 - return [list $prefix [file tail $top] $major $minor] 58 - } 63 + set tclh [join [list $top1 $dirname {*}$sub ${name}.h] /] 64 + set v [getversion $tclh $upper] 65 + if {[llength $v]} { 66 + lassign $v major minor 67 + # to do 68 + # use glob matching instead of string matching or add 69 + # brace handling to [string matcch] 70 + if {$useversion eq {} || [string match $useversion $major.$minor]} { 71 + set top [file dirname [file dirname $tclh]] 72 + set prefix [file dirname $top] 73 + return [list $prefix [file tail $top] $major $minor] 59 74 } 60 75 } 61 76 } 62 77 } 63 - return 64 78 } 65 79 66 80 proc parse_command_line {} { 67 81 global argv Version 68 82 69 83 # These variables determine where the man pages come from and where 70 84 # the converted pages go to. ................................................................................ 146 160 } 147 161 } 148 162 149 163 if {!$build_tcl && !$build_tk} { 150 164 set build_tcl 1; 151 165 set build_tk 1 152 166 } 167 + 168 + set major "" 169 + set minor "" 153 170 154 171 if {$build_tcl} { 155 - # Find Tcl. 156 - lassign [findversion $tcltkdir tcl $useversion] tcltkdir tcldir major minor 172 + # Find Tcl (firstly using glob pattern / backwards compatible way) 173 + set tcldir [lindex [lsort [glob -nocomplain -tails -type d \ 174 + -directory $tcltkdir tcl$useversion]] end] 175 + if {$tcldir ne {}} { 176 + # obtain version from generic header if we can: 177 + lassign [getversion [file join $tcltkdir $tcldir generic tcl.h]] major minor 178 + } else { 179 + lassign [findversion $tcltkdir tcl $useversion] tcltkdir tcldir major minor 180 + } 157 181 if {$tcldir eq {} && $opt_build_tcl} { 158 182 puts stderr "tcltk-man-html: couldn't find Tcl below $tcltkdir" 159 183 exit 1 160 184 } 161 185 puts "using Tcl source directory $tcltkdir $tcldir" 162 186 } 163 187 164 188 165 189 if {$build_tk} { 166 - # Find Tk. 167 - lassign [findversion $tcltkdir tk $useversion] tcltkdir tkdir major minor 190 + # Find Tk (firstly using glob pattern / backwards compatible way) 191 + set tkdir [lindex [lsort [glob -nocomplain -tails -type d \ 192 + -directory $tcltkdir tk$useversion]] end] 193 + if {$tkdir ne {}} { 194 + if {$major eq ""} { 195 + # obtain version from generic header if we can: 196 + lassign [getversion [file join $tcltkdir $tcldir generic tk.h]] major minor 197 + } 198 + } else { 199 + lassign [findversion $tcltkdir tk $useversion] tcltkdir tkdir major minor 200 + } 168 201 if {$tkdir eq {} && $opt_build_tk} { 169 202 puts stderr "tcltk-man-html: couldn't find Tk below $tcltkdir" 170 203 exit 1 171 204 } 172 205 puts "using Tk source directory $tkdir" 173 206 } 174 207 175 208 puts "verbose messages are [expr {$verbose ? {on} : {off}}]" 176 209 177 210 # the title for the man pages overall 178 211 global overall_title 179 212 set overall_title "" 180 213 if {$build_tcl} { 181 - append overall_title "Tcl $major.$minor" 214 + if {$major ne ""} { 215 + append overall_title "Tcl $major.$minor" 216 + } else { 217 + append overall_title "Tcl [capitalize $tcldir]" 218 + } 182 219 } 183 220 if {$build_tcl && $build_tk} { 184 221 append overall_title "/" 185 222 } 186 223 if {$build_tk} { 187 224 append overall_title "[capitalize $tkdir]" 188 225 }