Tcl Source Code

Check-in [ed3800e114]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

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: ed3800e114e500c9b08ab38c27d189cb96cea237ef08cb80885ea555bcce0d93
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
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

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       }