Merge 9.0. Further Makefile tweaks

For whatever reason, these macros were renamed and moved to tclIO.h post-660. This is
inappropriate as those macros deal with *encoding* flags, not *channel* flags and have
relevance outside of I/O making their renaming inappropriate. Further putting them in tclIO.h
forces inclusion of that header in modules that do not otherwise need that header.

doc/AddErrInfo.3

@@ -67,9 +67,6 @@ The \fB\-errorcode\fR return option will be set to this value.
 .AP "const char" *element in
 String to record as one element of the \fB\-errorcode\fR return option.
 Last \fIelement\fR argument must be NULL.
-.AP va_list argList in
-An argument list which must have been initialized using
-\fBva_start\fR, and cleared using \fBva_end\fR.
 .AP int lineNum
 The line number of a script where an error occurred.
 .AP "const char" *script in

doc/CrtObjCmd.3

@@ -187,7 +187,7 @@ except its \fIproc2\fR argument is of type \fBTcl_ObjCmdProc2\fR.
 typedef int \fBTcl_ObjCmdProc2\fR(
         void *\fIclientData\fR,
         Tcl_Interp *\fIinterp\fR,
-        ptrdiff_t \fIobjc\fR,
+        Tcl_Size \fIobjc\fR,
         Tcl_Obj *const \fIobjv\fR[]);
 .CE
 .PP

doc/CrtTrace.3

@@ -88,10 +88,10 @@ typedef int \fBTcl_CmdObjTraceProc\fR(
 typedef int \fBTcl_CmdObjTraceProc2\fR(
         \fBvoid *\fR \fIclientData\fR,
         \fBTcl_Interp\fR* \fIinterp\fR,
-        ptrdiff_t \fIlevel\fR,
+        Tcl_Size \fIlevel\fR,
         const char *\fIcommand\fR,
         \fBTcl_Command\fR \fIcommandToken\fR,
-        ptrdiff_t \fIobjc\fR,
+        Tcl_Size \fIobjc\fR,
         \fBTcl_Obj\fR *const \fIobjv\fR[]);
 .CE
 .PP

doc/Panic.3

@@ -27,10 +27,6 @@ void
 A printf-style format string.
 .AP "" arg in
 Arguments matching the format string.
-.AP va_list argList in
-An argument list of arguments matching the format string.
-Must have been initialized using \fBva_start\fR,
-and cleared using \fBva_end\fR.
 .AP Tcl_PanicProc *panicProc in
 Procedure to report fatal error message and abort.
 .BE

doc/SetResult.3

@@ -45,9 +45,6 @@ to the existing result of \fIinterp\fR.
 .AP Tcl_FreeProc *freeProc in
 Pointer to a procedure to call to release storage at
 \fIresult\fR.
-.AP va_list argList in
-An argument list which must have been initialized using
-\fBva_start\fR, and cleared using \fBva_end\fR.
 .AP Tcl_Interp *sourceInterp in
 The interpreter to transfer the result and return options from.
 .AP Tcl_Interp *targetInterp in

doc/StringObj.3

@@ -115,7 +115,7 @@ The index of the last Unicode character in the Unicode range to be
 returned as a new value. If negative, take all characters up to
 the last one available.
 .AP Tcl_Obj *objPtr in/out
-Points to a value to manipulate.
+A pointer to a value to read, or to an unshared value to modify.
 .AP Tcl_Obj *appendObjPtr in
 The value to append to \fIobjPtr\fR in \fBTcl_AppendObjToObj\fR.
 .AP "Tcl_Size \&| int" *lengthPtr out
@@ -123,9 +123,6 @@ The location where \fBTcl_GetStringFromObj\fR will store the length
 of a value's string representation. May be (int *)NULL when not used.
 .AP "const char" *string in
 Null-terminated string value to append to \fIobjPtr\fR.
-.AP va_list argList in
-An argument list which must have been initialized using
-\fBva_start\fR, and cleared using \fBva_end\fR.
 .AP Tcl_Size limit in
 Maximum number of bytes to be appended.
 .AP "const char" *ellipsis in

doc/Thread.3

@@ -107,8 +107,6 @@ and join it.
 Restrictions: On some UNIX systems the pthread-library does not
 contain the functionality to specify the stack size of a thread. The
 specified value for the stack size is ignored on these systems.
-Windows currently does not support joinable threads. This
-flag value is therefore ignored on this platform.
 .PP
 Tcl provides the \fBTcl_ExitThread\fR and \fBTcl_FinalizeThread\fR functions
 for terminating threads and invoking optional per-thread exit
@@ -158,9 +156,9 @@ A condition variable is used as a signaling mechanism:
 a thread can lock a mutex and then wait on a condition variable
 with \fBTcl_ConditionWait\fR.  This atomically releases the mutex lock
 and blocks the waiting thread until another thread calls
-\fBTcl_ConditionNotify\fR.  The caller of \fBTcl_ConditionNotify\fR should
+\fBTcl_ConditionNotify\fR.  The caller of \fBTcl_ConditionNotify\fR may
 have the associated mutex held by previously calling \fBTcl_MutexLock\fR,
-but this is not enforced.  Notifying the
+but this tends to produce more thread context switches.  Notifying the
 condition variable unblocks all threads waiting on the condition variable,
 but they do not proceed until the mutex is released with \fBTcl_MutexUnlock\fR.
 The implementation of \fBTcl_ConditionWait\fR automatically locks

doc/encoding.n

@@ -1,5 +1,6 @@
 '\"
 '\" Copyright (c) 1998 Scriptics Corporation.
+'\" Copyright (c) 2023 Nathan Coulter
 '\"
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.

generic/tcl.decls

@@ -146,7 +146,7 @@ declare 32 {
 }
 # Only available in Tcl 8.x, NULL in Tcl 9.0
 declare 33 {
-    unsigned char *TclGetByteArrayFromObj(Tcl_Obj *objPtr, int *numBytesPtr)
+    unsigned char *TclGetByteArrayFromObj(Tcl_Obj *objPtr, void *numBytesPtr)
 }
 declare 34 {
     int Tcl_GetDouble(Tcl_Interp *interp, const char *src, double *doublePtr)
@@ -173,7 +173,7 @@ declare 40 {
     const Tcl_ObjType *Tcl_GetObjType(const char *typeName)
 }
 declare 41 {
-    char *TclGetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr)
+    char *TclGetStringFromObj(Tcl_Obj *objPtr, void *lengthPtr)
 }
 declare 42 {
     void Tcl_InvalidateStringRep(Tcl_Obj *objPtr)
@@ -188,7 +188,7 @@ declare 44 {
 }
 declare 45 {
     int TclListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr,
-	    int *objcPtr, Tcl_Obj ***objvPtr)
+	    void *objcPtr, Tcl_Obj ***objvPtr)
 }
 declare 46 {
     int Tcl_ListObjIndex(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size index,
@@ -196,7 +196,7 @@ declare 46 {
 }
 declare 47 {
     int TclListObjLength(Tcl_Interp *interp, Tcl_Obj *listPtr,
-	    int *lengthPtr)
+	    void *lengthPtr)
 }
 declare 48 {
     int Tcl_ListObjReplace(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size first,
@@ -881,12 +881,12 @@ declare 241 {
     void Tcl_SourceRCFile(Tcl_Interp *interp)
 }
 declare 242 {
-    int TclSplitList(Tcl_Interp *interp, const char *listStr, int *argcPtr,
+    int TclSplitList(Tcl_Interp *interp, const char *listStr, void *argcPtr,
 	    const char ***argvPtr)
 }
 # Obsolete, use Tcl_FSSplitPath
 declare 243 {
-    void TclSplitPath(const char *path, int *argcPtr, const char ***argvPtr)
+    void TclSplitPath(const char *path, void *argcPtr, const char ***argvPtr)
 }
 # Removed in 9.0 (stub entry only)
 #declare 244  {
@@ -1601,7 +1601,7 @@ declare 433 {
 
 # introduced in 8.4a3
 declare 434 {
-    Tcl_UniChar *TclGetUnicodeFromObj(Tcl_Obj *objPtr, int *lengthPtr)
+    Tcl_UniChar *TclGetUnicodeFromObj(Tcl_Obj *objPtr, void *lengthPtr)
 }
 
 # TIP#15 (math function introspection) dkf
@@ -1702,7 +1702,7 @@ declare 460 {
     Tcl_Obj *Tcl_FSJoinPath(Tcl_Obj *listObj, Tcl_Size elements)
 }
 declare 461 {
-    Tcl_Obj *TclFSSplitPath(Tcl_Obj *pathPtr, int *lenPtr)
+    Tcl_Obj *TclFSSplitPath(Tcl_Obj *pathPtr, void *lenPtr)
 }
 declare 462 {
     int Tcl_FSEqualPaths(Tcl_Obj *firstPtr, Tcl_Obj *secondPtr)
@@ -1841,7 +1841,7 @@ declare 496 {
 	    Tcl_Obj *keyPtr)
 }
 declare 497 {
-    int TclDictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr, int *sizePtr)
+    int TclDictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr, void *sizePtr)
 }
 declare 498 {
     int Tcl_DictObjFirst(Tcl_Interp *interp, Tcl_Obj *dictPtr,
@@ -2270,7 +2270,7 @@ declare 603 {
 # TIP#265 (option parser) dkf for Sam Bromley
 declare 604 {
     int TclParseArgsObjv(Tcl_Interp *interp, const Tcl_ArgvInfo *argTable,
-	    int *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv)
+	    void *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv)
 }
 
 # TIP#336 (manipulate the error line) dgp
@@ -2468,7 +2468,7 @@ declare 648 {
 # TIP #568
 declare 649 {
     unsigned char *TclGetBytesFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
-	    int *numBytesPtr)
+	    void *numBytesPtr)
 }
 declare 650 {
     unsigned char *Tcl_GetBytesFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,

generic/tcl.h

@@ -561,7 +561,7 @@ typedef int (Tcl_CmdObjTraceProc) (void *clientData, Tcl_Interp *interp,
 	int level, const char *command, Tcl_Command commandInfo, int objc,
 	struct Tcl_Obj *const *objv);
 typedef int (Tcl_CmdObjTraceProc2) (void *clientData, Tcl_Interp *interp,
-	ptrdiff_t level, const char *command, Tcl_Command commandInfo, ptrdiff_t objc,
+	Tcl_Size level, const char *command, Tcl_Command commandInfo, Tcl_Size objc,
 	struct Tcl_Obj *const *objv);
 typedef void (Tcl_CmdObjTraceDeleteProc) (void *clientData);
 typedef void (Tcl_DupInternalRepProc) (struct Tcl_Obj *srcPtr,
@@ -586,7 +586,7 @@ typedef void (Tcl_NamespaceDeleteProc) (void *clientData);
 typedef int (Tcl_ObjCmdProc) (void *clientData, Tcl_Interp *interp,
 	int objc, struct Tcl_Obj *const *objv);
 typedef int (Tcl_ObjCmdProc2) (void *clientData, Tcl_Interp *interp,
-	ptrdiff_t objc, struct Tcl_Obj *const *objv);
+	Tcl_Size objc, struct Tcl_Obj *const *objv);
 typedef int (Tcl_LibraryInitProc) (Tcl_Interp *interp);
 typedef int (Tcl_LibraryUnloadProc) (Tcl_Interp *interp, int flags);
 typedef void (Tcl_PanicProc) (const char *format, ...);
@@ -1969,15 +1969,18 @@ typedef struct Tcl_EncodingType {
 #define TCL_ENCODING_CHAR_LIMIT		0x10
 /* Internal use bits, do not define bits in this space. See above comment */
 #define TCL_ENCODING_INTERNAL_USE_MASK  0xFF00
-/* Reserve top byte for profile values (disjoint, not a mask) */
+/*
+ * Reserve top byte for profile values (disjoint, not a mask). In case of
+ * changes, ensure ENCODING_PROFILE_* macros in tclInt.h are modified if
+ * necessary.
+ */
 #define TCL_ENCODING_PROFILE_TCL8     0x01000000
 #define TCL_ENCODING_PROFILE_STRICT   0x02000000
 #define TCL_ENCODING_PROFILE_REPLACE  0x03000000
-/* Still being argued - For Tcl9, is the default strict? TODO */
 #if TCL_MAJOR_VERSION < 9
 #define TCL_ENCODING_PROFILE_DEFAULT  TCL_ENCODING_PROFILE_TCL8
 #else
-#define TCL_ENCODING_PROFILE_DEFAULT  TCL_ENCODING_PROFILE_TCL8 /* STRICT? REPLACE? TODO */
+#define TCL_ENCODING_PROFILE_DEFAULT  TCL_ENCODING_PROFILE_TCL8
 #endif
 
 /*

generic/tclArithSeries.c

@@ -13,36 +13,95 @@
 #include "tclInt.h"
 #include "tclArithSeries.h"
 #include <assert.h>
+#include <math.h>
 
 /* -------------------------- ArithSeries object ---------------------------- */
 
+/*
+ * Helper functions
+ *
+ * - ArithRound -- Round doubles to the number of significant fractional
+ *                 digits
+ * - ArithSeriesIndexDbl -- base list indexing operation for doubles
+ * - ArithSeriesIndexInt --   "    "      "        "      "  integers
+ * - ArithSeriesGetInternalRep -- Return the internal rep from a Tcl_Obj
+ * - Precision -- determine the number of factional digits for the given
+ *   double value
+ * - maxPrecision -- Using the values provide, determine the longest percision
+ *   in the arithSeries
+ */
+static inline double
+ArithRound(double d, unsigned int n) {
+    double scalefactor = pow(10, n);
+    return round(d*scalefactor)/scalefactor;
+}
 
-#define ArithSeriesRepPtr(arithSeriesObjPtr) \
-    (ArithSeries *) ((arithSeriesObjPtr)->internalRep.twoPtrValue.ptr1)
+static inline double
+ArithSeriesIndexDbl(
+    ArithSeries *arithSeriesRepPtr,
+    Tcl_WideInt index)
+{
+    ArithSeriesDbl *dblRepPtr = (ArithSeriesDbl*)arithSeriesRepPtr;
+    if (arithSeriesRepPtr->isDouble) {
+        double d = dblRepPtr->start + (index * dblRepPtr->step);
+	unsigned n = (dblRepPtr->precision > 0 ? dblRepPtr->precision : 0);
+        return ArithRound(d, n);
+    } else {
+	return (double)(arithSeriesRepPtr->start + (index * arithSeriesRepPtr->step));
+    }
+}
 
-#define ArithSeriesIndexM(arithSeriesRepPtr, index) \
-    ((arithSeriesRepPtr)->isDouble ?					\
-     (((ArithSeriesDbl*)(arithSeriesRepPtr))->start+((index) * ((ArithSeriesDbl*)(arithSeriesRepPtr))->step)) \
-     :									\
-     ((arithSeriesRepPtr)->start+((index) * arithSeriesRepPtr->step)))
+static inline Tcl_WideInt
+ArithSeriesIndexInt(
+    ArithSeries *arithSeriesRepPtr,
+    Tcl_WideInt index)
+{
+    ArithSeriesDbl *dblRepPtr = (ArithSeriesDbl*)arithSeriesRepPtr;
+    if (arithSeriesRepPtr->isDouble) {
+	return (Tcl_WideInt)(dblRepPtr->start + ((index) * dblRepPtr->step));
+    } else {
+	return (arithSeriesRepPtr->start + (index * arithSeriesRepPtr->step));
+    }
+}
 
-#define ArithSeriesGetInternalRep(objPtr, arithRepPtr)		\
-    do {								\
-	const Tcl_ObjInternalRep *irPtr;				\
-	irPtr = TclFetchInternalRep((objPtr), &tclArithSeriesType.objType);	\
-	(arithRepPtr) = irPtr ? (ArithSeries *)irPtr->twoPtrValue.ptr1 : NULL;	\
-    } while (0)
+static inline ArithSeries*
+ArithSeriesGetInternalRep(Tcl_Obj *objPtr)
+{
+    const Tcl_ObjInternalRep *irPtr;
+    irPtr = TclFetchInternalRep((objPtr), &tclArithSeriesType.objType);
+    return irPtr ? (ArithSeries *)irPtr->twoPtrValue.ptr1 : NULL;
+}
 
+static inline int
+Precision(double d)
+{
+    char tmp[TCL_DOUBLE_SPACE+2], *off;
+    tmp[0] = 0;
+    Tcl_PrintDouble(NULL,d,tmp);
+    off = strchr(tmp, '.');
+    return (off ? strlen(off+1) : 0);
+}
+static inline int
+maxPrecision(double start, double end, double step)
+{
+    // Find longest number of digits after the decimal point.
+    int dp = Precision(step);
+    int i  = Precision(start);
+    dp = i>dp ? i : dp;
+    i  = Precision(end);
+    dp = i>dp ? i : dp;
+    return dp;
+}
 
 /*
  * Prototypes for procedures defined later in this file:
  */
 
-static void		DupArithSeriesInternalRep (Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
-static void		FreeArithSeriesInternalRep (Tcl_Obj *listPtr);
-static int		SetArithSeriesFromAny (Tcl_Interp *interp, Tcl_Obj *objPtr);
-static void		UpdateStringOfArithSeries (Tcl_Obj *arithSeriesObj);
-static Tcl_Obj *ArithSeriesObjStep(Tcl_Obj *arithSeriesPtr);
+static void	DupArithSeriesInternalRep (Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
+static void	FreeArithSeriesInternalRep (Tcl_Obj *listPtr);
+static int	SetArithSeriesFromAny (Tcl_Interp *interp, Tcl_Obj *objPtr);
+static void	UpdateStringOfArithSeries (Tcl_Obj *arithSeriesObj);
+static Tcl_Obj* ArithSeriesObjStep(Tcl_Obj *arithSeriesPtr);
 static Tcl_Size ArithSeriesObjLength(Tcl_Obj *arithSeriesPtr);
 
 /*
@@ -107,7 +166,7 @@ const TclObjTypeWithAbstractList tclArithSeriesType = {
  *----------------------------------------------------------------------
  */
 static Tcl_WideInt
-ArithSeriesLen(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step)
+ArithSeriesLenInt(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step)
 {
     Tcl_WideInt len;
 
@@ -118,6 +177,18 @@ ArithSeriesLen(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step)
     return (len < 0) ? -1 : len;
 }
 
+static Tcl_WideInt
+ArithSeriesLenDbl(double start, double end, double step)
+{
+    Tcl_WideInt len;
+
+    if (step == 0) {
+	return 0;
+    }
+    len = ((end-start+step)/step);
+    return (len < 0) ? -1 : len;
+}
+
 /*
  *----------------------------------------------------------------------
  *
@@ -140,10 +211,13 @@ static
 Tcl_Obj *
 NewArithSeriesInt(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step, Tcl_WideInt len)
 {
-    Tcl_WideInt length = (len>=0 ? len : ArithSeriesLen(start, end, step));
+    Tcl_WideInt length;
     Tcl_Obj *arithSeriesObj;
     ArithSeries *arithSeriesRepPtr;
 
+    length = len>=0 ? len : -1;
+    if (length < 0) length = -1;
+
     TclNewObj(arithSeriesObj);
 
     if (length <= 0) {
@@ -184,14 +258,20 @@ NewArithSeriesInt(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step, Tcl_Wide
  * 	None.
  *----------------------------------------------------------------------
  */
+
 static
 Tcl_Obj *
 NewArithSeriesDbl(double start, double end, double step, Tcl_WideInt len)
 {
-    Tcl_WideInt length = (len>=0 ? len : ArithSeriesLen(start, end, step));
+    Tcl_WideInt length;
     Tcl_Obj *arithSeriesObj;
     ArithSeriesDbl *arithSeriesRepPtr;
 
+    length = len>=0 ? len : -1;
+    if (length < 0) {
+	length = -1;
+    }
+
     TclNewObj(arithSeriesObj);
 
     if (length <= 0) {
@@ -205,11 +285,14 @@ NewArithSeriesDbl(double start, double end, double step, Tcl_WideInt len)
     arithSeriesRepPtr->step = step;
     arithSeriesRepPtr->len = length;
     arithSeriesRepPtr->elements = NULL;
+    arithSeriesRepPtr->precision = maxPrecision(start,end,step);
     arithSeriesObj->internalRep.twoPtrValue.ptr1 = arithSeriesRepPtr;
     arithSeriesObj->internalRep.twoPtrValue.ptr2 = NULL;
     arithSeriesObj->typePtr = &tclArithSeriesType.objType;
-    if (length > 0)
+
+    if (length > 0) {
     	Tcl_InvalidateStringRep(arithSeriesObj);
+    }
 
     return arithSeriesObj;
 }
@@ -295,7 +378,7 @@ TclNewArithSeriesObj(
 {
     double dstart, dend, dstep;
     Tcl_WideInt start, end, step;
-    Tcl_WideInt len;
+    Tcl_WideInt len = -1;
 
     if (startObj) {
 	assignNumber(useDoubles, &start, &dstart, startObj);
@@ -337,9 +420,9 @@ TclNewArithSeriesObj(
 	assert(dstep!=0);
 	if (!lenObj) {
 	    if (useDoubles) {
-		len = (dend - dstart + dstep)/dstep;
+		len = ArithSeriesLenDbl(dstart, dend, dstep);
 	    } else {
-		len = (end - start + step)/step;
+		len = ArithSeriesLenInt(start, end, step);
 	    }
 	}
     }
@@ -354,7 +437,7 @@ TclNewArithSeriesObj(
 	}
     }
 
-    if (TCL_MAJOR_VERSION < 9 && len > ListSizeT_MAX) {
+    if (len > TCL_SIZE_MAX) {
 	Tcl_SetObjResult(
 	    interp,
 	    Tcl_NewStringObj("max length of a Tcl list exceeded", -1));
@@ -398,7 +481,7 @@ ArithSeriesObjStep(
     if (arithSeriesObj->typePtr != &tclArithSeriesType.objType) {
         Tcl_Panic("ArithSeriesObjStep called with a not ArithSeries Obj.");
     }
-    arithSeriesRepPtr = ArithSeriesRepPtr(arithSeriesObj);
+    arithSeriesRepPtr = ArithSeriesGetInternalRep(arithSeriesObj);
     if (arithSeriesRepPtr->isDouble) {
 	TclNewDoubleObj(stepObj, ((ArithSeriesDbl*)(arithSeriesRepPtr))->step);
     } else {
@@ -430,7 +513,7 @@ ArithSeriesObjStep(
 
 Tcl_Obj *
 TclArithSeriesObjIndex(
-    Tcl_Interp *interp,
+    TCL_UNUSED(Tcl_Interp *),
     Tcl_Obj *arithSeriesObj,
     Tcl_WideInt index)
 {
@@ -439,21 +522,15 @@ TclArithSeriesObjIndex(
     if (arithSeriesObj->typePtr != &tclArithSeriesType.objType) {
 	Tcl_Panic("TclArithSeriesObjIndex called with a not ArithSeries Obj.");
     }
-    arithSeriesRepPtr = ArithSeriesRepPtr(arithSeriesObj);
+    arithSeriesRepPtr = ArithSeriesGetInternalRep(arithSeriesObj);
     if (index < 0 || (Tcl_Size)index >= arithSeriesRepPtr->len) {
-	if (interp) {
-	    Tcl_SetObjResult(interp,
-		    Tcl_ObjPrintf("index %" TCL_LL_MODIFIER "d is out of bounds 0 to %"
-			    TCL_LL_MODIFIER "d", index, (arithSeriesRepPtr->len-1)));
-	    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
-	}
-	return NULL;
+	return Tcl_NewObj();
     }
     /* List[i] = Start + (Step * index) */
     if (arithSeriesRepPtr->isDouble) {
-	return Tcl_NewDoubleObj(ArithSeriesIndexM(arithSeriesRepPtr, index));
+	return Tcl_NewDoubleObj(ArithSeriesIndexDbl(arithSeriesRepPtr, index));
     } else {
-	return Tcl_NewWideIntObj(ArithSeriesIndexM(arithSeriesRepPtr, index));
+	return Tcl_NewWideIntObj(ArithSeriesIndexInt(arithSeriesRepPtr, index));
     }
 }
 
@@ -541,16 +618,25 @@ DupArithSeriesInternalRep(
     Tcl_Obj *copyPtr)		/* Object with internal rep to set. */
 {
     ArithSeries *srcArithSeriesRepPtr =
-	    (ArithSeries *) srcPtr->internalRep.twoPtrValue.ptr1;
-    ArithSeries *copyArithSeriesRepPtr;
-
+	(ArithSeries *) srcPtr->internalRep.twoPtrValue.ptr1;
     /*
      * Allocate a new ArithSeries structure. */
 
-    copyArithSeriesRepPtr = (ArithSeries*) Tcl_Alloc(sizeof(ArithSeries));
-    *copyArithSeriesRepPtr = *srcArithSeriesRepPtr;
-    copyArithSeriesRepPtr->elements = NULL;
-    copyPtr->internalRep.twoPtrValue.ptr1 = copyArithSeriesRepPtr;
+    if (srcArithSeriesRepPtr->isDouble) {
+	ArithSeriesDbl *srcArithSeriesDblRepPtr =
+	    (ArithSeriesDbl *)srcArithSeriesRepPtr;
+	ArithSeriesDbl *copyArithSeriesDblRepPtr =
+	    (ArithSeriesDbl *) Tcl_Alloc(sizeof(ArithSeriesDbl));
+	*copyArithSeriesDblRepPtr = *srcArithSeriesDblRepPtr;
+	copyArithSeriesDblRepPtr->elements = NULL;
+	copyPtr->internalRep.twoPtrValue.ptr1 = copyArithSeriesDblRepPtr;
+    } else {
+	ArithSeries *copyArithSeriesRepPtr =
+	    (ArithSeries *) Tcl_Alloc(sizeof(ArithSeries));
+	*copyArithSeriesRepPtr = *srcArithSeriesRepPtr;
+	copyArithSeriesRepPtr->elements = NULL;
+	copyPtr->internalRep.twoPtrValue.ptr1 = copyArithSeriesRepPtr;
+    }
     copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
     copyPtr->typePtr = &tclArithSeriesType.objType;
 }
@@ -591,29 +677,47 @@ UpdateStringOfArithSeries(Tcl_Obj *arithSeriesObj)
     char *elem, *p;
     Tcl_Obj *elemObj;
     Tcl_Size i;
-    Tcl_WideInt length = 0;
+    Tcl_Size length = 0;
     Tcl_Size slen;
 
     /*
      * Pass 1: estimate space.
      */
-    for (i = 0; i < arithSeriesRepPtr->len; i++) {
-	elemObj = TclArithSeriesObjIndex(NULL, arithSeriesObj, i);
-	elem = Tcl_GetStringFromObj(elemObj, &slen);
-	Tcl_DecrRefCount(elemObj);
-	slen += 1; /* + 1 is for the space or the nul-term */
-	length += slen;
+    if (!arithSeriesRepPtr->isDouble) {
+	for (i = 0; i < arithSeriesRepPtr->len; i++) {
+	    double d = ArithSeriesIndexDbl(arithSeriesRepPtr, i);
+	    slen = d>0 ? log10(d)+1 : d<0 ? log10((0-d))+2 : 1;
+	    length += slen;
+	}
+    } else {
+	for (i = 0; i < arithSeriesRepPtr->len; i++) {
+	    double d = ArithSeriesIndexDbl(arithSeriesRepPtr, i);
+	    char tmp[TCL_DOUBLE_SPACE+2];
+	    tmp[0] = 0;
+	    Tcl_PrintDouble(NULL,d,tmp);
+	    if ((length + strlen(tmp)) > TCL_SIZE_MAX) {
+		break; // overflow
+	    }
+	    length += strlen(tmp);
+	}
     }
+    length += arithSeriesRepPtr->len; // Space for each separator
 
     /*
      * Pass 2: generate the string repr.
      */
 
     p = Tcl_InitStringRep(arithSeriesObj, NULL, length);
+    if (p == NULL) {
+	Tcl_Panic("Unable to allocate string size %" TCL_Z_MODIFIER "u", length);
+    }
     for (i = 0; i < arithSeriesRepPtr->len; i++) {
 	elemObj = TclArithSeriesObjIndex(NULL, arithSeriesObj, i);
 	elem = Tcl_GetStringFromObj(elemObj, &slen);
-	strcpy(p, elem);
+	if (((p - arithSeriesObj->bytes)+slen) > length) {
+	    break;
+	}
+	strncpy(p, elem, slen);
 	p[slen] = ' ';
 	p += slen+1;
 	Tcl_DecrRefCount(elemObj);
@@ -685,7 +789,7 @@ TclArithSeriesObjCopy(
     Tcl_Obj *copyPtr;
     ArithSeries *arithSeriesRepPtr;
 
-    ArithSeriesGetInternalRep(arithSeriesObj, arithSeriesRepPtr);
+    arithSeriesRepPtr = ArithSeriesGetInternalRep(arithSeriesObj);
     if (NULL == arithSeriesRepPtr) {
 	if (SetArithSeriesFromAny(interp, arithSeriesObj) != TCL_OK) {
 	    /* We know this is going to panic, but it's the message we want */
@@ -728,17 +832,30 @@ TclArithSeriesObjRange(
     ArithSeries *arithSeriesRepPtr;
     Tcl_Obj *startObj, *endObj, *stepObj;
 
-    ArithSeriesGetInternalRep(arithSeriesObj, arithSeriesRepPtr);
+    arithSeriesRepPtr = ArithSeriesGetInternalRep(arithSeriesObj);
 
     if (fromIdx == TCL_INDEX_NONE) {
 	fromIdx = 0;
     }
-    if (fromIdx > toIdx) {
+
+    if (fromIdx > toIdx ||
+	(toIdx > arithSeriesRepPtr->len-1 &&
+	 fromIdx > arithSeriesRepPtr->len-1)) {
 	Tcl_Obj *obj;
 	TclNewObj(obj);
 	return obj;
     }
 
+    if (fromIdx < 0) {
+	fromIdx = 0;
+    }
+    if (toIdx < 0) {
+	toIdx = 0;
+    }
+    if (toIdx > arithSeriesRepPtr->len-1) {
+	toIdx = arithSeriesRepPtr->len-1;
+    }
+
     startObj = TclArithSeriesObjIndex(interp, arithSeriesObj, fromIdx);
     if (startObj == NULL) {
 	return NULL;
@@ -778,15 +895,17 @@ TclArithSeriesObjRange(
     TclInvalidateStringRep(arithSeriesObj);
 
     if (arithSeriesRepPtr->isDouble) {
-	ArithSeriesDbl *arithSeriesDblRepPtr = (ArithSeriesDbl*)arithSeriesObj;
+	ArithSeriesDbl *arithSeriesDblRepPtr = (ArithSeriesDbl*)arithSeriesRepPtr;
 	double start, end, step;
+
 	Tcl_GetDoubleFromObj(NULL, startObj, &start);
 	Tcl_GetDoubleFromObj(NULL, endObj, &end);
 	Tcl_GetDoubleFromObj(NULL, stepObj, &step);
 	arithSeriesDblRepPtr->start = start;
 	arithSeriesDblRepPtr->end = end;
 	arithSeriesDblRepPtr->step = step;
-	arithSeriesDblRepPtr->len = (end-start+step)/step;
+	arithSeriesDblRepPtr->precision = maxPrecision(start, end, step);
+	arithSeriesDblRepPtr->len = ArithSeriesLenDbl(start, end, step);
 	arithSeriesDblRepPtr->elements = NULL;
 
     } else {
@@ -797,7 +916,7 @@ TclArithSeriesObjRange(
 	arithSeriesRepPtr->start = start;
 	arithSeriesRepPtr->end = end;
 	arithSeriesRepPtr->step = step;
-	arithSeriesRepPtr->len = (end-start+step)/step;
+	arithSeriesRepPtr->len = ArithSeriesLenInt(start, end, step);
 	arithSeriesRepPtr->elements = NULL;
     }
 
@@ -852,7 +971,7 @@ TclArithSeriesGetElements(
 	Tcl_Obj **objv;
 	int i, objc;
 
-	ArithSeriesGetInternalRep(objPtr, arithSeriesRepPtr);
+	arithSeriesRepPtr = ArithSeriesGetInternalRep(objPtr);
 	objc = arithSeriesRepPtr->len;
 	if (objc > 0) {
 	    if (arithSeriesRepPtr->elements) {
@@ -927,7 +1046,7 @@ TclArithSeriesObjReverse(
     double dstart, dend, dstep;
     int isDouble;
 
-    ArithSeriesGetInternalRep(arithSeriesObj, arithSeriesRepPtr);
+    arithSeriesRepPtr = ArithSeriesGetInternalRep(arithSeriesObj);
 
     isDouble = arithSeriesRepPtr->isDouble;
     len = arithSeriesRepPtr->len;

generic/tclArithSeries.h

@@ -30,6 +30,7 @@ typedef struct {
     double start;
     double end;
     double step;
+    int precision;
 } ArithSeriesDbl;
 
 

generic/tclBasic.c

@@ -3298,7 +3298,7 @@ invokeObj2Command(
     Command *cmdPtr = (Command *) clientData;
 
     if (objc > INT_MAX) {
-	objc = TCL_INDEX_NONE; /* TODO - why? Should error, not truncate */
+	return TclCommandWordLimitError(interp, objc);
     }
     if (cmdPtr->objProc != NULL) {
 	result = cmdPtr->objProc(cmdPtr->objClientData, interp, objc, objv);
@@ -3315,6 +3315,9 @@ static int cmdWrapper2Proc(void *clientData,
     Tcl_Obj *const objv[])
 {
     Command *cmdPtr = (Command *)clientData;
+    if (objc > INT_MAX) {
+	return TclCommandWordLimitError(interp, objc);
+    }
     return cmdPtr->objProc(cmdPtr->objClientData, interp, objc, objv);
 }
 
@@ -5164,17 +5167,17 @@ TclEvalEx(
 {
     Interp *iPtr = (Interp *) interp;
     const char *p, *next;
-    const unsigned int minObjs = 20;
+    const int minObjs = 20;
     Tcl_Obj **objv, **objvSpace;
     int *expand, *lines, *lineSpace;
     Tcl_Token *tokenPtr;
-    int bytesLeft, expandRequested, code = TCL_OK;
-    Tcl_Size commandLength;
+    int expandRequested, code = TCL_OK;
+    Tcl_Size bytesLeft, commandLength;
     CallFrame *savedVarFramePtr;/* Saves old copy of iPtr->varFramePtr in case
 				 * TCL_EVAL_GLOBAL was set. */
     int allowExceptions = (iPtr->evalFlags & TCL_ALLOW_EXCEPTIONS);
     int gotParse = 0;
-    TCL_HASH_TYPE i, objectsUsed = 0;
+    Tcl_Size i, objectsUsed = 0;
 				/* These variables keep track of how much
 				 * state has been allocated while evaluating
 				 * the script, so that it can be freed
@@ -5312,8 +5315,8 @@ TclEvalEx(
 	    Tcl_Size wordLine = line;
 	    const char *wordStart = parsePtr->commandStart;
 	    int *wordCLNext = clNext;
-	    unsigned int objectsNeeded = 0;
-	    unsigned int numWords = parsePtr->numWords;
+	    Tcl_Size objectsNeeded = 0;
+	    Tcl_Size numWords = parsePtr->numWords;
 
 	    /*
 	     * Generate an array of objects for the words of the command.
@@ -5332,6 +5335,8 @@ TclEvalEx(
 	    for (objectsUsed = 0, tokenPtr = parsePtr->tokenPtr;
 		    objectsUsed < numWords;
 		    objectsUsed++, tokenPtr += tokenPtr->numComponents+1) {
+		Tcl_Size additionalObjsCount;
+
 		/*
 		 * TIP #280. Track lines to current word. Save the information
 		 * on a per-word basis, signaling dynamic words as needed.
@@ -5381,12 +5386,22 @@ TclEvalEx(
 		    expandRequested = 1;
 		    expand[objectsUsed] = 1;
 
-		    objectsNeeded += (numElements ? numElements : 1);
+		    additionalObjsCount = (numElements ? numElements : 1);
+
 		} else {
 		    expand[objectsUsed] = 0;
-		    objectsNeeded++;
+		    additionalObjsCount = 1;
 		}
 
+		/* Currently max command words in INT_MAX */
+		if (additionalObjsCount > INT_MAX ||
+		    objectsNeeded > (INT_MAX - additionalObjsCount)) {
+		    code = TclCommandWordLimitError(interp, -1);
+		    Tcl_DecrRefCount(objv[objectsUsed]);
+		    break;
+		}
+		objectsNeeded += additionalObjsCount;
+
 		if (wordCLNext) {
 		    TclContinuationsEnterDerived(objv[objectsUsed],
 			    wordStart - outerScript, wordCLNext);

generic/tclBinary.c

@@ -386,7 +386,7 @@ unsigned char *
 TclGetBytesFromObj(
     Tcl_Interp *interp,		/* For error reporting */
     Tcl_Obj *objPtr,		/* Value to extract from */
-    int *numBytesPtr)		/* If non-NULL, write the number of bytes
+    void *numBytesPtr)		/* If non-NULL, write the number of bytes
 				 * in the array here */
 {
     Tcl_Size numBytes = 0;
@@ -404,7 +404,7 @@ TclGetBytesFromObj(
 	    }
 	    return NULL;
 	} else {
-	    *numBytesPtr = (int) numBytes;
+	    *(int *)numBytesPtr = (int) numBytes;
 	}
     }
     return bytes;
@@ -774,7 +774,7 @@ TclAppendBytesToByteArray(
 	 */
 
 	Tcl_Size attempt;
-	
+
 	/* Make sure we do not wrap when doubling */
 	if (needed <= (BYTEARRAY_MAX_LEN - needed)) {
 	    attempt = 2 * needed;
@@ -870,7 +870,7 @@ BinaryFormatCmd(
     int value = 0;		/* Current integer value to be packed.
 				 * Initialized to avoid compiler warning. */
     char cmd;			/* Current format character. */
-    Tcl_Size count;			/* Count associated with current format
+    Tcl_Size count;		/* Count associated with current format
 				 * character. */
     int flags;			/* Format field flags */
     const char *format;		/* Pointer to current position in format
@@ -1383,7 +1383,7 @@ BinaryScanCmd(
     int value = 0;		/* Current integer value to be packed.
 				 * Initialized to avoid compiler warning. */
     char cmd;			/* Current format character. */
-    Tcl_Size count;			/* Count associated with current format
+    Tcl_Size count;		/* Count associated with current format
 				 * character. */
     int flags;			/* Format field flags */
     const char *format;		/* Pointer to current position in format
@@ -1795,14 +1795,14 @@ GetFormatSpec(
 	(*formatPtr)++;
 	*countPtr = BINARY_ALL;
     } else if (isdigit(UCHAR(**formatPtr))) { /* INTL: digit */
-	unsigned long count;
+	unsigned long long count;
 
 	errno = 0;
-	count = strtoul(*formatPtr, (char **) formatPtr, 10);
-	if (errno || (count > (unsigned long) INT_MAX)) {
-	    *countPtr = INT_MAX;
+	count = strtoull(*formatPtr, (char **) formatPtr, 10);
+	if (errno || (count > TCL_SIZE_MAX)) {
+	    *countPtr = TCL_SIZE_MAX;
 	} else {
-	    *countPtr = (int) count;
+	    *countPtr = count;
 	}
     } else {
 	*countPtr = BINARY_NOCOUNT;
@@ -2638,11 +2638,11 @@ BinaryEncode64(
 {
     Tcl_Obj *resultObj;
     unsigned char *data, *limit;
-    int maxlen = 0;
+    Tcl_Size maxlen = 0;
     const char *wrapchar = "\n";
     Tcl_Size wrapcharlen = 1;
-    int i, index, size, outindex = 0, purewrap = 1;
-    Tcl_Size offset, count = 0;
+    int index, purewrap = 1;
+    Tcl_Size i, offset, size, outindex = 0, count = 0;
     enum { OPT_MAXLEN, OPT_WRAPCHAR };
     static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL };
 
@@ -2658,7 +2658,7 @@ BinaryEncode64(
 	}
 	switch (index) {
 	case OPT_MAXLEN:
-	    if (Tcl_GetIntFromObj(interp, objv[i + 1], &maxlen) != TCL_OK) {
+	    if (Tcl_GetSizeIntFromObj(interp, objv[i + 1], &maxlen) != TCL_OK) {
 		return TCL_ERROR;
 	    }
 	    if (maxlen < 0) {
@@ -2764,12 +2764,12 @@ BinaryEncodeUu(
 {
     Tcl_Obj *resultObj;
     unsigned char *data, *start, *cursor;
-    int rawLength, i, bits, index;
+    int i, bits, index;
     unsigned int n;
     int lineLength = 61;
     const unsigned char SingleNewline[] = { UCHAR('\n') };
     const unsigned char *wrapchar = SingleNewline;
-    Tcl_Size j, offset, count = 0, wrapcharlen = sizeof(SingleNewline);
+    Tcl_Size j, rawLength, offset, count = 0, wrapcharlen = sizeof(SingleNewline);
     enum { OPT_MAXLEN, OPT_WRAPCHAR };
     static const char *const optStrings[] = { "-maxlen", "-wrapchar", NULL };
 
@@ -2859,7 +2859,7 @@ BinaryEncodeUu(
      */
 
     while (offset < count) {
-	int lineLen = count - offset;
+	Tcl_Size lineLen = count - offset;
 
 	if (lineLen > rawLength) {
 	    lineLen = rawLength;

generic/tclCmdMZ.c

@@ -2642,8 +2642,8 @@ StringEqualCmd(
      */
 
     const char *string2;
-    int i, match, nocase = 0, reqlength = -1;
-    Tcl_Size length;
+    int i, match, nocase = 0;
+    Tcl_Size length, reqlength = -1;
 
     if (objc < 3 || objc > 6) {
     str_cmp_args:
@@ -2662,7 +2662,7 @@ StringEqualCmd(
 		goto str_cmp_args;
 	    }
 	    i++;
-	    if (TclGetIntFromObj(interp, objv[i], &reqlength) != TCL_OK) {
+	    if (TclGetSizeIntFromObj(interp, objv[i], &reqlength) != TCL_OK) {
 		return TCL_ERROR;
 	    }
 	} else {
@@ -2717,7 +2717,8 @@ StringCmpCmd(
      * the expr string comparison in INST_EQ/INST_NEQ/INST_LT/...).
      */
 
-    int match, nocase, reqlength, status;
+    int match, nocase, status;
+    Tcl_Size reqlength;
 
     status = TclStringCmpOpts(interp, objc, objv, &nocase, &reqlength);
     if (status != TCL_OK) {
@@ -2736,7 +2737,7 @@ TclStringCmpOpts(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[],	/* Argument objects. */
     int *nocase,
-    int *reqlength)
+    Tcl_Size *reqlength)
 {
     int i;
     Tcl_Size length;
@@ -2761,7 +2762,7 @@ TclStringCmpOpts(
 		goto str_cmp_args;
 	    }
 	    i++;
-	    if (TclGetIntFromObj(interp, objv[i], reqlength) != TCL_OK) {
+	    if (TclGetSizeIntFromObj(interp, objv[i], reqlength) != TCL_OK) {
 		return TCL_ERROR;
 	    }
 	} else {

generic/tclCompCmdsSZ.c

@@ -2669,7 +2669,7 @@ TclCompileTailcallCmd(
     Tcl_Token *tokenPtr = parsePtr->tokenPtr;
     int i;
 
-    if (parsePtr->numWords < 2 || parsePtr->numWords > 256
+    if (parsePtr->numWords < 2 || parsePtr->numWords >= 256
 	    || envPtr->procPtr == NULL) {
 	return TCL_ERROR;
     }

generic/tclCompile.c

@@ -869,6 +869,18 @@ TclSetByteCodeFromAny(
 	result = hookProc(interp, &compEnv, clientData);
     }
 
+    /*
+     * After optimization is all done, check that byte code length limits
+     * are not exceeded. Bug [27b3ce2997].
+     */
+    if ((compEnv.codeNext - compEnv.codeStart) > INT_MAX) {
+	/*
+	 * Cannot just return TCL_ERROR as callers ignore return value.
+	 * TODO - May be use TclCompileSyntaxError here?
+	 */
+	Tcl_Panic("Maximum byte code length %d exceeded.", INT_MAX);
+    }
+
     /*
      * Change the object into a ByteCode object. Ownership of the literal
      * objects and aux data items passes to the ByteCode object.
@@ -2136,7 +2148,7 @@ TclCompileScript(
 				 * serves as context for finding and compiling
 				 * commands. May not be NULL. */
     const char *script,		/* The source script to compile. */
-    size_t numBytes,		/* Number of bytes in script. If -1, the
+    Tcl_Size numBytes,		/* Number of bytes in script. If < 0, the
 				 * script consists of all bytes up to the
 				 * first null character. */
     CompileEnv *envPtr)		/* Holds resulting instructions. */
@@ -2167,9 +2179,26 @@ TclCompileScript(
 	return;
     }
 
+    if (numBytes < 0) {
+	numBytes = strlen(script);
+    }
+
     /* Each iteration compiles one command from the script. */
 
-    if (numBytes + 1 > 1) {
+    if (numBytes > 0) {
+      if (numBytes >= INT_MAX) {
+	/*
+	 * Note this gets -errorline as 1. Not worth figuring out which line
+	 * crosses the limit to get -errorline for this error case.
+	 */
+	Tcl_SetObjResult(interp,
+	  Tcl_ObjPrintf("Script length %" TCL_SIZE_MODIFIER
+			   "d exceeds max permitted length %d.",
+			   numBytes, (int)INT_MAX-1));
+	    Tcl_SetErrorCode(interp, "TCL", "LIMIT", "SCRIPTLENGTH", NULL);
+	    TclCompileSyntaxError(interp, envPtr);
+	    return;
+      }
       /*
        * Don't use system stack (size of Tcl_Parse is ca. 400 bytes), so
        * many nested compilations (body enclosed in body) can cause abnormal

generic/tclCompile.h

@@ -1100,7 +1100,7 @@ MODULE_SCOPE void	TclCompileInvocation(Tcl_Interp *interp,
 			    Tcl_Token *tokenPtr, Tcl_Obj *cmdObj, size_t numWords,
 			    CompileEnv *envPtr);
 MODULE_SCOPE void	TclCompileScript(Tcl_Interp *interp,
-			    const char *script, size_t numBytes,
+			    const char *script, Tcl_Size numBytes,
 			    CompileEnv *envPtr);
 MODULE_SCOPE void	TclCompileSyntaxError(Tcl_Interp *interp,
 			    CompileEnv *envPtr);

generic/tclDecls.h

@@ -136,7 +136,7 @@ EXTERN int		Tcl_GetBooleanFromObj(Tcl_Interp *interp,
 				Tcl_Obj *objPtr, int *intPtr);
 /* 33 */
 EXTERN unsigned char *	TclGetByteArrayFromObj(Tcl_Obj *objPtr,
-				int *numBytesPtr);
+				void *numBytesPtr);
 /* 34 */
 EXTERN int		Tcl_GetDouble(Tcl_Interp *interp, const char *src,
 				double *doublePtr);
@@ -156,7 +156,7 @@ EXTERN int		Tcl_GetLongFromObj(Tcl_Interp *interp,
 /* 40 */
 EXTERN const Tcl_ObjType * Tcl_GetObjType(const char *typeName);
 /* 41 */
-EXTERN char *		TclGetStringFromObj(Tcl_Obj *objPtr, int *lengthPtr);
+EXTERN char *		TclGetStringFromObj(Tcl_Obj *objPtr, void *lengthPtr);
 /* 42 */
 EXTERN void		Tcl_InvalidateStringRep(Tcl_Obj *objPtr);
 /* 43 */
@@ -167,7 +167,7 @@ EXTERN int		Tcl_ListObjAppendElement(Tcl_Interp *interp,
 				Tcl_Obj *listPtr, Tcl_Obj *objPtr);
 /* 45 */
 EXTERN int		TclListObjGetElements(Tcl_Interp *interp,
-				Tcl_Obj *listPtr, int *objcPtr,
+				Tcl_Obj *listPtr, void *objcPtr,
 				Tcl_Obj ***objvPtr);
 /* 46 */
 EXTERN int		Tcl_ListObjIndex(Tcl_Interp *interp,
@@ -175,7 +175,7 @@ EXTERN int		Tcl_ListObjIndex(Tcl_Interp *interp,
 				Tcl_Obj **objPtrPtr);
 /* 47 */
 EXTERN int		TclListObjLength(Tcl_Interp *interp,
-				Tcl_Obj *listPtr, int *lengthPtr);
+				Tcl_Obj *listPtr, void *lengthPtr);
 /* 48 */
 EXTERN int		Tcl_ListObjReplace(Tcl_Interp *interp,
 				Tcl_Obj *listPtr, Tcl_Size first,
@@ -665,9 +665,9 @@ EXTERN const char *	Tcl_SignalMsg(int sig);
 EXTERN void		Tcl_SourceRCFile(Tcl_Interp *interp);
 /* 242 */
 EXTERN int		TclSplitList(Tcl_Interp *interp, const char *listStr,
-				int *argcPtr, const char ***argvPtr);
+				void *argcPtr, const char ***argvPtr);
 /* 243 */
-EXTERN void		TclSplitPath(const char *path, int *argcPtr,
+EXTERN void		TclSplitPath(const char *path, void *argcPtr,
 				const char ***argvPtr);
 /* Slot 244 is reserved */
 /* Slot 245 is reserved */
@@ -1137,7 +1137,8 @@ EXTERN int		Tcl_AttemptSetObjLength(Tcl_Obj *objPtr,
 /* 433 */
 EXTERN Tcl_ThreadId	Tcl_GetChannelThread(Tcl_Channel channel);
 /* 434 */
-EXTERN Tcl_UniChar *	TclGetUnicodeFromObj(Tcl_Obj *objPtr, int *lengthPtr);
+EXTERN Tcl_UniChar *	TclGetUnicodeFromObj(Tcl_Obj *objPtr,
+				void *lengthPtr);
 /* Slot 435 is reserved */
 /* Slot 436 is reserved */
 /* 437 */
@@ -1209,7 +1210,7 @@ EXTERN int		Tcl_FSConvertToPathType(Tcl_Interp *interp,
 /* 460 */
 EXTERN Tcl_Obj *	Tcl_FSJoinPath(Tcl_Obj *listObj, Tcl_Size elements);
 /* 461 */
-EXTERN Tcl_Obj *	TclFSSplitPath(Tcl_Obj *pathPtr, int *lenPtr);
+EXTERN Tcl_Obj *	TclFSSplitPath(Tcl_Obj *pathPtr, void *lenPtr);
 /* 462 */
 EXTERN int		Tcl_FSEqualPaths(Tcl_Obj *firstPtr,
 				Tcl_Obj *secondPtr);
@@ -1306,7 +1307,7 @@ EXTERN int		Tcl_DictObjRemove(Tcl_Interp *interp,
 				Tcl_Obj *dictPtr, Tcl_Obj *keyPtr);
 /* 497 */
 EXTERN int		TclDictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr,
-				int *sizePtr);
+				void *sizePtr);
 /* 498 */
 EXTERN int		Tcl_DictObjFirst(Tcl_Interp *interp,
 				Tcl_Obj *dictPtr, Tcl_DictSearch *searchPtr,
@@ -1612,7 +1613,7 @@ EXTERN int		Tcl_GetEnsembleParameterList(Tcl_Interp *interp,
 				Tcl_Command token, Tcl_Obj **paramListPtr);
 /* 604 */
 EXTERN int		TclParseArgsObjv(Tcl_Interp *interp,
-				const Tcl_ArgvInfo *argTable, int *objcPtr,
+				const Tcl_ArgvInfo *argTable, void *objcPtr,
 				Tcl_Obj *const *objv, Tcl_Obj ***remObjv);
 /* 605 */
 EXTERN int		Tcl_GetErrorLine(Tcl_Interp *interp);
@@ -1744,7 +1745,7 @@ EXTERN int *		Tcl_UtfToUniCharDString(const char *src,
 				Tcl_Size length, Tcl_DString *dsPtr);
 /* 649 */
 EXTERN unsigned char *	TclGetBytesFromObj(Tcl_Interp *interp,
-				Tcl_Obj *objPtr, int *numBytesPtr);
+				Tcl_Obj *objPtr, void *numBytesPtr);
 /* 650 */
 EXTERN unsigned char *	Tcl_GetBytesFromObj(Tcl_Interp *interp,
 				Tcl_Obj *objPtr, Tcl_Size *numBytesPtr);
@@ -1911,7 +1912,7 @@ typedef struct TclStubs {
     void (*tclFreeObj) (Tcl_Obj *objPtr); /* 30 */
     int (*tcl_GetBoolean) (Tcl_Interp *interp, const char *src, int *intPtr); /* 31 */
     int (*tcl_GetBooleanFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr); /* 32 */
-    unsigned char * (*tclGetByteArrayFromObj) (Tcl_Obj *objPtr, int *numBytesPtr); /* 33 */
+    unsigned char * (*tclGetByteArrayFromObj) (Tcl_Obj *objPtr, void *numBytesPtr); /* 33 */
     int (*tcl_GetDouble) (Tcl_Interp *interp, const char *src, double *doublePtr); /* 34 */
     int (*tcl_GetDoubleFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr); /* 35 */
     void (*reserved36)(void);
@@ -1919,13 +1920,13 @@ typedef struct TclStubs {
     int (*tcl_GetIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr); /* 38 */
     int (*tcl_GetLongFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr); /* 39 */
     const Tcl_ObjType * (*tcl_GetObjType) (const char *typeName); /* 40 */
-    char * (*tclGetStringFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 41 */
+    char * (*tclGetStringFromObj) (Tcl_Obj *objPtr, void *lengthPtr); /* 41 */
     void (*tcl_InvalidateStringRep) (Tcl_Obj *objPtr); /* 42 */
     int (*tcl_ListObjAppendList) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *elemListPtr); /* 43 */
     int (*tcl_ListObjAppendElement) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *objPtr); /* 44 */
-    int (*tclListObjGetElements) (Tcl_Interp *interp, Tcl_Obj *listPtr, int *objcPtr, Tcl_Obj ***objvPtr); /* 45 */
+    int (*tclListObjGetElements) (Tcl_Interp *interp, Tcl_Obj *listPtr, void *objcPtr, Tcl_Obj ***objvPtr); /* 45 */
     int (*tcl_ListObjIndex) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size index, Tcl_Obj **objPtrPtr); /* 46 */
-    int (*tclListObjLength) (Tcl_Interp *interp, Tcl_Obj *listPtr, int *lengthPtr); /* 47 */
+    int (*tclListObjLength) (Tcl_Interp *interp, Tcl_Obj *listPtr, void *lengthPtr); /* 47 */
     int (*tcl_ListObjReplace) (Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Size first, Tcl_Size count, Tcl_Size objc, Tcl_Obj *const objv[]); /* 48 */
     void (*reserved49)(void);
     Tcl_Obj * (*tcl_NewByteArrayObj) (const unsigned char *bytes, Tcl_Size numBytes); /* 50 */
@@ -2120,8 +2121,8 @@ typedef struct TclStubs {
     const char * (*tcl_SignalId) (int sig); /* 239 */
     const char * (*tcl_SignalMsg) (int sig); /* 240 */
     void (*tcl_SourceRCFile) (Tcl_Interp *interp); /* 241 */
-    int (*tclSplitList) (Tcl_Interp *interp, const char *listStr, int *argcPtr, const char ***argvPtr); /* 242 */
-    void (*tclSplitPath) (const char *path, int *argcPtr, const char ***argvPtr); /* 243 */
+    int (*tclSplitList) (Tcl_Interp *interp, const char *listStr, void *argcPtr, const char ***argvPtr); /* 242 */
+    void (*tclSplitPath) (const char *path, void *argcPtr, const char ***argvPtr); /* 243 */
     void (*reserved244)(void);
     void (*reserved245)(void);
     void (*reserved246)(void);
@@ -2312,7 +2313,7 @@ typedef struct TclStubs {
     void * (*tcl_AttemptDbCkrealloc) (void *ptr, TCL_HASH_TYPE size, const char *file, int line); /* 431 */
     int (*tcl_AttemptSetObjLength) (Tcl_Obj *objPtr, Tcl_Size length); /* 432 */
     Tcl_ThreadId (*tcl_GetChannelThread) (Tcl_Channel channel); /* 433 */
-    Tcl_UniChar * (*tclGetUnicodeFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 434 */
+    Tcl_UniChar * (*tclGetUnicodeFromObj) (Tcl_Obj *objPtr, void *lengthPtr); /* 434 */
     void (*reserved435)(void);
     void (*reserved436)(void);
     Tcl_Obj * (*tcl_SubstObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 437 */
@@ -2339,7 +2340,7 @@ typedef struct TclStubs {
     int (*tcl_FSChdir) (Tcl_Obj *pathPtr); /* 458 */
     int (*tcl_FSConvertToPathType) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 459 */
     Tcl_Obj * (*tcl_FSJoinPath) (Tcl_Obj *listObj, Tcl_Size elements); /* 460 */
-    Tcl_Obj * (*tclFSSplitPath) (Tcl_Obj *pathPtr, int *lenPtr); /* 461 */
+    Tcl_Obj * (*tclFSSplitPath) (Tcl_Obj *pathPtr, void *lenPtr); /* 461 */
     int (*tcl_FSEqualPaths) (Tcl_Obj *firstPtr, Tcl_Obj *secondPtr); /* 462 */
     Tcl_Obj * (*tcl_FSGetNormalizedPath) (Tcl_Interp *interp, Tcl_Obj *pathPtr); /* 463 */
     Tcl_Obj * (*tcl_FSJoinToPath) (Tcl_Obj *pathPtr, Tcl_Size objc, Tcl_Obj *const objv[]); /* 464 */
@@ -2375,7 +2376,7 @@ typedef struct TclStubs {
     int (*tcl_DictObjPut) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr, Tcl_Obj *valuePtr); /* 494 */
     int (*tcl_DictObjGet) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr, Tcl_Obj **valuePtrPtr); /* 495 */
     int (*tcl_DictObjRemove) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr); /* 496 */
-    int (*tclDictObjSize) (Tcl_Interp *interp, Tcl_Obj *dictPtr, int *sizePtr); /* 497 */
+    int (*tclDictObjSize) (Tcl_Interp *interp, Tcl_Obj *dictPtr, void *sizePtr); /* 497 */
     int (*tcl_DictObjFirst) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_DictSearch *searchPtr, Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr, int *donePtr); /* 498 */
     void (*tcl_DictObjNext) (Tcl_DictSearch *searchPtr, Tcl_Obj **keyPtrPtr, Tcl_Obj **valuePtrPtr, int *donePtr); /* 499 */
     void (*tcl_DictObjDone) (Tcl_DictSearch *searchPtr); /* 500 */
@@ -2482,7 +2483,7 @@ typedef struct TclStubs {
     unsigned (*tcl_GetBlockSizeFromStat) (const Tcl_StatBuf *statPtr); /* 601 */
     int (*tcl_SetEnsembleParameterList) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj *paramList); /* 602 */
     int (*tcl_GetEnsembleParameterList) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **paramListPtr); /* 603 */
-    int (*tclParseArgsObjv) (Tcl_Interp *interp, const Tcl_ArgvInfo *argTable, int *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv); /* 604 */
+    int (*tclParseArgsObjv) (Tcl_Interp *interp, const Tcl_ArgvInfo *argTable, void *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv); /* 604 */
     int (*tcl_GetErrorLine) (Tcl_Interp *interp); /* 605 */
     void (*tcl_SetErrorLine) (Tcl_Interp *interp, int lineNum); /* 606 */
     void (*tcl_TransferResult) (Tcl_Interp *sourceInterp, int code, Tcl_Interp *targetInterp); /* 607 */
@@ -2527,7 +2528,7 @@ typedef struct TclStubs {
     Tcl_Size (*tcl_UtfToUniChar) (const char *src, int *chPtr); /* 646 */
     char * (*tcl_UniCharToUtfDString) (const int *uniStr, Tcl_Size uniLength, Tcl_DString *dsPtr); /* 647 */
     int * (*tcl_UtfToUniCharDString) (const char *src, Tcl_Size length, Tcl_DString *dsPtr); /* 648 */
-    unsigned char * (*tclGetBytesFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *numBytesPtr); /* 649 */
+    unsigned char * (*tclGetBytesFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, void *numBytesPtr); /* 649 */
     unsigned char * (*tcl_GetBytesFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Size *numBytesPtr); /* 650 */
     char * (*tcl_GetStringFromObj) (Tcl_Obj *objPtr, Tcl_Size *lengthPtr); /* 651 */
     Tcl_UniChar * (*tcl_GetUnicodeFromObj) (Tcl_Obj *objPtr, Tcl_Size *lengthPtr); /* 652 */
@@ -4040,15 +4041,15 @@ extern const TclStubs *tclStubsPtr;
 #   if TCL_MAJOR_VERSION < 9 || !defined(TCL_NO_DEPRECATED)
 #	define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) \
 		(sizeof(*(sizePtr)) <= sizeof(int) ? \
-			tclStubsPtr->tclGetBytesFromObj(interp, objPtr, (int *)(void *)(sizePtr)) : \
+			tclStubsPtr->tclGetBytesFromObj(interp, objPtr, (sizePtr)) : \
 			tclStubsPtr->tcl_GetBytesFromObj(interp, objPtr, (Tcl_Size *)(void *)(sizePtr)))
 #	define Tcl_GetStringFromObj(objPtr, sizePtr) \
 		(sizeof(*(sizePtr)) <= sizeof(int) ? \
-			tclStubsPtr->tclGetStringFromObj(objPtr, (int *)(void *)(sizePtr)) : \
+			tclStubsPtr->tclGetStringFromObj(objPtr, (sizePtr)) : \
 			tclStubsPtr->tcl_GetStringFromObj(objPtr, (Tcl_Size *)(void *)(sizePtr)))
 #	define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \
 		(sizeof(*(sizePtr)) <= sizeof(int) ? \
-			tclStubsPtr->tclGetUnicodeFromObj(objPtr, (int *)(void *)(sizePtr)) : \
+			tclStubsPtr->tclGetUnicodeFromObj(objPtr, (sizePtr)) : \
 			tclStubsPtr->tcl_GetUnicodeFromObj(objPtr, (Tcl_Size *)(void *)(sizePtr)))
 #   endif
 #define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \
@@ -4063,18 +4064,18 @@ extern const TclStubs *tclStubsPtr;
 #if TCL_MAJOR_VERSION > 8
 #define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \
 	(sizeof(*(sizePtr)) <= sizeof(int) ? \
-		tclStubsPtr->tclGetBytesFromObj(NULL, objPtr, (int *)(void *)(sizePtr)) : \
+		tclStubsPtr->tclGetBytesFromObj(NULL, objPtr, (sizePtr)) : \
 		tclStubsPtr->tcl_GetBytesFromObj(NULL, objPtr, (Tcl_Size *)(void *)(sizePtr)))
 #else
 #define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \
 	(sizeof(*(sizePtr)) <= sizeof(int) ? \
-		tclStubsPtr->tclGetByteArrayFromObj(objPtr, (int *)(void *)(sizePtr)) : \
+		tclStubsPtr->tclGetByteArrayFromObj(objPtr, (sizePtr)) : \
 		tclStubsPtr->tcl_GetByteArrayFromObj(objPtr, (Tcl_Size *)(void *)(sizePtr)))
 #endif
 #else
 #define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) \
 	(sizeof(*(sizePtr)) <= sizeof(int) ? \
-		TclGetBytesFromObj(interp, objPtr, (int *)(void *)(sizePtr)) : \
+		TclGetBytesFromObj(interp, objPtr, (sizePtr)) : \
 		(Tcl_GetBytesFromObj)(interp, objPtr, (Tcl_Size *)(void *)(sizePtr)))
 #define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \
 	((Tcl_GetIndexFromObjStruct)((interp), (objPtr), (tablePtr), (offset), (msg), \
@@ -4087,15 +4088,15 @@ extern const TclStubs *tclStubsPtr;
 	Tcl_GetBool(interp, src, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr)))
 #define Tcl_GetStringFromObj(objPtr, sizePtr) \
 	(sizeof(*(sizePtr)) <= sizeof(int) ? \
-		TclGetStringFromObj(objPtr, (int *)(void *)(sizePtr)) : \
+		TclGetStringFromObj(objPtr, (sizePtr)) : \
 		(Tcl_GetStringFromObj)(objPtr, (Tcl_Size *)(void *)(sizePtr)))
 #define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \
 	(sizeof(*(sizePtr)) <= sizeof(int) ? \
-		TclGetBytesFromObj(NULL, objPtr, (int *)(void *)(sizePtr)) : \
+		TclGetBytesFromObj(NULL, objPtr, (sizePtr)) : \
 		(Tcl_GetBytesFromObj)(NULL, objPtr, (Tcl_Size *)(void *)(sizePtr)))
 #define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \
 	(sizeof(*(sizePtr)) <= sizeof(int) ? \
-		TclGetUnicodeFromObj(objPtr, (int *)(void *)(sizePtr)) : \
+		TclGetUnicodeFromObj(objPtr, (sizePtr)) : \
 		(Tcl_GetUnicodeFromObj)(objPtr, (Tcl_Size *)(void *)(sizePtr)))
 #endif
 
@@ -4168,34 +4169,36 @@ extern const TclStubs *tclStubsPtr;
 #   define Tcl_WCharLen (sizeof(wchar_t) != sizeof(short) \
 		? (Tcl_Size (*)(wchar_t *))tclStubsPtr->tcl_UniCharLen \
 		: (Tcl_Size (*)(wchar_t *))Tcl_Char16Len)
+#if TCL_MAJOR_VERSION < 9 || !defined(TCL_NO_DEPRECATED)
 #   undef Tcl_ListObjGetElements
 #   define Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr) (sizeof(*(objcPtr)) == sizeof(int) \
-		? tclStubsPtr->tclListObjGetElements((interp), (listPtr), (int *)(void *)(objcPtr), (objvPtr)) \
+		? tclStubsPtr->tclListObjGetElements((interp), (listPtr), (objcPtr), (objvPtr)) \
 		: tclStubsPtr->tcl_ListObjGetElements((interp), (listPtr), (Tcl_Size *)(void *)(objcPtr), (objvPtr)))
 #   undef Tcl_ListObjLength
 #   define Tcl_ListObjLength(interp, listPtr, lengthPtr) (sizeof(*(lengthPtr)) == sizeof(int) \
-		? tclStubsPtr->tclListObjLength((interp), (listPtr), (int *)(void *)(lengthPtr)) \
+		? tclStubsPtr->tclListObjLength((interp), (listPtr), (lengthPtr)) \
 		: tclStubsPtr->tcl_ListObjLength((interp), (listPtr), (Tcl_Size *)(void *)(lengthPtr)))
 #   undef Tcl_DictObjSize
 #   define Tcl_DictObjSize(interp, dictPtr, sizePtr) (sizeof(*(sizePtr)) == sizeof(int) \
-		? tclStubsPtr->tclDictObjSize((interp), (dictPtr), (int *)(void *)(sizePtr)) \
+		? tclStubsPtr->tclDictObjSize((interp), (dictPtr), (sizePtr)) \
 		: tclStubsPtr->tcl_DictObjSize((interp), (dictPtr), (Tcl_Size *)(void *)(sizePtr)))
 #   undef Tcl_SplitList
 #   define Tcl_SplitList(interp, listStr, argcPtr, argvPtr) (sizeof(*(argcPtr)) == sizeof(int) \
-		? tclStubsPtr->tclSplitList((interp), (listStr), (int *)(void *)(argcPtr), (argvPtr)) \
+		? tclStubsPtr->tclSplitList((interp), (listStr), (argcPtr), (argvPtr)) \
 		: tclStubsPtr->tcl_SplitList((interp), (listStr), (Tcl_Size *)(void *)(argcPtr), (argvPtr)))
 #   undef Tcl_SplitPath
 #   define Tcl_SplitPath(path, argcPtr, argvPtr) (sizeof(*(argcPtr)) == sizeof(int) \
-		? tclStubsPtr->tclSplitPath((path), (int *)(void *)(argcPtr), (argvPtr)) \
+		? tclStubsPtr->tclSplitPath((path), (argcPtr), (argvPtr)) \
 		: tclStubsPtr->tcl_SplitPath((path), (Tcl_Size *)(void *)(argcPtr), (argvPtr)))
 #   undef Tcl_FSSplitPath
 #   define Tcl_FSSplitPath(pathPtr, lenPtr) (sizeof(*(lenPtr)) == sizeof(int) \
-		? tclStubsPtr->tclFSSplitPath((pathPtr), (int *)(void *)(lenPtr)) \
+		? tclStubsPtr->tclFSSplitPath((pathPtr), (lenPtr)) \
 		: tclStubsPtr->tcl_FSSplitPath((pathPtr), (Tcl_Size *)(void *)(lenPtr)))
 #   undef Tcl_ParseArgsObjv
 #   define Tcl_ParseArgsObjv(interp, argTable, objcPtr, objv, remObjv) (sizeof(*(objcPtr)) == sizeof(int) \
-		? tclStubsPtr->tclParseArgsObjv((interp), (argTable), (int *)(void *)(objcPtr), (objv), (remObjv)) \
+		? tclStubsPtr->tclParseArgsObjv((interp), (argTable), (objcPtr), (objv), (remObjv)) \
 		: tclStubsPtr->tcl_ParseArgsObjv((interp), (argTable), (Tcl_Size *)(void *)(objcPtr), (objv), (remObjv)))
+#endif /* TCL_MAJOR_VERSION < 9 || !defined(TCL_NO_DEPRECATED) */
 #else
 #   define Tcl_WCharToUtfDString (sizeof(wchar_t) != sizeof(short) \
 		? (char *(*)(const wchar_t *, Tcl_Size, Tcl_DString *))Tcl_UniCharToUtfDString \
@@ -4211,25 +4214,25 @@ extern const TclStubs *tclStubsPtr;
 		: (Tcl_Size (*)(wchar_t *))Tcl_Char16Len)
 #if !defined(BUILD_tcl) && !defined(TCL_NO_DEPRECATED)
 #   define Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr) (sizeof(*(objcPtr)) == sizeof(int) \
-		? TclListObjGetElements((interp), (listPtr), (int *)(void *)(objcPtr), (objvPtr)) \
+		? TclListObjGetElements((interp), (listPtr), (objcPtr), (objvPtr)) \
 		: (Tcl_ListObjGetElements)((interp), (listPtr), (Tcl_Size *)(void *)(objcPtr), (objvPtr)))
 #   define Tcl_ListObjLength(interp, listPtr, lengthPtr) (sizeof(*(lengthPtr)) == sizeof(int) \
-		? TclListObjLength((interp), (listPtr), (int *)(void *)(lengthPtr)) \
+		? TclListObjLength((interp), (listPtr), (lengthPtr)) \
 		: (Tcl_ListObjLength)((interp), (listPtr), (Tcl_Size *)(void *)(lengthPtr)))
 #   define Tcl_DictObjSize(interp, dictPtr, sizePtr) (sizeof(*(sizePtr)) == sizeof(int) \
-		? TclDictObjSize((interp), (dictPtr), (int *)(void *)(sizePtr)) \
+		? TclDictObjSize((interp), (dictPtr), (sizePtr)) \
 		: (Tcl_DictObjSize)((interp), (dictPtr), (Tcl_Size *)(void *)(sizePtr)))
 #   define Tcl_SplitList(interp, listStr, argcPtr, argvPtr) (sizeof(*(argcPtr)) == sizeof(int) \
-		? TclSplitList((interp), (listStr), (int *)(void *)(argcPtr), (argvPtr)) \
+		? TclSplitList((interp), (listStr), (argcPtr), (argvPtr)) \
 		: (Tcl_SplitList)((interp), (listStr), (Tcl_Size *)(void *)(argcPtr), (argvPtr)))
 #   define Tcl_SplitPath(path, argcPtr, argvPtr) (sizeof(*(argcPtr)) == sizeof(int) \
-		? TclSplitPath((path), (int *)(void *)(argcPtr), (argvPtr)) \
+		? TclSplitPath((path), (argcPtr), (argvPtr)) \
 		: (Tcl_SplitPath)((path), (Tcl_Size *)(void *)(argcPtr), (argvPtr)))
 #   define Tcl_FSSplitPath(pathPtr, lenPtr) (sizeof(*(lenPtr)) == sizeof(int) \
-		? TclFSSplitPath((pathPtr), (int *)(void *)(lenPtr)) \
+		? TclFSSplitPath((pathPtr), (lenPtr)) \
 		: (Tcl_FSSplitPath)((pathPtr), (Tcl_Size *)(void *)(lenPtr)))
 #   define Tcl_ParseArgsObjv(interp, argTable, objcPtr, objv, remObjv) (sizeof(*(objcPtr)) == sizeof(int) \
-		? TclParseArgsObjv((interp), (argTable), (int *)(void *)(objcPtr), (objv), (remObjv)) \
+		? TclParseArgsObjv((interp), (argTable), (objcPtr), (objv), (remObjv)) \
 		: (Tcl_ParseArgsObjv)((interp), (argTable), (Tcl_Size *)(void *)(objcPtr), (objv), (remObjv)))
 #endif /* !defined(BUILD_tcl) */
 #endif

generic/tclEncoding.c

@@ -10,7 +10,6 @@
  */
 
 #include "tclInt.h"
-#include "tclIO.h"
 
 typedef size_t (LengthProc)(const char *src);
 
@@ -200,16 +199,16 @@ static struct TclEncodingProfiles {
     {"tcl8", TCL_ENCODING_PROFILE_TCL8},
 };
 #define PROFILE_TCL8(flags_)                                           \
-    ((CHANNEL_PROFILE_GET(flags_) == TCL_ENCODING_PROFILE_TCL8)   \
-     || (CHANNEL_PROFILE_GET(flags_) == 0                         \
+    ((ENCODING_PROFILE_GET(flags_) == TCL_ENCODING_PROFILE_TCL8)   \
+     || (ENCODING_PROFILE_GET(flags_) == 0                         \
 	 && TCL_ENCODING_PROFILE_DEFAULT == TCL_ENCODING_PROFILE_TCL8))
 #define PROFILE_STRICT(flags_)                                         \
-    ((CHANNEL_PROFILE_GET(flags_) == TCL_ENCODING_PROFILE_STRICT) \
-     || (CHANNEL_PROFILE_GET(flags_) == 0                         \
+    ((ENCODING_PROFILE_GET(flags_) == TCL_ENCODING_PROFILE_STRICT) \
+     || (ENCODING_PROFILE_GET(flags_) == 0                         \
 	 && TCL_ENCODING_PROFILE_DEFAULT == TCL_ENCODING_PROFILE_STRICT))
 #define PROFILE_REPLACE(flags_)                                         \
-    ((CHANNEL_PROFILE_GET(flags_) == TCL_ENCODING_PROFILE_REPLACE) \
-     || (CHANNEL_PROFILE_GET(flags_) == 0                          \
+    ((ENCODING_PROFILE_GET(flags_) == TCL_ENCODING_PROFILE_REPLACE) \
+     || (ENCODING_PROFILE_GET(flags_) == 0                          \
 	 && TCL_ENCODING_PROFILE_DEFAULT == TCL_ENCODING_PROFILE_REPLACE))
 
 #define UNICODE_REPLACE_CHAR ((Tcl_UniChar)0xFFFD)
@@ -2532,7 +2531,17 @@ UtfToUtfProc(
     flags |= PTR2INT(clientData);
     dstEnd = dst + dstLen - ((flags & ENCODING_UTF) ? TCL_UTF_MAX : 6);
 
-    profile = CHANNEL_PROFILE_GET(flags);
+
+#if TCL_UTF_MAX < 4
+    /* Initialize the buffer so that some random data doesn't trick
+     * Tcl_UniCharToUtf() into thinking it should combine surrogate pairs.
+     * Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its
+     * prior non-stateful nature, this call to memset can also be removed.
+     */
+    memset(dst, 0xff, dstLen);
+#endif
+
+    profile = ENCODING_PROFILE_GET(flags);
     for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) {
 
 	if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) {
@@ -2746,6 +2755,15 @@ Utf32ToUtfProc(
     }
     result = TCL_OK;
 
+#if TCL_UTF_MAX < 4
+    /* Initialize the buffer so that some random data doesn't trick
+     * Tcl_UniCharToUtf() into thinking it should combine surrogate pairs.
+     * Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its
+     * prior non-stateful nature, this call to memset can also be removed.
+     */
+    memset(dst, 0xff, dstLen);
+#endif
+
     /*
      * Check alignment with utf-32 (4 == sizeof(UTF-32))
      */
@@ -3015,6 +3033,15 @@ Utf16ToUtfProc(
     }
     result = TCL_OK;
 
+#if TCL_UTF_MAX < 4
+    /* Initialize the buffer so that some random data doesn't trick
+     * Tcl_UniCharToUtf() into thinking it should combine surrogate pairs.
+     * Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its
+     * prior non-stateful nature, this call to memset can also be removed.
+     */
+    memset(dst, 0xff, dstLen);
+#endif
+
     /*
      * Check alignment with utf-16 (2 == sizeof(UTF-16))
      */
@@ -3428,6 +3455,15 @@ TableToUtfProc(
     dstStart = dst;
     dstEnd = dst + dstLen - TCL_UTF_MAX;
 
+#if TCL_UTF_MAX < 4
+    /* Initialize the buffer so that some random data doesn't trick
+     * Tcl_UniCharToUtf() into thinking it should combine surrogate pairs.
+     * Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its
+     * prior non-stateful nature, this call to memset can also be removed.
+     */
+    memset(dst, 0xff, dstLen);
+#endif
+
     toUnicode = (const unsigned short *const *) dataPtr->toUnicode;
     prefixBytes = dataPtr->prefixBytes;
     pageZero = toUnicode[0];
@@ -3669,6 +3705,15 @@ Iso88591ToUtfProc(
     dstStart = dst;
     dstEnd = dst + dstLen - TCL_UTF_MAX;
 
+#if TCL_UTF_MAX < 4
+    /* Initialize the buffer so that some random data doesn't trick
+     * Tcl_UniCharToUtf() into thinking it should combine surrogate pairs.
+     * Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its
+     * prior non-stateful nature, this call to memset can also be removed.
+     */
+    memset(dst, 0xff, dstLen);
+#endif
+
     result = TCL_OK;
     for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) {
 	Tcl_UniChar ch = 0;
@@ -3908,6 +3953,15 @@ EscapeToUtfProc(
     dstStart = dst;
     dstEnd = dst + dstLen - TCL_UTF_MAX;
 
+#if TCL_UTF_MAX < 4
+    /* Initialize the buffer so that some random data doesn't trick
+     * Tcl_UniCharToUtf() into thinking it should combine surrogate pairs.
+     * Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its
+     * prior non-stateful nature, this call to memset can also be removed.
+     */
+    memset(dst, 0xff, dstLen);
+#endif
+
     state = PTR2INT(*statePtr);
     if (flags & TCL_ENCODING_START) {
 	state = 0;
@@ -4587,9 +4641,9 @@ TclEncodingProfileIdToName(
 int TclEncodingSetProfileFlags(int flags)
 {
     if (flags & TCL_ENCODING_STOPONERROR) {
-	CHANNEL_PROFILE_SET(flags, TCL_ENCODING_PROFILE_STRICT);
+	ENCODING_PROFILE_SET(flags, TCL_ENCODING_PROFILE_STRICT);
     } else {
-	int profile = CHANNEL_PROFILE_GET(flags);
+	int profile = ENCODING_PROFILE_GET(flags);
 	switch (profile) {
 	case TCL_ENCODING_PROFILE_TCL8:
 	case TCL_ENCODING_PROFILE_STRICT:
@@ -4597,7 +4651,7 @@ int TclEncodingSetProfileFlags(int flags)
 	    break;
 	case 0: /* Unspecified by caller */
 	default:
-	    CHANNEL_PROFILE_SET(flags, TCL_ENCODING_PROFILE_DEFAULT);
+	    ENCODING_PROFILE_SET(flags, TCL_ENCODING_PROFILE_DEFAULT);
 	    break;
 	}
     }

generic/tclExecute.c

@@ -981,10 +981,10 @@ GrowEvaluationStack(
 {
     ExecStack *esPtr = eePtr->execStackPtr, *oldPtr = NULL;
     size_t newBytes;
-    int growth = growth1;
-    int newElems, currElems, needed = growth - (esPtr->endPtr - esPtr->tosPtr);
+    Tcl_Size growth = growth1;
+    Tcl_Size newElems, currElems, needed = growth - (esPtr->endPtr - esPtr->tosPtr);
     Tcl_Obj **markerPtr = esPtr->markerPtr, **memStart;
-    int moveWords = 0;
+    Tcl_Size moveWords = 0;
 
     if (move) {
 	if (!markerPtr) {
@@ -2825,8 +2825,12 @@ TEBCresume(
 
 	pc += pcAdjustment;
 	TEBC_YIELD();
-	return TclNREvalObjv(interp, objc, objv,
+	if (objc > INT_MAX) {
+	    return TclCommandWordLimitError(interp, objc);
+	} else {
+	    return TclNREvalObjv(interp, objc, objv,
 		TCL_EVAL_NOERR | TCL_EVAL_SOURCE_IN_FRAME, NULL);
+	}
 
     case INST_INVOKE_REPLACE:
 	objc = TclGetUInt4AtPtr(pc+1);
@@ -5272,7 +5276,7 @@ TEBCresume(
 	    TclNewObj(objResultPtr);
 	} else if (TclIsPureByteArray(valuePtr)) {
 	    objResultPtr = Tcl_NewByteArrayObj(
-		    Tcl_GetByteArrayFromObj(valuePtr, (size_t *)NULL)+index, 1);
+		    Tcl_GetByteArrayFromObj(valuePtr, (Tcl_Size *)NULL)+index, 1);
 	} else if (valuePtr->bytes && slength == valuePtr->length) {
 	    objResultPtr = Tcl_NewStringObj((const char *)
 		    valuePtr->bytes+index, 1);
@@ -5488,7 +5492,7 @@ TEBCresume(
 	NEXT_INST_F(1, 2, 1);
 
     case INST_STR_FIND_LAST:
-	objResultPtr = TclStringLast(OBJ_UNDER_TOS, OBJ_AT_TOS, INT_MAX - 1);
+	objResultPtr = TclStringLast(OBJ_UNDER_TOS, OBJ_AT_TOS, TCL_SIZE_MAX - 1);
 
 	TRACE(("%.20s %.20s => %s\n",
 		O2S(OBJ_UNDER_TOS), O2S(OBJ_AT_TOS), O2S(objResultPtr)));
@@ -5536,7 +5540,7 @@ TEBCresume(
 		    nocase);
 	} else if (TclIsPureByteArray(valuePtr) && TclIsPureByteArray(value2Ptr) && !nocase) {
 	    unsigned char *bytes1, *bytes2;
-	    size_t wlen1 = 0, wlen2 = 0;
+	    Tcl_Size wlen1 = 0, wlen2 = 0;
 
 	    bytes1 = Tcl_GetByteArrayFromObj(valuePtr, &wlen1);
 	    bytes2 = Tcl_GetByteArrayFromObj(value2Ptr, &wlen2);

generic/tclIO.c

@@ -223,8 +223,8 @@ static void		StopCopy(CopyState *csPtr);
 static void		TranslateInputEOL(ChannelState *statePtr, char *dst,
 			    const char *src, int *dstLenPtr, int *srcLenPtr);
 static void		UpdateInterest(Channel *chanPtr);
-static int		Write(Channel *chanPtr, const char *src,
-			    int srcLen, Tcl_Encoding encoding);
+static Tcl_Size		Write(Channel *chanPtr, const char *src,
+			    Tcl_Size srcLen, Tcl_Encoding encoding);
 static Tcl_Obj *	FixLevelCode(Tcl_Obj *msg);
 static void		SpliceChannel(Tcl_Channel chan);
 static void		CutChannel(Tcl_Channel chan);
@@ -1679,11 +1679,11 @@ Tcl_CreateChannel(
     statePtr->encoding = Tcl_GetEncoding(NULL, name);
     statePtr->inputEncodingState  = NULL;
     statePtr->inputEncodingFlags  = TCL_ENCODING_START;
-    CHANNEL_PROFILE_SET(statePtr->inputEncodingFlags,
+    ENCODING_PROFILE_SET(statePtr->inputEncodingFlags,
 			     TCL_ENCODING_PROFILE_DEFAULT);
     statePtr->outputEncodingState = NULL;
     statePtr->outputEncodingFlags = TCL_ENCODING_START;
-    CHANNEL_PROFILE_SET(statePtr->outputEncodingFlags,
+    ENCODING_PROFILE_SET(statePtr->outputEncodingFlags,
 			     TCL_ENCODING_PROFILE_DEFAULT);
 
     /*
@@ -4240,6 +4240,7 @@ Tcl_WriteObj(
     Channel *chanPtr;
     ChannelState *statePtr;	/* State info for channel */
     const char *src;
+    Tcl_Size srcLen = 0;
 
     statePtr = ((Channel *) chan)->state;
     chanPtr = statePtr->topChanPtr;
@@ -4247,34 +4248,21 @@ Tcl_WriteObj(
     if (CheckChannelErrors(statePtr, TCL_WRITABLE) != 0) {
 	return TCL_INDEX_NONE;
     }
-
-    Tcl_Size srcLen;
     if (statePtr->encoding == NULL) {
+	Tcl_Size result;
+
 	src = (char *) Tcl_GetByteArrayFromObj(objPtr, &srcLen);
 	if (src == NULL) {
 	    Tcl_SetErrno(EILSEQ);
-	    return TCL_INDEX_NONE;
+	    result = TCL_INDEX_NONE;
+	} else {
+	    result = WriteBytes(chanPtr, src, srcLen);
 	}
+	return result;
     } else {
 	src = Tcl_GetStringFromObj(objPtr, &srcLen);
+	return WriteChars(chanPtr, src, srcLen);
     }
-
-    size_t totalWritten = 0;
-    /*
-     * Note original code always called WriteChars even if srcLen 0
-     * so we will too.
-     */
-    do {
-	int chunkSize = srcLen > INT_MAX ? INT_MAX : srcLen;
-	int written;
-	written = WriteChars(chanPtr, src, chunkSize);
-	if (written < 0) {
-	    return TCL_INDEX_NONE;
-	}
-	totalWritten += written;
-	srcLen -= chunkSize;
-    } while (srcLen);
-    return totalWritten;
 }
 
 static void
@@ -4345,17 +4333,18 @@ WillRead(
  *----------------------------------------------------------------------
  */
 
-static int
+static Tcl_Size
 Write(
     Channel *chanPtr,		/* The channel to buffer output for. */
     const char *src,		/* UTF-8 string to write. */
-    int srcLen,			/* Length of UTF-8 string in bytes. */
+    Tcl_Size srcLen,            /* Length of UTF-8 string in bytes. */
     Tcl_Encoding encoding)
 {
     ChannelState *statePtr = chanPtr->state;
 				/* State info for channel */
     char *nextNewLine = NULL;
-    int endEncoding, saved = 0, total = 0, flushed = 0, needNlFlush = 0;
+    int endEncoding, needNlFlush = 0;
+    Tcl_Size saved = 0, total = 0, flushed = 0;
     char safe[BUFFER_PADDING];
     int encodingError = 0;
 
@@ -4368,7 +4357,6 @@ Write(
      */
 
     endEncoding = ((statePtr->outputEncodingFlags & TCL_ENCODING_END) != 0);
-
     if (GotFlag(statePtr, CHANNEL_LINEBUFFERED)
 	    || (statePtr->outputTranslation != TCL_TRANSLATE_LF)) {
 	nextNewLine = (char *)memchr(src, '\n', srcLen);
@@ -4377,7 +4365,8 @@ Write(
     while (srcLen + saved + endEncoding > 0 && !encodingError) {
 	ChannelBuffer *bufPtr;
 	char *dst;
-	int result, srcRead, dstLen, dstWrote, srcLimit = srcLen;
+        int result, srcRead, dstLen, dstWrote;
+        Tcl_Size srcLimit = srcLen;
 
 	if (nextNewLine) {
 	    srcLimit = nextNewLine - src;
@@ -4649,7 +4638,7 @@ Tcl_GetsObj(
     if (statePtr->encoding == GetBinaryEncoding()
 	    && ((statePtr->inputTranslation == TCL_TRANSLATE_LF)
 		    || (statePtr->inputTranslation == TCL_TRANSLATE_CR))
-	    && Tcl_GetByteArrayFromObj(objPtr, (size_t *)NULL) != NULL) {
+	    && Tcl_GetByteArrayFromObj(objPtr, (Tcl_Size *)NULL) != NULL) {
 	return TclGetsObjBinary(chan, objPtr);
     }
 
@@ -5990,7 +5979,7 @@ DoReadChars(
 	    && (statePtr->inEofChar == '\0');
 
     if (appendFlag) {
-	if (binaryMode && (NULL == Tcl_GetByteArrayFromObj(objPtr, (size_t *)NULL))) {
+	if (binaryMode && (NULL == Tcl_GetByteArrayFromObj(objPtr, (Tcl_Size *)NULL))) {
 	    binaryMode = 0;
 	}
     } else {
@@ -7985,7 +7974,7 @@ Tcl_GetChannelOption(
 	    Tcl_DStringAppendElement(dsPtr, "-profile");
 	}
 	/* Note currently input and output profiles are same */
-	profile = CHANNEL_PROFILE_GET(statePtr->inputEncodingFlags);
+	profile = ENCODING_PROFILE_GET(statePtr->inputEncodingFlags);
 	profileName = TclEncodingProfileIdToName(interp, profile);
 	if (profileName == NULL) {
 	    return TCL_ERROR;
@@ -8180,11 +8169,11 @@ Tcl_SetChannelOption(
 
 	if ((newValue[0] == '\0') || (strcmp(newValue, "binary") == 0)) {
 	    encoding = Tcl_GetEncoding(NULL, "iso8859-1");
-	    CHANNEL_PROFILE_SET(statePtr->inputEncodingFlags
-		    ,CHANNEL_PROFILE_GET(statePtr->inputEncodingFlags)
+	    ENCODING_PROFILE_SET(statePtr->inputEncodingFlags
+		    ,ENCODING_PROFILE_GET(statePtr->inputEncodingFlags)
 			|TCL_ENCODING_PROFILE_STRICT);
-	    CHANNEL_PROFILE_SET(statePtr->outputEncodingFlags
-		    ,CHANNEL_PROFILE_GET(statePtr->outputEncodingFlags)
+	    ENCODING_PROFILE_SET(statePtr->outputEncodingFlags
+		    ,ENCODING_PROFILE_GET(statePtr->outputEncodingFlags)
 			|TCL_ENCODING_PROFILE_STRICT);
 	} else {
 	    encoding = Tcl_GetEncoding(interp, newValue);
@@ -8207,12 +8196,12 @@ Tcl_SetChannelOption(
 	Tcl_FreeEncoding(statePtr->encoding);
 	statePtr->encoding = encoding;
 	statePtr->inputEncodingState = NULL;
-	profile = CHANNEL_PROFILE_GET(statePtr->inputEncodingFlags);
+	profile = ENCODING_PROFILE_GET(statePtr->inputEncodingFlags);
 	statePtr->inputEncodingFlags = TCL_ENCODING_START;
-	CHANNEL_PROFILE_SET(statePtr->inputEncodingFlags, profile);
+	ENCODING_PROFILE_SET(statePtr->inputEncodingFlags, profile);
 	statePtr->outputEncodingState = NULL;
 	statePtr->outputEncodingFlags = TCL_ENCODING_START;
-	CHANNEL_PROFILE_SET(statePtr->outputEncodingFlags, profile); /* Same as input */
+	ENCODING_PROFILE_SET(statePtr->outputEncodingFlags, profile); /* Same as input */
 	ResetFlag(statePtr, CHANNEL_NEED_MORE_DATA|CHANNEL_ENCODING_ERROR);
 	UpdateInterest(chanPtr);
 	return TCL_OK;
@@ -8255,8 +8244,8 @@ Tcl_SetChannelOption(
 	if (TclEncodingProfileNameToId(interp, newValue, &profile) != TCL_OK) {
 	    return TCL_ERROR;
 	}
-	CHANNEL_PROFILE_SET(statePtr->inputEncodingFlags, profile);
-	CHANNEL_PROFILE_SET(statePtr->outputEncodingFlags, profile);
+	ENCODING_PROFILE_SET(statePtr->inputEncodingFlags, profile);
+	ENCODING_PROFILE_SET(statePtr->outputEncodingFlags, profile);
 	ResetFlag(statePtr, CHANNEL_NEED_MORE_DATA|CHANNEL_ENCODING_ERROR);
 	return TCL_OK;
     } else if (HaveOpt(1, "-translation")) {
@@ -8294,11 +8283,11 @@ Tcl_SetChannelOption(
 		statePtr->inEofChar = 0;
 		Tcl_FreeEncoding(statePtr->encoding);
 		statePtr->encoding = Tcl_GetEncoding(NULL, "iso8859-1");
-		CHANNEL_PROFILE_SET(statePtr->inputEncodingFlags
-			,CHANNEL_PROFILE_GET(statePtr->inputEncodingFlags)
+		ENCODING_PROFILE_SET(statePtr->inputEncodingFlags
+			,ENCODING_PROFILE_GET(statePtr->inputEncodingFlags)
 			    |TCL_ENCODING_PROFILE_STRICT);
-		CHANNEL_PROFILE_SET(statePtr->outputEncodingFlags
-			,CHANNEL_PROFILE_GET(statePtr->outputEncodingFlags)
+		ENCODING_PROFILE_SET(statePtr->outputEncodingFlags
+			,ENCODING_PROFILE_GET(statePtr->outputEncodingFlags)
 			    |TCL_ENCODING_PROFILE_STRICT);
 	    } else if (strcmp(readMode, "lf") == 0) {
 		translation = TCL_TRANSLATE_LF;
@@ -8349,11 +8338,11 @@ Tcl_SetChannelOption(
 		statePtr->outputTranslation = TCL_TRANSLATE_LF;
 		Tcl_FreeEncoding(statePtr->encoding);
 		statePtr->encoding = Tcl_GetEncoding(NULL, "iso8859-1");
-		CHANNEL_PROFILE_SET(statePtr->inputEncodingFlags
-			,CHANNEL_PROFILE_GET(statePtr->inputEncodingFlags)
+		ENCODING_PROFILE_SET(statePtr->inputEncodingFlags
+			,ENCODING_PROFILE_GET(statePtr->inputEncodingFlags)
 			    |TCL_ENCODING_PROFILE_STRICT);
-		CHANNEL_PROFILE_SET(statePtr->outputEncodingFlags
-			,CHANNEL_PROFILE_GET(statePtr->outputEncodingFlags)
+		ENCODING_PROFILE_SET(statePtr->outputEncodingFlags
+			,ENCODING_PROFILE_GET(statePtr->outputEncodingFlags)
 			    |TCL_ENCODING_PROFILE_STRICT);
 	    } else if (strcmp(writeMode, "lf") == 0) {
 		statePtr->outputTranslation = TCL_TRANSLATE_LF;
@@ -10280,8 +10269,8 @@ Lossless(
 	    (
 		toRead == -1
 		&& inStatePtr->encoding == outStatePtr->encoding
-		&& CHANNEL_PROFILE_GET(inStatePtr->inputEncodingFlags) == TCL_ENCODING_PROFILE_TCL8
-		&& CHANNEL_PROFILE_GET(outStatePtr->inputEncodingFlags) == TCL_ENCODING_PROFILE_TCL8
+		&& ENCODING_PROFILE_GET(inStatePtr->inputEncodingFlags) == TCL_ENCODING_PROFILE_TCL8
+		&& ENCODING_PROFILE_GET(outStatePtr->inputEncodingFlags) == TCL_ENCODING_PROFILE_TCL8
 	    )
 	);
 }

generic/tclIO.h

@@ -288,13 +288,6 @@ typedef struct ChannelState {
 #define CHANNEL_CLOSEDWRITE	(1<<21)	/* Channel write side has been closed.
 					 * No further Tcl-level write IO on
 					 * the channel is allowed. */
-#define CHANNEL_PROFILE_MASK     0xFF000000
-#define CHANNEL_PROFILE_GET(flags_)  ((flags_) & CHANNEL_PROFILE_MASK)
-#define CHANNEL_PROFILE_SET(flags_, profile_) \
-    do {                                           \
-	(flags_) &= ~CHANNEL_PROFILE_MASK;    \
-	(flags_) |= profile_;                      \
-    } while (0)
 
 /*
  * The length of time to wait between synthetic timer events. Must be zero or

generic/tclIOGT.c

@@ -375,7 +375,7 @@ ExecuteCallback(
 				 * interpreters. */
 {
     Tcl_Obj *resObj;		/* See below, switch (transmit). */
-    size_t resLen = 0;
+    Tcl_Size resLen = 0;
     unsigned char *resBuf;
     Tcl_InterpState state = NULL;
     int res = TCL_OK;

generic/tclIORTrans.c

@@ -264,7 +264,7 @@ struct ForwardParamTransform {
     ForwardParamBase base;	/* "Supertype". MUST COME FIRST. */
     char *buf;			/* I: Bytes to transform,
 				 * O: Bytes in transform result */
-    size_t size;		/* I: #bytes to transform,
+    Tcl_Size size;		/* I: #bytes to transform,
 				 * O: #bytes in the transform result */
 };
 struct ForwardParamLimit {
@@ -2562,7 +2562,7 @@ ForwardProc(
 	     * Sent it back to the request originator.
 	     */
 
-	    size_t bytec = 0;	/* Number of returned bytes */
+	    Tcl_Size bytec = 0;	/* Number of returned bytes */
 	    unsigned char *bytev;
 				/* Array of returned bytes */
 
@@ -2596,7 +2596,7 @@ ForwardProc(
 	     * Sent it back to the request originator.
 	     */
 
-	    size_t bytec = 0;	/* Number of returned bytes */
+	    Tcl_Size bytec = 0;	/* Number of returned bytes */
 	    unsigned char *bytev;
 				/* Array of returned bytes */
 
@@ -2626,7 +2626,7 @@ ForwardProc(
 	     * Sent it back to the request originator.
 	     */
 
-	    size_t bytec = 0;	/* Number of returned bytes */
+	    Tcl_Size bytec = 0;	/* Number of returned bytes */
 	    unsigned char *bytev; /* Array of returned bytes */
 
 	    bytev = Tcl_GetByteArrayFromObj(resObj, &bytec);
@@ -2652,7 +2652,7 @@ ForwardProc(
 	     * Sent it back to the request originator.
 	     */
 
-	    size_t bytec = 0;	/* Number of returned bytes */
+	    Tcl_Size bytec = 0;	/* Number of returned bytes */
 	    unsigned char *bytev;
 				/* Array of returned bytes */
 
@@ -3045,7 +3045,7 @@ TransformRead(
     Tcl_Obj *bufObj)
 {
     Tcl_Obj *resObj;
-    size_t bytec = 0;		/* Number of returned bytes */
+    Tcl_Size bytec = 0;		/* Number of returned bytes */
     unsigned char *bytev;	/* Array of returned bytes */
 
     /*
@@ -3100,7 +3100,7 @@ TransformWrite(
 {
     Tcl_Obj *bufObj;
     Tcl_Obj *resObj;
-    size_t bytec = 0;		/* Number of returned bytes */
+    Tcl_Size bytec = 0;		/* Number of returned bytes */
     unsigned char *bytev;	/* Array of returned bytes */
     int res;
 
@@ -3167,7 +3167,7 @@ TransformDrain(
     int *errorCodePtr)
 {
     Tcl_Obj *resObj;
-    size_t bytec = 0;		/* Number of returned bytes */
+    Tcl_Size bytec = 0;		/* Number of returned bytes */
     unsigned char *bytev;	/* Array of returned bytes */
 
     /*
@@ -3216,7 +3216,7 @@ TransformFlush(
     int op)
 {
     Tcl_Obj *resObj;
-    size_t bytec = 0;		/* Number of returned bytes */
+    Tcl_Size bytec = 0;		/* Number of returned bytes */
     unsigned char *bytev;	/* Array of returned bytes */
     int res;
 

generic/tclInt.h

@@ -2451,16 +2451,6 @@ typedef enum TclEolTranslation {
 #define TCL_INVOKE_NO_UNKNOWN	(1<<1)
 #define TCL_INVOKE_NO_TRACEBACK	(1<<2)
 
-#if TCL_MAJOR_VERSION > 8
-/*
- * SSIZE_MAX, NOT SIZE_MAX as negative differences need to be expressed
- * between values of the Tcl_Size type so limit the range to signed
- */
-#   define ListSizeT_MAX ((Tcl_Size)PTRDIFF_MAX)
-#else
-#   define ListSizeT_MAX INT_MAX
-#endif
-
 /*
  * ListStore --
  *
@@ -2501,7 +2491,8 @@ typedef struct ListStore {
 
 /* Max number of elements that can be contained in a list */
 #define LIST_MAX                                               \
-    ((Tcl_Size)((ListSizeT_MAX - offsetof(ListStore, slots)) / sizeof(Tcl_Obj *)))
+    ((Tcl_Size)(((size_t)TCL_SIZE_MAX - offsetof(ListStore, slots)) \
+		   / sizeof(Tcl_Obj *)))
 /* Memory size needed for a ListStore to hold numSlots_ elements */
 #define LIST_SIZE(numSlots_) \
 	((Tcl_Size)(offsetof(ListStore, slots) + ((numSlots_) * sizeof(Tcl_Obj *))))
@@ -2864,6 +2855,22 @@ typedef struct ProcessGlobalValue {
 #define TCL_PARSE_NO_UNDERSCORE	128
 				/* Reject underscore digit separator */
 
+
+/*
+ *----------------------------------------------------------------------
+ * Internal convenience macros for manipulating encoding flags. See
+ * TCL_ENCODING_PROFILE_* in tcl.h
+ *----------------------------------------------------------------------
+ */
+
+#define ENCODING_PROFILE_MASK     0xFF000000
+#define ENCODING_PROFILE_GET(flags_)  ((flags_) & ENCODING_PROFILE_MASK)
+#define ENCODING_PROFILE_SET(flags_, profile_) \
+    do {                                       \
+	(flags_) &= ~ENCODING_PROFILE_MASK;    \
+	(flags_) |= profile_;                  \
+    } while (0)
+
 /*
  *----------------------------------------------------------------
  * Variables shared among Tcl modules but not used by the outside world.
@@ -3228,7 +3235,6 @@ MODULE_SCOPE Tcl_Obj *	TclGetHomeDirObj(Tcl_Interp *interp, const char *user);
 MODULE_SCOPE Tcl_Obj *	TclResolveTildePath(Tcl_Interp *interp,
 			    Tcl_Obj *pathObj);
 MODULE_SCOPE Tcl_Obj *	TclResolveTildePathList(Tcl_Obj *pathsObj);
-MODULE_SCOPE int	TclJoinThread(Tcl_ThreadId id, int *result);
 MODULE_SCOPE void	TclLimitRemoveAllHandlers(Tcl_Interp *interp);
 MODULE_SCOPE Tcl_Obj *	TclLindexList(Tcl_Interp *interp,
 			    Tcl_Obj *listPtr, Tcl_Obj *argPtr);
@@ -3356,7 +3362,6 @@ MODULE_SCOPE void	TclThreadStorageKeySet(Tcl_ThreadDataKey *keyPtr,
 			    void *data);
 MODULE_SCOPE TCL_NORETURN void TclpThreadExit(int status);
 MODULE_SCOPE void	TclRememberCondition(Tcl_Condition *mutex);
-MODULE_SCOPE void	TclRememberJoinableThread(Tcl_ThreadId id);
 MODULE_SCOPE void	TclRememberMutex(Tcl_Mutex *mutex);
 MODULE_SCOPE void	TclRemoveScriptLimitCallbacks(Tcl_Interp *interp);
 MODULE_SCOPE int	TclReToGlob(Tcl_Interp *interp, const char *reStr,
@@ -3375,7 +3380,6 @@ MODULE_SCOPE void	TclSetCmdNameObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
 MODULE_SCOPE void	TclSetDuplicateObj(Tcl_Obj *dupPtr, Tcl_Obj *objPtr);
 MODULE_SCOPE void	TclSetProcessGlobalValue(ProcessGlobalValue *pgvPtr,
 			    Tcl_Obj *newValue, Tcl_Encoding encoding);
-MODULE_SCOPE void	TclSignalExitThread(Tcl_ThreadId id, int result);
 MODULE_SCOPE void	TclSpellFix(Tcl_Interp *interp,
 			    Tcl_Obj *const *objv, Tcl_Size objc, Tcl_Size subIdx,
 			    Tcl_Obj *bad, Tcl_Obj *fix);
@@ -3386,7 +3390,7 @@ MODULE_SCOPE int	TclStringCmp(Tcl_Obj *value1Ptr, Tcl_Obj *value2Ptr,
 			    int checkEq, int nocase, Tcl_Size reqlength);
 MODULE_SCOPE int	TclStringCmpOpts(Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[], int *nocase,
-			    int *reqlength);
+			    Tcl_Size *reqlength);
 MODULE_SCOPE int	TclStringMatch(const char *str, Tcl_Size strLen,
 			    const char *pattern, int ptnLen, int flags);
 MODULE_SCOPE int	TclStringMatchObj(Tcl_Obj *stringObj,
@@ -4173,6 +4177,12 @@ MODULE_SCOPE int	TclIndexEncode(Tcl_Interp *interp, Tcl_Obj *objPtr,
 MODULE_SCOPE Tcl_Size	TclIndexDecode(int encoded, Tcl_Size endValue);
 MODULE_SCOPE int	TclIndexInvalidError(Tcl_Interp *interp,
 			    const char *idxType, Tcl_Size idx);
+
+/*
+ * Error message utility functions
+ */
+MODULE_SCOPE int TclCommandWordLimitError(Tcl_Interp *interp, Tcl_Size count);
+
 #endif /* TCL_MAJOR_VERSION > 8 */
 
 /* Constants used in index value encoding routines. */

generic/tclListObj.c

@@ -850,7 +850,19 @@ ListStoreReallocate (ListStore *storePtr, Tcl_Size numSlots)
     newCapacity = ListStoreUpSize(numSlots);
     newStorePtr =
 	(ListStore *)Tcl_AttemptRealloc(storePtr, LIST_SIZE(newCapacity));
+
+    /*
+     * In case above failed keep looping reducing the requested extra space
+     * by half every time.
+     */
+    while (newStorePtr == NULL && (newCapacity > (numSlots+1))) {
+	/* Because of loop condition newCapacity can't overflow */
+	newCapacity = numSlots + ((newCapacity - numSlots) / 2);
+	newStorePtr =
+	    (ListStore *)Tcl_AttemptRealloc(storePtr, LIST_SIZE(newCapacity));
+    }
     if (newStorePtr == NULL) {
+	/* Last resort - allcate what was asked */
 	newCapacity = numSlots;
 	newStorePtr = (ListStore *)Tcl_AttemptRealloc(storePtr,
 						    LIST_SIZE(newCapacity));
@@ -2025,7 +2037,7 @@ Tcl_ListObjLength(
     return TCL_OK;
 }
 
-Tcl_Size 
+Tcl_Size
 ListLength(Tcl_Obj *listPtr)
 {
     ListRep listRep;
@@ -2110,12 +2122,12 @@ Tcl_ListObjReplace(
     }
     if (numToDelete < 0) {
 	numToDelete = 0;
-    } else if (first > ListSizeT_MAX - numToDelete /* Handle integer overflow */
+    } else if (first > LIST_MAX - numToDelete /* Handle integer overflow */
              || origListLen < first + numToDelete) {
 	numToDelete = origListLen - first;
     }
 
-    if (numToInsert > ListSizeT_MAX - (origListLen - numToDelete)) {
+    if (numToInsert > LIST_MAX - (origListLen - numToDelete)) {
 	return ListLimitExceededError(interp);
     }
 
@@ -2576,7 +2588,7 @@ TclLindexList(
      * see TIP#22 and TIP#33 for the details.
      */
     if (!TclHasInternalRep(argObj, &tclListType.objType)
-	&& TclGetIntForIndexM(NULL, argObj, ListSizeT_MAX - 1, &index)
+	&& TclGetIntForIndexM(NULL, argObj, TCL_SIZE_MAX - 1, &index)
 	       == TCL_OK) {
 	/*
 	 * argPtr designates a single index.
@@ -2702,7 +2714,7 @@ TclLindexFlat(
 
 		while (++i < indexCount) {
 		    if (TclGetIntForIndexM(
-			    interp, indexArray[i], ListSizeT_MAX - 1, &index)
+			    interp, indexArray[i], TCL_SIZE_MAX - 1, &index)
 			!= TCL_OK) {
 			Tcl_DecrRefCount(sublistCopy);
 			return NULL;
@@ -2767,7 +2779,7 @@ TclLsetList(
      */
 
     if (!TclHasInternalRep(indexArgObj, &tclListType.objType)
-	&& TclGetIntForIndexM(NULL, indexArgObj, ListSizeT_MAX - 1, &index)
+	&& TclGetIntForIndexM(NULL, indexArgObj, TCL_SIZE_MAX - 1, &index)
 	       == TCL_OK) {
 	/* indexArgPtr designates a single index. */
         /* T:listrep-1.{2.1,12.1,15.1,19.1},2.{2.3,9.3,10.1,13.1,16.1}, 3.{4,5,6}.3 */

generic/tclLiteral.c

@@ -646,7 +646,7 @@ TclAddLiteralObj(
     if (litPtrPtr) {
 	*litPtrPtr = lPtr;
     }
-    
+
     return objIndex;
 }
 

generic/tclOO.h

@@ -63,7 +63,7 @@ typedef struct Tcl_ObjectContext_ *Tcl_ObjectContext;
 typedef int (Tcl_MethodCallProc)(void *clientData, Tcl_Interp *interp,
 	Tcl_ObjectContext objectContext, int objc, Tcl_Obj *const *objv);
 typedef int (Tcl_MethodCallProc2)(void *clientData, Tcl_Interp *interp,
-	Tcl_ObjectContext objectContext, ptrdiff_t objc, Tcl_Obj *const *objv);
+	Tcl_ObjectContext objectContext, Tcl_Size objc, Tcl_Obj *const *objv);
 typedef void (Tcl_MethodDeleteProc)(void *clientData);
 typedef int (Tcl_CloneProc)(Tcl_Interp *interp, void *oldClientData,
 	void **newClientData);

generic/tclObj.c

@@ -1670,7 +1670,7 @@ char *
 TclGetStringFromObj(
     Tcl_Obj *objPtr,	/* Object whose string rep byte pointer should
 				 * be returned. */
-    int *lengthPtr)	/* If non-NULL, the location where the string
+    void *lengthPtr)	/* If non-NULL, the location where the string
 				 * rep's byte array length should * be stored.
 				 * If NULL, no length is stored. */
 {
@@ -1702,9 +1702,9 @@ TclGetStringFromObj(
     if (lengthPtr != NULL) {
 	if (objPtr->length > INT_MAX) {
 	    Tcl_Panic("Tcl_GetStringFromObj with 'int' lengthPtr"
-		    " cannot handle such long strings. Please use 'size_t'");
+		    " cannot handle such long strings. Please use 'Tcl_Size'");
 	}
-	*lengthPtr = (int)objPtr->length;
+	*(int *)lengthPtr = (int)objPtr->length;
     }
     return objPtr->bytes;
 }

generic/tclParse.c

@@ -214,7 +214,7 @@ Tcl_ParseCommand(
 				 * command. */
     char type;			/* Result returned by CHAR_TYPE(*src). */
     Tcl_Token *tokenPtr;	/* Pointer to token being filled in. */
-    int wordIndex;		/* Index of word token for current word. */
+    Tcl_Size wordIndex;		/* Index of word token for current word. */
     int terminators;		/* CHAR_TYPE bits that indicate the end of a
 				 * command. */
     const char *termPtr;	/* Set by Tcl_ParseBraces/QuotedString to
@@ -327,7 +327,7 @@ Tcl_ParseCommand(
 	    src = termPtr;
 	    numBytes = parsePtr->end - src;
 	} else if (*src == '{') {
-	    int expIdx = wordIndex + 1;
+	    Tcl_Size expIdx = wordIndex + 1;
 	    Tcl_Token *expPtr;
 
 	    if (Tcl_ParseBraces(interp, src, numBytes, parsePtr, 1,
@@ -345,7 +345,7 @@ Tcl_ParseCommand(
 	    expPtr = &parsePtr->tokenPtr[expIdx];
 	    if ((0 == expandWord)
 		    /* Haven't seen prefix already */
-		    && (expIdx + 1 == (int)parsePtr->numTokens)
+		    && (expIdx + 1 == parsePtr->numTokens)
 		    /* Only one token */
 		    && (((1 == expPtr->size)
 			    /* Same length as prefix */
@@ -380,7 +380,7 @@ Tcl_ParseCommand(
 
 	tokenPtr = &parsePtr->tokenPtr[wordIndex];
 	tokenPtr->size = src - tokenPtr->start;
-	tokenPtr->numComponents = (int)parsePtr->numTokens - (wordIndex + 1);
+	tokenPtr->numComponents = parsePtr->numTokens - (wordIndex + 1);
 	if (expandWord) {
 	    Tcl_Size i;
 	    int isLiteral = 1;
@@ -407,7 +407,8 @@ Tcl_ParseCommand(
 	    }
 
 	    if (isLiteral) {
-		int elemCount = 0, code = TCL_OK, literal = 1;
+		Tcl_Size elemCount = 0;
+		int code = TCL_OK, literal = 1;
 		const char *nextElem, *listEnd, *elemStart;
 
 		/*
@@ -471,8 +472,8 @@ Tcl_ParseCommand(
 		     */
 
 		    const char *listStart;
-		    int growthNeeded = wordIndex + 2*elemCount
-			    - (int)parsePtr->numTokens;
+		    Tcl_Size growthNeeded = wordIndex + 2*elemCount
+			    - parsePtr->numTokens;
 
 		    parsePtr->numWords += elemCount - 1;
 		    if (growthNeeded > 0) {

generic/tclScan.c

@@ -11,6 +11,7 @@
 
 #include "tclInt.h"
 #include "tclTomMath.h"
+#include <assert.h>
 
 /*
  * Flag values used by Tcl_ScanObjCmd.
@@ -258,7 +259,7 @@ ValidateFormat(
     int *totalSubs)		/* The number of variables that will be
 				 * required. */
 {
-    int gotXpg, gotSequential, value, i, flags;
+    int gotXpg, gotSequential, i, flags;
     char *end;
     Tcl_UniChar ch = 0;
     int objIndex, xpgSize, nspace = numVars;
@@ -306,7 +307,8 @@ ValidateFormat(
 	     * format string.
 	     */
 
-	    value = strtoul(format-1, &end, 10);	/* INTL: "C" locale. */
+	    /* assert(value is >= 0) because of the isdigit() check above */
+	    unsigned long long ull = strtoull(format-1, &end, 10);	/* INTL: "C" locale. */
 	    if (*end != '$') {
 		goto notXpg;
 	    }
@@ -316,17 +318,22 @@ ValidateFormat(
 	    if (gotSequential) {
 		goto mixedXPG;
 	    }
-	    objIndex = value - 1;
-	    if ((objIndex < 0) || (numVars && (objIndex >= numVars))) {
+	    /* >=INT_MAX because 9.0 does not support more than INT_MAX-1 args */
+	    if (ull == 0 || ull >= INT_MAX) {
 		goto badIndex;
-	    } else if (numVars == 0) {
+	    }
+	    objIndex = (int) ull - 1;
+	    if (numVars && (objIndex >= numVars)) {
+		goto badIndex;
+	    }
+	    else if (numVars == 0) {
 		/*
 		 * In the case where no vars are specified, the user can
 		 * specify %9999$ legally, so we have to consider special
-		 * rules for growing the assign array. 'value' is guaranteed
-		 * to be > 0.
+		 * rules for growing the assign array. 'ull' is guaranteed
+		 * to be > 0 and < INT_MAX as per checks above.
 		 */
-		xpgSize = (xpgSize > value) ? xpgSize : value;
+		xpgSize = (xpgSize > (int)ull) ? xpgSize : (int)ull;
 	    }
 	    goto xpgCheckDone;
 	}
@@ -348,7 +355,22 @@ ValidateFormat(
 	 */
 
 	if ((ch < 0x80) && isdigit(UCHAR(ch))) {	/* INTL: "C" locale. */
-	    value = strtoul(format-1, (char **) &format, 10);	/* INTL: "C" locale. */
+	    /* Note ull >= 0 because of isdigit check above */
+	    unsigned long long ull;
+	    ull = strtoull(
+		format - 1, (char **)&format, 10); /* INTL: "C" locale. */
+	    /* Note >=, not >, to leave room for a nul */
+	    if (ull >= TCL_SIZE_MAX) {
+		Tcl_SetObjResult(
+		    interp,
+		    Tcl_ObjPrintf("specified field width %" TCL_LL_MODIFIER
+				  "u exceeds limit %" TCL_SIZE_MODIFIER "d.",
+				  ull,
+				  (Tcl_Size)TCL_SIZE_MAX-1));
+		Tcl_SetErrorCode(
+		    interp, "TCL", "FORMAT", "WIDTHLIMIT", NULL);
+		goto error;
+	    }
 	    flags |= SCAN_WIDTH;
 	    format += TclUtfToUniChar(format, &ch);
 	}
@@ -473,7 +495,7 @@ ValidateFormat(
 		 * guaranteed to be at least one larger than objIndex.
 		 */
 
-		value = nspace;
+		int nspaceOrig = nspace;
 		if (xpgSize) {
 		    nspace = xpgSize;
 		} else {
@@ -481,7 +503,7 @@ ValidateFormat(
 		}
 		nassign = (int *)TclStackRealloc(interp, nassign,
 			nspace * sizeof(int));
-		for (i = value; i < nspace; i++) {
+		for (i = nspaceOrig; i < nspace; i++) {
 		    nassign[i] = 0;
 		}
 	    }
@@ -575,7 +597,8 @@ Tcl_ScanObjCmd(
     long value;
     const char *string, *end, *baseString;
     char op = 0;
-    int width, underflow = 0;
+    int underflow = 0;
+    Tcl_Size width;
     Tcl_WideInt wideValue;
     Tcl_UniChar ch = 0, sch = 0;
     Tcl_Obj **objs = NULL, *objPtr = NULL;
@@ -670,6 +693,7 @@ Tcl_ScanObjCmd(
 	    format += TclUtfToUniChar(format, &ch);
 	} else if ((ch < 0x80) && isdigit(UCHAR(ch))) {	/* INTL: "C" locale. */
 	    char *formatEnd;
+	    /* Note currently XPG3 range limited to INT_MAX to match type of objc */
 	    value = strtoul(format-1, &formatEnd, 10);/* INTL: "C" locale. */
 	    if (*formatEnd == '$') {
 		format = formatEnd+1;
@@ -683,7 +707,10 @@ Tcl_ScanObjCmd(
 	 */
 
 	if ((ch < 0x80) && isdigit(UCHAR(ch))) {	/* INTL: "C" locale. */
-	    width = (int) strtoul(format-1, (char **) &format, 10);/* INTL: "C" locale. */
+	    unsigned long long ull;
+	    ull  = strtoull(format-1, (char **) &format, 10); /* INTL: "C" locale. */
+	    assert(ull <= TCL_SIZE_MAX); /* Else ValidateFormat should've error'ed */
+	    width = (Tcl_Size)ull;
 	    format += TclUtfToUniChar(format, &ch);
 	} else {
 	    width = 0;
@@ -1067,12 +1094,15 @@ Tcl_ScanObjCmd(
     } else {
 	/*
 	 * Here no vars were specified, we want a list returned (inline scan)
+	 * We create an empty Tcl_Obj to fill missing values rather than
+	 * allocating a new Tcl_Obj every time. See test scan-bigdata-XX.
 	 */
-
+	Tcl_Obj *emptyObj = Tcl_NewObj();
+	Tcl_IncrRefCount(emptyObj);
 	TclNewObj(objPtr);
-	for (i = 0; i < totalVars; i++) {
+	for (i = 0; code == TCL_OK && i < totalVars; i++) {
 	    if (objs[i] != NULL) {
-		Tcl_ListObjAppendElement(NULL, objPtr, objs[i]);
+		code = Tcl_ListObjAppendElement(interp, objPtr, objs[i]);
 		Tcl_DecrRefCount(objs[i]);
 	    } else {
 		/*
@@ -1080,9 +1110,20 @@ Tcl_ScanObjCmd(
 		 * empty strings for these.
 		 */
 
-		Tcl_ListObjAppendElement(NULL, objPtr, Tcl_NewObj());
+		code = Tcl_ListObjAppendElement(interp, objPtr, emptyObj);
 	    }
 	}
+	Tcl_DecrRefCount(emptyObj);
+	if (code != TCL_OK) {
+	    /* If error'ed out, free up remaining. i contains last index freed */
+	    while (++i < totalVars) {
+		if (objs[i] != NULL) {
+		    Tcl_DecrRefCount(objs[i]);
+		}
+	    }
+	    Tcl_DecrRefCount(objPtr);
+	    objPtr = NULL;
+	}
     }
     if (objs != NULL) {
 	Tcl_Free(objs);

generic/tclStringObj.c

@@ -1,29 +1,27 @@
 /*
  * tclStringObj.c --
  *
- *	This file contains functions that implement string operations on Tcl
- *	objects. Some string operations work with UTF strings and others
- *	require Unicode format. Functions that require knowledge of the width
- *	of each character, such as indexing, operate on Unicode data.
+ *      This file contains functions that implement string operations on Tcl
+ *      objects. Some string operations work with UTF-8 encoding forms.
+ *      Functions that require knowledge of the width of each character,
+ * 	such as indexing, operate on fixed width encoding forms such as UTF-32.
  *
- *	A Unicode string is an internationalized string. Conceptually, a
- *	Unicode string is an array of 16-bit quantities organized as a
- *	sequence of properly formed UTF-8 characters. There is a one-to-one
- *	map between Unicode and UTF characters. Because Unicode characters
- *	have a fixed width, operations such as indexing operate on Unicode
- *	data. The String object is optimized for the case where each UTF char
+ * 	Conceptually, a string is a sequence of Unicode code points. Internally
+ * 	it may be stored in an encoding form such as a modified version of
+ * 	UTF-8 or UTF-16 (when TCL_UTF_MAX=3) or UTF-32.
+ *
+ *	The String object is optimized for the case where each UTF char
  *	in a string is only one byte. In this case, we store the value of
- *	numChars, but we don't store the Unicode data (unless Tcl_GetUnicode
- *	is explicitly called).
+ *	numChars, but we don't store the fixed form encoding (unless
+ * 	Tcl_GetUnicode is explicitly called).
  *
- *	The String object type stores one or both formats. The default
- *	behavior is to store UTF. Once Unicode is calculated by a function, it
- *	is stored in the internal rep for future access (without an additional
- *	O(n) cost).
+ *      The String object type stores one or both formats. The default
+ *      behavior is to store UTF-8. Once UTF-16/UTF32 is calculated, it is
+ *      stored in the internal rep for future access (without an additional
+ *      O(n) cost).
  *
  *	To allow many appends to be done to an object without constantly
- *	reallocating the space for the string or Unicode representation, we
- *	allocate double the space for the string or Unicode and use the
+ *	reallocating space, we allocate double the space and use the
  *	internal representation to keep track of how much space is used vs.
  *	allocated.
  *
@@ -515,6 +513,11 @@ TclCheckEmptyString(
 	return TCL_EMPTYSTRING_YES;
     }
 
+    if (TclIsPureByteArray(objPtr)
+	&& Tcl_GetCharLength(objPtr) == 0) {
+	return TCL_EMPTYSTRING_YES;
+    }
+
     if (TclListObjIsCanonical(objPtr)) {
 	TclListObjLengthM(NULL, objPtr, &length);
 	return length == 0;
@@ -685,7 +688,7 @@ Tcl_UniChar *
 TclGetUnicodeFromObj(
     Tcl_Obj *objPtr,		/* The object to find the Unicode string
 				 * for. */
-    int *lengthPtr)		/* If non-NULL, the location where the string
+    void *lengthPtr)		/* If non-NULL, the location where the string
 				 * rep's Tcl_UniChar length should be stored. If
 				 * NULL, no length is stored. */
 {
@@ -704,7 +707,7 @@ TclGetUnicodeFromObj(
 	    Tcl_Panic("Tcl_GetUnicodeFromObj with 'int' lengthPtr"
 		    " cannot handle such long strings. Please use 'Tcl_Size'");
 	}
-	*lengthPtr = (int)stringPtr->numChars;
+	*(int *)lengthPtr = (int)stringPtr->numChars;
     }
     return stringPtr->unicode;
 }
@@ -1431,26 +1434,26 @@ Tcl_AppendObjToObj(
     Tcl_Size appendNumChars = TCL_INDEX_NONE;
     const char *bytes;
 
-    /*
-     * Special case: second object is standard-empty is fast case. We know
-     * that appending nothing to anything leaves that starting anything...
-     */
-
-    if (appendObjPtr->bytes == &tclEmptyString) {
+    if (TclCheckEmptyString(appendObjPtr) == TCL_EMPTYSTRING_YES) {
 	return;
     }
 
-    /*
-     * Handle append of one ByteArray object to another as a special case.
-     * Note that we only do this when the objects are pure so that the
-     * bytearray faithfully represent the true value; Otherwise appending the
-     * byte arrays together could lose information;
-     */
+    if (TclCheckEmptyString(objPtr) == TCL_EMPTYSTRING_YES) {
+	TclSetDuplicateObj(objPtr, appendObjPtr);
+	return;
+    }
 
-    if ((TclIsPureByteArray(objPtr) || objPtr->bytes == &tclEmptyString)
-	    && TclIsPureByteArray(appendObjPtr)) {
+    if (
+	TclIsPureByteArray(appendObjPtr)
+	&& (TclIsPureByteArray(objPtr) || objPtr->bytes == &tclEmptyString)
+    ) {
 	/*
-	 * You might expect the code here to be
+	 * Both bytearray objects are pure, so the second internal bytearray value
+	 * can be appended to the first, with no need to modify the "bytes" field.
+	 */
+
+	/*
+	 * One might expect the code here to be
 	 *
 	 *  bytes = Tcl_GetByteArrayFromObj(appendObjPtr, &length);
 	 *  TclAppendBytesToByteArray(objPtr, bytes, length);
@@ -2006,12 +2009,16 @@ Tcl_AppendFormatToObj(
 
 	width = 0;
 	if (isdigit(UCHAR(ch))) {
-	    width = strtoul(format, &end, 10);
-	    if (width < 0) {
+	    /* Note ull will be >= 0 because of isdigit check above */
+	    unsigned long long ull;
+	    ull = strtoull(format, &end, 10);
+	    /* Comparison is >=, not >, to leave room for nul */
+	    if (ull >= TCL_SIZE_MAX) {
 		msg = overflow;
 		errCode = "OVERFLOW";
 		goto errorMsg;
 	    }
+	    width = (Tcl_Size)ull;
 	    format = end;
 	    step = TclUtfToUniChar(format, &ch);
 	} else if (ch == '*') {
@@ -2048,7 +2055,16 @@ Tcl_AppendFormatToObj(
 	    step = TclUtfToUniChar(format, &ch);
 	}
 	if (isdigit(UCHAR(ch))) {
-	    precision = strtoul(format, &end, 10);
+	    /* Note ull will be >= 0 because of isdigit check above */
+	    unsigned long long ull;
+	    ull = strtoull(format, &end, 10);
+	    /* Comparison is >=, not >, to leave room for nul */
+	    if (ull >= TCL_SIZE_MAX) {
+		msg = overflow;
+		errCode = "OVERFLOW";
+		goto errorMsg;
+	    }
+	    precision = (Tcl_Size)ull;
 	    format = end;
 	    step = TclUtfToUniChar(format, &ch);
 	} else if (ch == '*') {
@@ -3126,7 +3142,7 @@ TclStringCat(
     int allowUniChar = 1, requestUniChar = 0, forceUniChar = 0;
     Tcl_Size first = objc - 1;	/* Index of first value possibly not empty */
     Tcl_Size last = 0;		/* Index of last value possibly not empty */
-    int inPlace = flags & TCL_STRING_IN_PLACE;
+    int inPlace = (flags & TCL_STRING_IN_PLACE) && !Tcl_IsShared(*objv);
 
     /* assert ( objc >= 0 ) */
 
@@ -3254,7 +3270,8 @@ TclStringCat(
 
 		Tcl_Obj *objPtr = *ov++;
 
-		if (objPtr->bytes == NULL) {
+		if (objPtr->bytes == NULL
+		    && TclCheckEmptyString(objPtr) != TCL_EMPTYSTRING_YES) {
 		    /* No string rep; Take the chance we can avoid making it */
 		    pendingPtr = objPtr;
 		} else {
@@ -3330,6 +3347,7 @@ TclStringCat(
     }
 
     objv += first; objc = (last - first + 1);
+    inPlace = (flags & TCL_STRING_IN_PLACE) && !Tcl_IsShared(*objv);
 
     if (binary) {
 	/* Efficiently produce a pure byte array result */
@@ -3340,7 +3358,7 @@ TclStringCat(
 	 * failure to allocate enough space. Following stanza may panic.
 	 */
 
-	if (inPlace && !Tcl_IsShared(*objv)) {
+	if (inPlace) {
 	    Tcl_Size start = 0;
 
 	    objResultPtr = *objv++; objc--;
@@ -3370,7 +3388,7 @@ TclStringCat(
 	/* Efficiently produce a pure Tcl_UniChar array result */
 	Tcl_UniChar *dst;
 
-	if (inPlace && !Tcl_IsShared(*objv)) {
+	if (inPlace) {
 	    Tcl_Size start;
 
 	    objResultPtr = *objv++; objc--;
@@ -3421,7 +3439,7 @@ TclStringCat(
 	/* Efficiently concatenate string reps */
 	char *dst;
 
-	if (inPlace && !Tcl_IsShared(*objv)) {
+	if (inPlace) {
 	    Tcl_Size start;
 
 	    objResultPtr = *objv++; objc--;
@@ -3512,6 +3530,7 @@ TclStringCmp(
     if ((reqlength == 0) || (value1Ptr == value2Ptr)) {
 	/*
 	 * Always match at 0 chars of if it is the same obj.
+	 * Note: as documented reqlength negative means it is ignored
 	 */
 	match = 0;
     } else {
@@ -3566,7 +3585,7 @@ TclStringCmp(
 			memCmpFn = memcmp;
 			s1len *= sizeof(Tcl_UniChar);
 			s2len *= sizeof(Tcl_UniChar);
-			if (reqlength != TCL_INDEX_NONE) {
+			if (reqlength > 0) {
 			    reqlength *= sizeof(Tcl_UniChar);
 			}
 		    } else {
@@ -3610,7 +3629,7 @@ TclStringCmp(
 		s1 = Tcl_GetStringFromObj(value1Ptr, &s1len);
 		s2 = Tcl_GetStringFromObj(value2Ptr, &s2len);
 	    }
-	    if (!nocase && checkEq && reqlength == TCL_INDEX_NONE) {
+	    if (!nocase && checkEq && reqlength < 0) {
 		/*
 		 * When we have equal-length we can check only for
 		 * (in)equality. We can use memcmp in all (n)eq cases because
@@ -3627,7 +3646,7 @@ TclStringCmp(
 		 * length was requested.
 		 */
 
-		if ((reqlength == TCL_INDEX_NONE) && !nocase) {
+		if ((reqlength < 0) && !nocase) {
 		    memCmpFn = (memCmpFn_t) TclpUtfNcmp2;
 		} else {
 		    s1len = Tcl_NumUtfChars(s1, s1len);
@@ -3643,7 +3662,7 @@ TclStringCmp(
 	 * comparison function.
 	 */
 	length = (s1len < s2len) ? s1len : s2len;
-	if (reqlength == TCL_INDEX_NONE) {
+	if (reqlength < 0) {
 	    /*
 	     * The requested length is negative, so ignore it by setting it
 	     * to length + 1 to correct the match var.
@@ -3654,7 +3673,7 @@ TclStringCmp(
 	    length = reqlength;
 	}
 
-	if (checkEq && reqlength == TCL_INDEX_NONE && (s1len != s2len)) {
+	if (checkEq && reqlength < 0 && (s1len != s2len)) {
 	    match = 1;		/* This will be reversed below. */
 	} else {
 	    /*
@@ -4483,6 +4502,14 @@ ExtendStringRepWithUnicode(
 
   copyBytes:
     dst = objPtr->bytes + origLength;
+#if TCL_UTF_MAX < 4
+    /* Initialize the buffer so that some random data doesn't trick
+     * Tcl_UniCharToUtf() into thinking it should combine surrogate pairs.
+     * Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its
+     * prior non-stateful nature, this call to memset can also be removed.
+     */
+    memset(dst, 0xff, stringPtr->allocated - origLength);
+#endif
     for (i = 0; i < numChars; i++) {
 	dst += Tcl_UniCharToUtf(unicode[i], dst);
     }

generic/tclStringRep.h

@@ -1,29 +1,12 @@
 /*
  * tclStringRep.h --
  *
- *	This file contains the definition of the Unicode string internal
- *	representation and macros to access it.
+ *  This file contains the definition of internal representations of a string
+ *  and macros to access it.
  *
- *	A Unicode string is an internationalized string. Conceptually, a
- *	Unicode string is an array of 16-bit quantities organized as a
- *	sequence of properly formed UTF-8 characters. There is a one-to-one
- *	map between Unicode and UTF characters. Because Unicode characters
- *	have a fixed width, operations such as indexing operate on Unicode
- *	data. The String object is optimized for the case where each UTF char
- *	in a string is only one byte. In this case, we store the value of
- *	numChars, but we don't store the Unicode data (unless Tcl_GetUnicode
- *	is explicitly called).
- *
- *	The String object type stores one or both formats. The default
- *	behavior is to store UTF. Once Unicode is calculated by a function, it
- *	is stored in the internal rep for future access (without an additional
- *	O(n) cost).
- *
- *	To allow many appends to be done to an object without constantly
- *	reallocating the space for the string or Unicode representation, we
- *	allocate double the space for the string or Unicode and use the
- *	internal representation to keep track of how much space is used vs.
- *	allocated.
+ *  Conceptually, a string is a sequence of Unicode code points. Internally
+ *  it may be stored in an encoding form such as a modified version of UTF-8
+ *  or UTF-16 (when TCL_UTF_MAX=3) or UTF-32.
  *
  * Copyright (c) 1995-1997 Sun Microsystems, Inc.
  * Copyright (c) 1999 by Scriptics Corporation.
@@ -39,15 +22,10 @@
 /*
  * The following structure is the internal rep for a String object. It keeps
  * track of how much memory has been used and how much has been allocated for
- * the Unicode and UTF string to enable growing and shrinking of the UTF and
- * Unicode reps of the String object with fewer mallocs. To optimize string
+ * the various representations to enable growing and shrinking of
+ * the String object with fewer mallocs. To optimize string
  * length and indexing operations, this structure also stores the number of
- * characters (same of UTF and Unicode!) once that value has been computed.
- *
- * Under normal configurations, what Tcl calls "Unicode" is actually UTF-16
- * restricted to the Basic Multilingual Plane (i.e. U+00000 to U+0FFFF). This
- * can be officially modified by altering the definition of Tcl_UniChar in
- * tcl.h, but do not do that unless you are sure what you're doing!
+ * code points (independent of encoding form) once that value has been computed.
  */
 
 typedef struct {
@@ -57,15 +35,15 @@ typedef struct {
 				 * Unicode rep, or that the number of UTF bytes ==
 				 * the number of chars. */
     Tcl_Size allocated;		/* The amount of space actually allocated for
-				 * the UTF string (minus 1 byte for the
+				 * the UTF-8 string (minus 1 byte for the
 				 * termination char). */
     Tcl_Size maxChars;		/* Max number of chars that can fit in the
 				 * space allocated for the Unicode array. */
     int hasUnicode;		/* Boolean determining whether the string has
-				 * a Unicode representation. */
-    Tcl_UniChar unicode[TCLFLEXARRAY];	/* The array of Unicode chars. The actual size
-				 * of this field depends on the 'maxChars'
-				 * field above. */
+				 * a Tcl_UniChar representation. */
+    Tcl_UniChar unicode[TCLFLEXARRAY];	/* The array of Tcl_UniChar units.
+				 * The actual size of this field depends on
+				 * the maxChars field above. */
 } String;
 
 /* Limit on string lengths. The -1 because limit does not include the nul */

generic/tclStubInit.c

@@ -123,7 +123,7 @@ static void uniCodePanic() {
 # define TclParseArgsObjv 0
 #else /* !defined(TCL_NO_DEPRECATED) */
 int TclListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr,
-    int *objcPtr, Tcl_Obj ***objvPtr) {
+    void *objcPtr, Tcl_Obj ***objvPtr) {
     Tcl_Size n = TCL_INDEX_NONE;
     int result = Tcl_ListObjGetElements(interp, listPtr, &n, objvPtr);
     if (objcPtr) {
@@ -133,12 +133,12 @@ int TclListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr,
 	    }
 	    return TCL_ERROR;
 	}
-	*objcPtr = n;
+	*(int *)objcPtr = (int)n;
     }
     return result;
 }
 int TclListObjLength(Tcl_Interp *interp, Tcl_Obj *listPtr,
-    int *lengthPtr) {
+    void *lengthPtr) {
     Tcl_Size n = TCL_INDEX_NONE;
     int result = Tcl_ListObjLength(interp, listPtr, &n);
     if (lengthPtr) {
@@ -148,12 +148,12 @@ int TclListObjLength(Tcl_Interp *interp, Tcl_Obj *listPtr,
 	    }
 	    return TCL_ERROR;
 	}
-	*lengthPtr = n;
+	*(int *)lengthPtr = (int)n;
     }
     return result;
 }
 int TclDictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr,
-    int *sizePtr) {
+    void *sizePtr) {
     Tcl_Size n = TCL_INDEX_NONE;
     int result = Tcl_DictObjSize(interp, dictPtr, &n);
     if (sizePtr) {
@@ -163,11 +163,11 @@ int TclDictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr,
 	    }
 	    return TCL_ERROR;
 	}
-	*sizePtr = n;
+	*(int *)sizePtr = (int)n;
     }
     return result;
 }
-int TclSplitList(Tcl_Interp *interp, const char *listStr, int *argcPtr,
+int TclSplitList(Tcl_Interp *interp, const char *listStr, void *argcPtr,
 	const char ***argvPtr) {
     Tcl_Size n = TCL_INDEX_NONE;
     int result = Tcl_SplitList(interp, listStr, &n, argvPtr);
@@ -179,11 +179,11 @@ int TclSplitList(Tcl_Interp *interp, const char *listStr, int *argcPtr,
 	    Tcl_Free((void *)*argvPtr);
 	    return TCL_ERROR;
 	}
-	*argcPtr = n;
+	*(int *)argcPtr = (int)n;
     }
     return result;
 }
-void TclSplitPath(const char *path, int *argcPtr, const char ***argvPtr) {
+void TclSplitPath(const char *path, void *argcPtr, const char ***argvPtr) {
     Tcl_Size n = TCL_INDEX_NONE;
     Tcl_SplitPath(path, &n, argvPtr);
     if (argcPtr) {
@@ -192,10 +192,10 @@ void TclSplitPath(const char *path, int *argcPtr, const char ***argvPtr) {
 	    Tcl_Free((void *)*argvPtr);
 	    *argvPtr = NULL;
 	}
-	*argcPtr = n;
+	*(int *)argcPtr = (int)n;
     }
 }
-Tcl_Obj *TclFSSplitPath(Tcl_Obj *pathPtr, int *lenPtr) {
+Tcl_Obj *TclFSSplitPath(Tcl_Obj *pathPtr, void *lenPtr) {
     Tcl_Size n = TCL_INDEX_NONE;
     Tcl_Obj *result = Tcl_FSSplitPath(pathPtr, &n);
     if (lenPtr) {
@@ -203,16 +203,16 @@ Tcl_Obj *TclFSSplitPath(Tcl_Obj *pathPtr, int *lenPtr) {
 	    Tcl_DecrRefCount(result);
 	    return NULL;
 	}
-	*lenPtr = n;
+	*(int *)lenPtr = (int)n;
     }
     return result;
 }
 int TclParseArgsObjv(Tcl_Interp *interp,
-	const Tcl_ArgvInfo *argTable, int *objcPtr, Tcl_Obj *const *objv,
+	const Tcl_ArgvInfo *argTable, void *objcPtr, Tcl_Obj *const *objv,
 	Tcl_Obj ***remObjv) {
-    Tcl_Size n = (*objcPtr < 0) ? TCL_INDEX_NONE: *objcPtr ;
+    Tcl_Size n = (*(int *)objcPtr < 0) ? TCL_INDEX_NONE: (Tcl_Size)*(int *)objcPtr ;
     int result = Tcl_ParseArgsObjv(interp, argTable, &n, objv, remObjv);
-    *objcPtr = (int)n;
+    *(int *)objcPtr = (int)n;
     return result;
 }
 #endif /* !defined(TCL_NO_DEPRECATED) */

generic/tclTest.c

@@ -224,7 +224,8 @@ static Tcl_ObjCmdProc	TestbytestringObjCmd;
 static Tcl_ObjCmdProc	TestsetbytearraylengthObjCmd;
 static Tcl_ObjCmdProc	TestpurebytesobjObjCmd;
 static Tcl_ObjCmdProc	TeststringbytesObjCmd;
-static Tcl_CmdProc	TestcmdinfoCmd;
+static Tcl_ObjCmdProc2	Testcmdobj2ObjCmd;
+static Tcl_ObjCmdProc	TestcmdinfoObjCmd;
 static Tcl_CmdProc	TestcmdtokenCmd;
 static Tcl_CmdProc	TestcmdtraceCmd;
 static Tcl_CmdProc	TestconcatobjCmd;
@@ -586,7 +587,9 @@ Tcltest_Init(
 	    NULL, NULL);
     Tcl_CreateCommand(interp, "testcmdtoken", TestcmdtokenCmd, NULL,
 	    NULL);
-    Tcl_CreateCommand(interp, "testcmdinfo", TestcmdinfoCmd, NULL,
+    Tcl_CreateObjCommand2(interp, "testcmdobj2", Testcmdobj2ObjCmd,
+	    NULL, NULL);
+    Tcl_CreateObjCommand(interp, "testcmdinfo", TestcmdinfoObjCmd, NULL,
 	    NULL);
     Tcl_CreateCommand(interp, "testcmdtrace", TestcmdtraceCmd,
 	    NULL, NULL);
@@ -1061,7 +1064,41 @@ TestbumpinterpepochObjCmd(
 /*
  *----------------------------------------------------------------------
  *
- * TestcmdinfoCmd --
+ * Testcmdobj2 --
+ *
+ *	Mock up to test the Tcl_CreateCommandObj2 functionality
+ *
+ * Results:
+ *	Standard Tcl result.
+ *
+ * Side effects:
+ *	Sets interpreter result to number of arguments, first arg, last arg.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+Testcmdobj2ObjCmd(
+    TCL_UNUSED(void *),
+    Tcl_Interp *interp,		/* Current interpreter. */
+    Tcl_Size objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    Tcl_Obj *resultObj;
+    resultObj = Tcl_NewListObj(0, NULL);
+    Tcl_ListObjAppendElement(interp, resultObj, Tcl_NewWideIntObj(objc));
+    if (objc > 1) {
+	Tcl_ListObjAppendElement(interp, resultObj, objv[1]);
+	Tcl_ListObjAppendElement(interp, resultObj, objv[objc-1]);
+    }
+    Tcl_SetObjResult(interp, resultObj);
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestcmdinfoObjCmd --
  *
  *	This procedure implements the "testcmdinfo" command.  It is used to
  *	test Tcl_GetCommandInfo, Tcl_SetCommandInfo, and command creation and
@@ -1077,28 +1114,69 @@ TestbumpinterpepochObjCmd(
  */
 
 static int
-TestcmdinfoCmd(
+TestcmdinfoObjCmd(
     TCL_UNUSED(void *),
     Tcl_Interp *interp,		/* Current interpreter. */
-    int argc,			/* Number of arguments. */
-    const char **argv)		/* Argument strings. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])      /* Argument objects. */
 {
+    static const char *const subcmds[] = {
+	   "call", "call2", "create", "delete", "get", "modify", NULL
+    };
+    enum options {
+	CMDINFO_CALL, CMDINFO_CALL2, CMDINFO_CREATE,
+	CMDINFO_DELETE, CMDINFO_GET, CMDINFO_MODIFY
+    } idx;
     Tcl_CmdInfo info;
+    Tcl_Obj **cmdObjv;
+    Tcl_Size cmdObjc;
 
-    if (argc != 3) {
-	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
-		" option cmdName\"", NULL);
+    if (objc != 3) {
+	Tcl_WrongNumArgs(interp, 1, objv, "command arg");
 	return TCL_ERROR;
     }
-    if (strcmp(argv[1], "create") == 0) {
-	Tcl_CreateCommand(interp, argv[2], CmdProc1, (void *) "original",
-		CmdDelProc1);
-    } else if (strcmp(argv[1], "delete") == 0) {
+    if (Tcl_GetIndexFromObj(interp, objv[1], subcmds, "option", 0,
+	    &idx) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    switch (idx) {
+    case CMDINFO_CALL:
+    case CMDINFO_CALL2:
+	if (Tcl_ListObjGetElements(interp, objv[2], &cmdObjc, &cmdObjv) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	if (cmdObjc == 0) {
+	    Tcl_AppendResult(interp, "No command name given", NULL);
+	    return TCL_ERROR;
+	}
+	if (Tcl_GetCommandInfo(interp, Tcl_GetString(cmdObjv[0]), &info) == 0) {
+	    return TCL_ERROR;
+	}
+	if (idx == CMDINFO_CALL) {
+	    /*
+	     * Note when calling through the old 32-bit API, it is the caller's
+	     * responsibility to check that number of arguments is <= INT_MAX.
+	     * We do not do that here just so we can test what happens if the
+	     * caller mistakenly passes more arguments.
+	     */
+	    return info.objProc(info.objClientData, interp, cmdObjc, cmdObjv);
+	} else {
+	    return info.objProc2(info.objClientData2, interp, cmdObjc, cmdObjv);
+	}
+    case CMDINFO_CREATE:
+	Tcl_CreateCommand(interp,
+			  Tcl_GetString(objv[2]),
+			  CmdProc1,
+			  (void *)"original",
+			  CmdDelProc1);
+	break;
+    case CMDINFO_DELETE:
 	Tcl_DStringInit(&delString);
-	Tcl_DeleteCommand(interp, argv[2]);
+	Tcl_DeleteCommand(interp, Tcl_GetString(objv[2]));
 	Tcl_DStringResult(interp, &delString);
-    } else if (strcmp(argv[1], "get") == 0) {
-	if (Tcl_GetCommandInfo(interp, argv[2], &info) ==0) {
+	break;
+    case CMDINFO_GET:
+	if (Tcl_GetCommandInfo(interp, Tcl_GetString(objv[2]), &info) ==0) {
 	    Tcl_AppendResult(interp, "??", NULL);
 	    return TCL_OK;
 	}
@@ -1121,28 +1199,35 @@ TestcmdinfoCmd(
 	    Tcl_AppendResult(interp, " unknown", NULL);
 	}
 	Tcl_AppendResult(interp, " ", info.namespacePtr->fullName, NULL);
-	if (info.isNativeObjectProc) {
-	    Tcl_AppendResult(interp, " nativeObjectProc", NULL);
-	} else {
+	if (info.isNativeObjectProc == 0) {
 	    Tcl_AppendResult(interp, " stringProc", NULL);
+	} else if (info.isNativeObjectProc == 1) {
+	    Tcl_AppendResult(interp, " nativeObjectProc", NULL);
+	} else if (info.isNativeObjectProc == 2) {
+	    Tcl_AppendResult(interp, " nativeObjectProc2", NULL);
+	} else {
+	    Tcl_SetObjResult(
+		interp,
+		Tcl_ObjPrintf("Invalid isNativeObjectProc value %d",
+			      info.isNativeObjectProc));
+	    return TCL_ERROR;
 	}
-    } else if (strcmp(argv[1], "modify") == 0) {
+	break;
+    case CMDINFO_MODIFY:
 	info.proc = CmdProc2;
 	info.clientData = (void *) "new_command_data";
 	info.objProc = NULL;
 	info.objClientData = NULL;
 	info.deleteProc = CmdDelProc2;
 	info.deleteData = (void *) "new_delete_data";
-	if (Tcl_SetCommandInfo(interp, argv[2], &info) == 0) {
+	if (Tcl_SetCommandInfo(interp, Tcl_GetString(objv[2]), &info) == 0) {
 	    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0));
 	} else {
 	    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(1));
 	}
-    } else {
-	Tcl_AppendResult(interp, "bad option \"", argv[1],
-		"\": must be create, delete, get, or modify", NULL);
-	return TCL_ERROR;
+	break;
     }
+
     return TCL_OK;
 }
 
@@ -5677,7 +5762,14 @@ TestbytestringObjCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* The argument objects. */
 {
-    Tcl_Size n = 0;
+    struct {
+#if !defined(TCL_NO_DEPRECATED)
+	int n; /* On purpose, not Tcl_Size, in order to demonstrate what happens */
+#else
+	Tcl_Size n;
+#endif
+	int m; /* This variable should not be overwritten */
+    } x = {0, 1};
     const char *p;
 
     if (objc != 2) {
@@ -5685,11 +5777,15 @@ TestbytestringObjCmd(
 	return TCL_ERROR;
     }
 
-    p = (const char *)Tcl_GetBytesFromObj(interp, objv[1], &n);
+    p = (const char *)Tcl_GetBytesFromObj(interp, objv[1], &x.n);
     if (p == NULL) {
 	return TCL_ERROR;
     }
-    Tcl_SetObjResult(interp, Tcl_NewStringObj(p, n));
+    if (x.m != 1) {
+	Tcl_AppendResult(interp, "Tcl_GetBytesFromObj() overwrites variable", NULL);
+	return TCL_ERROR;
+    }
+    Tcl_SetObjResult(interp, Tcl_NewStringObj(p, x.n));
     return TCL_OK;
 }
 
@@ -6765,7 +6861,7 @@ TestWrongNumArgsObjCmd(
     Tcl_Size i, length;
     const char *msg;
 
-    if (objc + 1 < 4) {
+    if (objc < 3) {
 	goto insufArgs;
     }
 

generic/tclThreadJoin.c

@@ -1,318 +0,0 @@
-/*
- * tclThreadJoin.c --
- *
- *	This file implements a platform independent emulation layer for the
- *	handling of joinable threads. The Windows platform uses this code to
- *	provide the functionality of joining threads.  This code is currently
- *	not necessary on Unix.
- *
- * Copyright © 2000 Scriptics Corporation
- *
- * See the file "license.terms" for information on usage and redistribution of
- * this file, and for a DISCLAIMER OF ALL WARRANTIES.
- */
-
-#include "tclInt.h"
-
-#ifdef _WIN32
-
-/*
- * The information about each joinable thread is remembered in a structure as
- * defined below.
- */
-
-typedef struct JoinableThread {
-    Tcl_ThreadId  id;		/* The id of the joinable thread. */
-    int result;			/* A place for the result after the demise of
-				 * the thread. */
-    int done;			/* Boolean flag. Initialized to 0 and set to 1
-				 * after the exit of the thread. This allows a
-				 * thread requesting a join to detect when
-				 * waiting is not necessary. */
-    int waitedUpon;		/* Boolean flag. Initialized to 0 and set to 1
-				 * by the thread waiting for this one via
-				 * Tcl_JoinThread.  Used to lock any other
-				 * thread trying to wait on this one. */
-    Tcl_Mutex threadMutex;	/* The mutex used to serialize access to this
-				 * structure. */
-    Tcl_Condition cond;		/* This is the condition a thread has to wait
-				 * upon to get notified of the end of the
-				 * described thread. It is signaled indirectly
-				 * by Tcl_ExitThread. */
-    struct JoinableThread *nextThreadPtr;
-				/* Reference to the next thread in the list of
-				 * joinable threads. */
-} JoinableThread;
-
-/*
- * The following variable is used to maintain the global list of all joinable
- * threads. Usage by a thread is allowed only if the thread acquired the
- * 'joinMutex'.
- */
-
-TCL_DECLARE_MUTEX(joinMutex)
-
-static JoinableThread *firstThreadPtr;
-
-/*
- *----------------------------------------------------------------------
- *
- * TclJoinThread --
- *
- *	This procedure waits for the exit of the thread with the specified id
- *	and returns its result.
- *
- * Results:
- *	A standard tcl result signaling the overall success/failure of the
- *	operation and an integer result delivered by the thread which was
- *	waited upon.
- *
- * Side effects:
- *	Deallocates the memory allocated by TclRememberJoinableThread.
- *	Removes the data associated to the thread waited upon from the list of
- *	joinable threads.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclJoinThread(
-    Tcl_ThreadId id,		/* The id of the thread to wait upon. */
-    int *result)		/* Reference to a location for the result of
-				 * the thread we are waiting upon. */
-{
-    JoinableThread *threadPtr;
-
-    /*
-     * Steps done here:
-     * i.    Acquire the joinMutex and search for the thread.
-     * ii.   Error out if it could not be found.
-     * iii.  If found, switch from exclusive access to the list to exclusive
-     *	     access to the thread structure.
-     * iv.   Error out if some other is already waiting.
-     * v.    Skip the waiting part of the thread is already done.
-     * vi.   Wait for the thread to exit, mark it as waited upon too.
-     * vii.  Get the result form the structure,
-     * viii. switch to exclusive access of the list,
-     * ix.   remove the structure from the list,
-     * x.    then switch back to exclusive access to the structure
-     * xi.   and delete it.
-     */
-
-    Tcl_MutexLock(&joinMutex);
-
-    threadPtr = firstThreadPtr;
-    while (threadPtr!=NULL && threadPtr->id!=id) {
-	threadPtr = threadPtr->nextThreadPtr;
-    }
-
-    if (threadPtr == NULL) {
-	/*
-	 * Thread not found. Either not joinable, or already waited upon and
-	 * exited. Whatever, an error is in order.
-	 */
-
-	Tcl_MutexUnlock(&joinMutex);
-	return TCL_ERROR;
-    }
-
-    /*
-     * [1] If we don't lock the structure before giving up exclusive access to
-     * the list some other thread just completing its wait on the same thread
-     * can delete the structure from under us, leaving us with a dangling
-     * pointer.
-     */
-
-    Tcl_MutexLock(&threadPtr->threadMutex);
-    Tcl_MutexUnlock(&joinMutex);
-
-    /*
-     * [2] Now that we have the structure mutex any other thread that just
-     * tries to delete structure will wait at location [3] until we are done
-     * with the structure. And in that case we are done with it rather quickly
-     * as 'waitedUpon' will be set and we will have to error out.
-     */
-
-    if (threadPtr->waitedUpon) {
-	Tcl_MutexUnlock(&threadPtr->threadMutex);
-	return TCL_ERROR;
-    }
-
-    /*
-     * We are waiting now, let other threads recognize this.
-     */
-
-    threadPtr->waitedUpon = 1;
-
-    while (!threadPtr->done) {
-	Tcl_ConditionWait(&threadPtr->cond, &threadPtr->threadMutex, NULL);
-    }
-
-    /*
-     * We have to release the structure before trying to access the list again
-     * or we can run into deadlock with a thread at [1] (see above) because of
-     * us holding the structure and the other holding the list.  There is no
-     * problem with dangling pointers here as 'waitedUpon == 1' is still valid
-     * and any other thread will error out and not come to this place. IOW,
-     * the fact that we are here also means that no other thread came here
-     * before us and is able to delete the structure.
-     */
-
-    Tcl_MutexUnlock(&threadPtr->threadMutex);
-    Tcl_MutexLock(&joinMutex);
-
-    /*
-     * We have to search the list again as its structure may (may, almost
-     * certainly) have changed while we were waiting. Especially now is the
-     * time to compute the predecessor in the list. Any earlier result can be
-     * dangling by now.
-     */
-
-    if (firstThreadPtr == threadPtr) {
-	firstThreadPtr = threadPtr->nextThreadPtr;
-    } else {
-	JoinableThread *prevThreadPtr = firstThreadPtr;
-
-	while (prevThreadPtr->nextThreadPtr != threadPtr) {
-	    prevThreadPtr = prevThreadPtr->nextThreadPtr;
-	}
-	prevThreadPtr->nextThreadPtr = threadPtr->nextThreadPtr;
-    }
-
-    Tcl_MutexUnlock(&joinMutex);
-
-    /*
-     * [3] Now that the structure is not part of the list anymore no other
-     * thread can acquire its mutex from now on. But it is possible that
-     * another thread is still holding the mutex though, see location [2].  So
-     * we have to acquire the mutex one more time to wait for that thread to
-     * finish. We can (and have to) release the mutex immediately.
-     */
-
-    Tcl_MutexLock(&threadPtr->threadMutex);
-    Tcl_MutexUnlock(&threadPtr->threadMutex);
-
-    /*
-     * Copy the result to us, finalize the synchronisation objects, then free
-     * the structure and return.
-     */
-
-    *result = threadPtr->result;
-
-    Tcl_ConditionFinalize(&threadPtr->cond);
-    Tcl_MutexFinalize(&threadPtr->threadMutex);
-    Tcl_Free(threadPtr);
-
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclRememberJoinableThread --
- *
- *	This procedure remembers a thread as joinable. Only a call to
- *	TclJoinThread will remove the structure created (and initialized) here.
- *	IOW, not waiting upon a joinable thread will cause memory leaks.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Allocates memory, adds it to the global list of all joinable threads.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclRememberJoinableThread(
-    Tcl_ThreadId id)		/* The thread to remember as joinable */
-{
-    JoinableThread *threadPtr;
-
-    threadPtr = (JoinableThread *)Tcl_Alloc(sizeof(JoinableThread));
-    threadPtr->id = id;
-    threadPtr->done = 0;
-    threadPtr->waitedUpon = 0;
-    threadPtr->threadMutex = (Tcl_Mutex) NULL;
-    threadPtr->cond = (Tcl_Condition) NULL;
-
-    Tcl_MutexLock(&joinMutex);
-
-    threadPtr->nextThreadPtr = firstThreadPtr;
-    firstThreadPtr = threadPtr;
-
-    Tcl_MutexUnlock(&joinMutex);
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclSignalExitThread --
- *
- *	This procedure signals that the specified thread is done with its
- *	work. If the thread is joinable this signal is propagated to the
- *	thread waiting upon it.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Modifies the associated structure to hold the result.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclSignalExitThread(
-    Tcl_ThreadId id,		/* Id of the thread signaling its exit. */
-    int result)			/* The result from the thread. */
-{
-    JoinableThread *threadPtr;
-
-    Tcl_MutexLock(&joinMutex);
-
-    threadPtr = firstThreadPtr;
-    while ((threadPtr != NULL) && (threadPtr->id != id)) {
-	threadPtr = threadPtr->nextThreadPtr;
-    }
-
-    if (threadPtr == NULL) {
-	/*
-	 * Thread not found. Not joinable. No problem, nothing to do.
-	 */
-
-	Tcl_MutexUnlock(&joinMutex);
-	return;
-    }
-
-    /*
-     * Switch over the exclusive access from the list to the structure, then
-     * store the result, set the flag and notify the waiting thread, provided
-     * that it exists. The order of lock/unlock ensures that a thread entering
-     * 'TclJoinThread' will not interfere with us.
-     */
-
-    Tcl_MutexLock(&threadPtr->threadMutex);
-    Tcl_MutexUnlock(&joinMutex);
-
-    threadPtr->done = 1;
-    threadPtr->result = result;
-
-    if (threadPtr->waitedUpon) {
-	Tcl_ConditionNotify(&threadPtr->cond);
-    }
-
-    Tcl_MutexUnlock(&threadPtr->threadMutex);
-}
-#else
-TCL_MAC_EMPTY_FILE(generic_tclThreadJoin_c)
-#endif /* _WIN32 */
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */

generic/tclUtf.c

@@ -348,6 +348,16 @@ Tcl_UniCharToUtfDString(
 
     p = string;
     wEnd = uniStr + uniLength;
+
+#if TCL_UTF_MAX < 4
+    /* Initialize the buffer so that some random data doesn't trick
+     * Tcl_UniCharToUtf() into thinking it should combine surrogate pairs.
+     * Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its
+     * prior non-stateful nature, this call to memset can also be removed.
+     */
+    memset(p, 0xff, Tcl_DStringLength(dsPtr) - oldLength);
+#endif
+
     for (w = uniStr; w < wEnd; ) {
 	p += Tcl_UniCharToUtf(*w, p);
 	w++;
@@ -391,6 +401,16 @@ Tcl_Char16ToUtfDString(
 
     p = string;
     wEnd = uniStr + uniLength;
+
+#if TCL_UTF_MAX < 4
+    /* Initialize the buffer so that some random data doesn't trick
+     * Tcl_UniCharToUtf() into thinking it should combine surrogate pairs.
+	 * Because TCL_COMBINE is used here, memset() is required even when
+	 * TCL_UTF_MAX == 4.
+     */
+    memset(p, 0xff, Tcl_DStringLength(dsPtr) - oldLength);
+#endif
+
     for (w = uniStr; w < wEnd; ) {
 	if (!len && ((*w & 0xFC00) != 0xDC00)) {
 	    /* Special case for handling high surrogates. */

generic/tclUtil.c

@@ -3679,8 +3679,8 @@ GetEndOffsetFromObj(
     offset = irPtr->wideValue;
 
     if (offset == WIDE_MAX) {
-	/* 
-	 * Encodes end+1. This is distinguished from end+n as noted above 
+	/*
+	 * Encodes end+1. This is distinguished from end+n as noted above
 	 * NOTE: this may wrap around if the caller passes (as lset does)
 	 * listLen-1 as endValue and and listLen is 0. The -1 will be
 	 * interpreted as FF...FF and adding 1 will result in 0 which
@@ -3976,6 +3976,46 @@ TclIndexInvalidError (
     return TCL_ERROR; /* Always */
 }
 
+/*
+ *------------------------------------------------------------------------
+ *
+ * TclCommandWordLimitErrpr --
+ *
+ *    Generates an error message limit on number of command words exceeded.
+ *
+ * Results:
+ *    Always return TCL_ERROR.
+ *
+ * Side effects:
+ *    If interp is not-NULL, an error message is stored in it.
+ *
+ *------------------------------------------------------------------------
+ */
+int
+TclCommandWordLimitError (
+    Tcl_Interp *interp,   /* May be NULL */
+    Tcl_Size count)       /* If <= 0, "unknown" */
+{
+    if (interp) {
+	if (count > 0) {
+	    Tcl_SetObjResult(
+		interp,
+		Tcl_ObjPrintf("Number of words (%" TCL_SIZE_MODIFIER
+			      "d) in command exceeds limit %" TCL_SIZE_MODIFIER
+			      "d.",
+			      count,
+			      (Tcl_Size)INT_MAX));
+	}
+	else {
+	    Tcl_SetObjResult(interp,
+			     Tcl_ObjPrintf("Number of words in command exceeds "
+					   "limit %" TCL_SIZE_MODIFIER "d.",
+					   (Tcl_Size)INT_MAX));
+	}
+    }
+    return TCL_ERROR; /* Always */
+}
+
 /*
  *----------------------------------------------------------------------
  *

generic/tclZipfs.c

@@ -5140,7 +5140,7 @@ ZipFSMatchMountPoints(
 {
     Tcl_HashEntry *hPtr;
     Tcl_HashSearch search;
-    size_t l; 
+    size_t l;
     Tcl_Size normLength;
     const char *path = Tcl_GetStringFromObj(normPathPtr, &normLength);
     size_t len = normLength;

generic/tclZlib.c

@@ -3761,7 +3761,7 @@ ZlibStackChannelTransform(
     if (compDictObj != NULL) {
 	cd->compDictObj = Tcl_DuplicateObj(compDictObj);
 	Tcl_IncrRefCount(cd->compDictObj);
-	Tcl_GetByteArrayFromObj(cd->compDictObj, (size_t *)NULL);
+	Tcl_GetByteArrayFromObj(cd->compDictObj, (Tcl_Size *)NULL);
     }
 
     if (format == TCL_ZLIB_FORMAT_RAW) {

macosx/README

@@ -129,8 +129,6 @@ Detailed Instructions for building with macosx/GNUmakefile
 (where ${ver} is a shell variable containing the Tcl version number e.g. '9.0').
 Setup this shell variable as follows:
 	ver="9.0"
-If you are building from CVS, omit this step (CVS source tree names usually do
-not contain a version number).
 
 - Setup environment variables as desired, e.g. for a universal build on 10.5:
 	CFLAGS="-arch x86_64 -arch arm64 -mmacosx-version-min=10.5"

macosx/Tcl.xcodeproj/project.pbxproj

@@ -86,7 +86,6 @@
 		F96D45C808F272BC004A47F5 /* tclTestProcBodyObj.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2908F272A7004A47F5 /* tclTestProcBodyObj.c */; };
 		F96D45C908F272BC004A47F5 /* tclThread.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2A08F272A7004A47F5 /* tclThread.c */; };
 		F96D45CA08F272BC004A47F5 /* tclThreadAlloc.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2B08F272A7004A47F5 /* tclThreadAlloc.c */; };
-		F96D45CB08F272BC004A47F5 /* tclThreadJoin.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2C08F272A7004A47F5 /* tclThreadJoin.c */; };
 		F96D45CC08F272BC004A47F5 /* tclThreadStorage.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2D08F272A7004A47F5 /* tclThreadStorage.c */; };
 		F96D45CD08F272BC004A47F5 /* tclThreadTest.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2E08F272A7004A47F5 /* tclThreadTest.c */; };
 		F96D45CE08F272BC004A47F5 /* tclTimer.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2F08F272A7004A47F5 /* tclTimer.c */; };
@@ -522,7 +521,6 @@
 		F96D3F2908F272A7004A47F5 /* tclTestProcBodyObj.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclTestProcBodyObj.c; sourceTree = "<group>"; };
 		F96D3F2A08F272A7004A47F5 /* tclThread.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclThread.c; sourceTree = "<group>"; };
 		F96D3F2B08F272A7004A47F5 /* tclThreadAlloc.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclThreadAlloc.c; sourceTree = "<group>"; };
-		F96D3F2C08F272A7004A47F5 /* tclThreadJoin.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclThreadJoin.c; sourceTree = "<group>"; };
 		F96D3F2D08F272A7004A47F5 /* tclThreadStorage.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclThreadStorage.c; sourceTree = "<group>"; };
 		F96D3F2E08F272A7004A47F5 /* tclThreadTest.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclThreadTest.c; sourceTree = "<group>"; };
 		F96D3F2F08F272A7004A47F5 /* tclTimer.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclTimer.c; sourceTree = "<group>"; };
@@ -1297,7 +1295,6 @@
 				F96D3F2908F272A7004A47F5 /* tclTestProcBodyObj.c */,
 				F96D3F2A08F272A7004A47F5 /* tclThread.c */,
 				F96D3F2B08F272A7004A47F5 /* tclThreadAlloc.c */,
-				F96D3F2C08F272A7004A47F5 /* tclThreadJoin.c */,
 				F96D3F2D08F272A7004A47F5 /* tclThreadStorage.c */,
 				F96D3F2E08F272A7004A47F5 /* tclThreadTest.c */,
 				F96D3F2F08F272A7004A47F5 /* tclTimer.c */,
@@ -2000,7 +1997,6 @@
 				F96D45C808F272BC004A47F5 /* tclTestProcBodyObj.c in Sources */,
 				F96D45C908F272BC004A47F5 /* tclThread.c in Sources */,
 				F96D45CA08F272BC004A47F5 /* tclThreadAlloc.c in Sources */,
-				F96D45CB08F272BC004A47F5 /* tclThreadJoin.c in Sources */,
 				F96D45CC08F272BC004A47F5 /* tclThreadStorage.c in Sources */,
 				F96D45CD08F272BC004A47F5 /* tclThreadTest.c in Sources */,
 				F96D45CE08F272BC004A47F5 /* tclTimer.c in Sources */,

tests/bigdata.test

@@ -115,6 +115,30 @@ set ::bigLengths(uintmax) 0xffffffff
 set ::bigLengths(patlenmultiple) [bigPatlenMultiple $::bigLengths(intmax)]
 set ::bigLengths(upatlenmultiple) [bigPatlenMultiple $::bigLengths(uintmax)]
 
+#
+# script limits
+bigtestRO script-length-bigdata-1 {Test script length limit} b -body {
+    try [string cat [string repeat " " 0x7ffffff7] "set a b"]
+}
+# TODO - different behaviour between compiled and uncompiled
+test script-length-bigdata-2.compiled {Test script length limit} -body {
+    try [string cat [string repeat " " 0x7ffffff8] "set a b"]
+} -constraints {
+    bigdata
+} -result {Script length 2147483647 exceeds max permitted length 2147483646.} -returnCodes error
+test script-length-bigdata-2.uncompiled {Test script length limit} -body {
+    testevalex [string cat [string repeat " " 0x7ffffff8] "set a b"]
+} -constraints {
+    bigdata
+ } -result b
+test script-bytecode-length-bigdata-1 {Test bytecode length limit} -body {
+    # Note we need to exceed bytecode limit without exceeding script char limit
+    set s [string repeat {{*}$x;} [expr 0x7fffffff/6]]
+    catch $s r e
+} -cleanup {
+    bigClean
+} -constraints panic-in-EnterCmdStartData
+
 #
 # string cat
 bigtest string-cat-bigdata-1 "string cat large small result > INT_MAX" 1 -body {
@@ -139,9 +163,8 @@ bigtest string-cat-bigdata-3 "string cat result > UINT_MAX" 1 -body {
 bigtestRO string-equal/compare-bigdata-1 "string compare/equal equal strings" {0 1} -body {
     list [string compare $s1 $s2] [string equal $s1 $s2]
 } -setup {
-    set len [expr {$::bigLengths(intmax)+1}]
-    set s1 [bigString $len]
-    set s2 [bigString $len]; # Use separate string to avoid Tcl_Obj * being same
+    set s1 [bigString 0x100000000]
+    set s2 [bigString 0x100000000]; # Separate so Tcl_Obj is not the same
 } -cleanup {
     bigClean
 }
@@ -152,15 +175,14 @@ bigtestRO string-equal/compare-bigdata-2 "string compare/equal -length unequal s
     lappend result [string equal $s1 $s2]
     # Check lengths > UINT_MAX
     # Also that lengths do not truncate to sizeof(int)
-    lappend result [string compare -length $len $s1 $s2]
-    lappend result [string equal -length $len $s1 $s2]
+    lappend result [string compare -length 0x100000000 $s1 $s2]
+    lappend result [string equal -length 0x100000000 $s1 $s2]
 } -setup {
-    set len [expr {$::bigLengths(uintmax)+2}]
-    set s1 [bigString $len]
-    set s2 [bigString $len $len]; # Differs in last char
+    set s1 [bigString 0x100000001]
+    set s2 [bigString 0x100000001 0x100000000]; # Differs in last char
 } -cleanup {
     bigClean
-} -constraints bug-a814ee5bbd
+}
 
 #
 # string first
@@ -174,7 +196,7 @@ bigtestRO string-first-bigdata-1 "string first > INT_MAX" {2147483648 -1 2147483
     set s [bigString 0x8000000a 0x80000000]
 } -cleanup {
     bigClean
-} -constraints bug-a814ee5bbd
+}
 
 bigtestRO string-first-bigdata-2 "string first > UINT_MAX" {4294967296 -1 4294967300 1} -body {
     list \
@@ -186,7 +208,7 @@ bigtestRO string-first-bigdata-2 "string first > UINT_MAX" {4294967296 -1 429496
     set s [bigString 0x10000000a 0x100000000]
 } -cleanup {
     bigClean
-} -constraints bug-a814ee5bbd
+}
 
 bigtestRO string-first-bigdata-3 "string first - long needle" 10 -body {
     string first $needle $s
@@ -195,7 +217,7 @@ bigtestRO string-first-bigdata-3 "string first - long needle" 10 -body {
     set needle [bigString 0x100000000]
 } -cleanup {
    bigClean needle
-} -constraints bug-a814ee5bbd
+}
 
 #
 # string index
@@ -252,8 +274,7 @@ bigtestRO string-last-bigdata-1 "string last > INT_MAX" {2 -1 2147483640 11} -bo
     set s [bigString 0x80000010 2]
 } -cleanup {
     bigClean
-} -constraints bug-a814ee5bbd
-
+}
 bigtestRO string-last-bigdata-2 "string last > UINT_MAX" {4294967300 -1 4294967290 1} -body {
     list \
         [string last 0 $s] \
@@ -264,8 +285,7 @@ bigtestRO string-last-bigdata-2 "string last > UINT_MAX" {4294967300 -1 42949672
     set s [bigString 0x10000000a 2]
 } -cleanup {
     bigClean
-} -constraints bug-a814ee5bbd
-
+}
 bigtestRO string-last-bigdata-3 "string last - long needle" 0 -body {
     string last $needle $s
 } -setup {
@@ -273,7 +293,7 @@ bigtestRO string-last-bigdata-3 "string last - long needle" 0 -body {
     set needle [bigString 0x100000000]
 } -cleanup {
     bigClean needle
-} -constraints bug-a814ee5bbd
+}
 
 #
 # string length
@@ -331,8 +351,18 @@ bigtestRO string-range-bigdata-1 "string range" {6 7 5 {} 5 4 {} 9 {}} -body {
     set s [bigString 0x10000000a]
 } -cleanup {
     bigClean
-} -constraints bug-ad9361fd20f0
-# TODO - once above bug is fixed, add tests for large result range
+}
+bigtestRO string-range-bigdata-2 "bug ad9361fd20 case 1" aXaaaa -body {
+    string range [string insert [string repeat a 0x80000000] end-0x7fffffff X] 0 5
+}
+bigtestRO string-range-bigdata-3 "bug ad9361fd20 case 2" 2 -body {
+    string length [string range $s end-0x7fffffff end-0x7ffffffe]
+} -setup {
+    set s [string repeat a 0xffffffff]
+} -cleanup {
+    bigClean
+}
+# TODO - add tests for large result range
 
 #
 # string repeat - use bigtest, not bigtestRO !!
@@ -363,8 +393,8 @@ bigtestRO string-replace-bigdata-1 "string replace" {789012345 012345678 XYZ7890
     set s [bigString 0x10000000a]
 } -cleanup {
     bigClean
-} -constraints bug-ad9361fd20f0
-# TODO - once above bug is fixed, add tests for large result range:
+}
+# TODO -
 # - replacements string is large
 # - replace in the middle - string length grows, shrinks
 # - last < first
@@ -550,7 +580,7 @@ bigtestRO format-bigdata-1 "format %s" 1 -body {
     set s [bigString 0x100000000]
 } -cleanup {
     bigClean
-} -constraints bug-a550f9710b
+}
 bigtest format-bigdata-2 "format bigstring%s" 1 -body {
     set s [format $s X]
     string equal $s [bigString 0x100000001 0x100000000]
@@ -559,24 +589,71 @@ bigtest format-bigdata-2 "format bigstring%s" 1 -body {
     append s %s
 } -cleanup {
     bigClean
-} -constraints bug-a550f9710b
-# TODO - once above bugs fixed, add tests for width and precision
+}
+bigtest format-bigdata-3 "format big width" {4294967300 {    } {   a}} -body {
+    set s [format %4294967300s a]
+    list [string length $s] [string range $s 0 3] [string range $s end-3 end]
+} -cleanup {
+    bigClean
+}
+bigtest format-bigdata-4 "format big negative width" {4294967300 {a   } {    }} -body {
+    set s [format %-4294967300s a]
+    list [string length $s] [string range $s 0 3] [string range $s end-3 end]
+} -cleanup {
+    bigClean
+}
+bigtest format-bigdata-5 "format big * width" {4294967300 {    } {   a}} -body {
+    set s [format %*s 4294967300 a]
+    list [string length $s] [string range $s 0 3] [string range $s end-3 end]
+} -cleanup {
+    bigClean
+}
+bigtest format-bigdata-6 "format big negative * width" {4294967300 {a   } {    }} -body {
+    set s [format %*s -4294967300 a]
+    list [string length $s] [string range $s 0 3] [string range $s end-3 end]
+} -cleanup {
+    bigClean
+}
+bigtestRO format-bigdata-7 "format big precision" {4294967300 0123 6789} -body {
+    # Unset explicitly before setting to save memory as bigtestRO runs the
+    # script below twice.
+    unset -nocomplain s2
+    set s2 [format %.4294967300s $s]
+    list [string length $s2] [string range $s2 0 3] [string range $s2 end-3 end]
+} -setup {
+    set s [testbigdata string 4294967310]
+} -cleanup {
+    bigClean
+}
+bigtestRO format-bigdata-8 "format big * precision" {4294967300 0123 6789} -body {
+    # Unset explicitly before setting to save memory as bigtestRO runs the
+    # script below twice.
+    unset -nocomplain s2
+    set s2 [format %.*s 4294967300 $s]
+    list [string length $s2] [string range $s2 0 3] [string range $s2 end-3 end]
+} -setup {
+    set s [testbigdata string 4294967310]
+} -cleanup {
+    bigClean
+}
 
 #
 # scan
-bigtestRO scan-bigdata-1 "scan %s" {1 1 2 1} -body {
+bigtestRO scan-bigdata-1 "scan %s" {1 1 2 X 1 2 4294967300 01234X} -body {
     # Unset explicitly before setting to save memory as bigtestRO runs the
     # script below twice.
-    unset -nocomplain result digits
+    unset -nocomplain result digits x
     lappend result [string equal [scan $s %s] $s]
     lappend result [string equal [scan $s {%[0-9X]}] $s]
     lappend result [scan $s {%[0-9]%s} digits x] $x
-    lappend result [string equal $digits [bigString 0x100000008]]
+    lappend result [string equal $digits [bigString 0x100000009]]
+    lappend result [scan $s %4294967300s%s x y]
+    lappend result [string length $x] $y
 } -setup {
     set s [bigString 0x10000000a 0x100000009]
 } -cleanup {
     bigClean digits
-} -constraints bug-d4ede611a7
+}
 
 #
 # regexp
@@ -635,16 +712,16 @@ bigtestRO subst-bigdata-1 "subst" {1 1} -body {
 
 #
 # binary format
-bigtestRO binary-format-bigdata-1 "binary format aN" 4294967296 -body {
+bigtestRO binary-format-bigdata-1 "binary format aN" [list 4294967296  X\0\0\0 \0\0\0\0] -body {
     # Unset explicitly before setting to save memory as bigtestRO runs the
     # script below twice.
     unset -nocomplain bin
     set bin [binary format a4294967296 X]
-    string length $bin
+    list [string length $bin] [string range $bin 0 3] [string range $bin end-3 end]
 } -cleanup {
     bigClean
-} -constraints bug-9369f83649
-# TODO - do string compare and add other format specifiers once above bug is fixed
+}
+# TODO - do string compare and add other format specifiers
 
 bigtestRO binary-format-bigdata-2 "binary format a*" 1 -body {
     # Unset explicitly before setting to save memory as bigtestRO runs the
@@ -660,17 +737,17 @@ bigtestRO binary-format-bigdata-2 "binary format a*" 1 -body {
 
 #
 # binary scan
-bigtestRO binary-scan-bigdata-1 "binary scan aN" 4294967296 -body {
+bigtestRO binary-scan-bigdata-1 "binary scan aN" {4294967296 0123 2345} -body {
     # Unset explicitly before setting to save memory as bigtestRO runs the
     # script below twice.
     unset -nocomplain bin2
     binary scan $bin a4294967296 bin2
-    string length $bin2
+    list [string length $bin2] [string range $bin2 0 3] [string range $bin2 end-3 end]
 } -setup {
     set bin [bigBinary 4294967296]
 } -cleanup {
     bigClean
-} -constraints bug-9369f83649
+}
 # TODO - do string compare and add other format specifiers once above bug is fixed
 
 bigtestRO binary-scan-bigdata-2 "binary scan a*" 1 -body {
@@ -696,7 +773,7 @@ bigtestRO binary-encode/decode-base64-bigdata-1 "binary encode/decode base64" 1
     set bin [bigBinary 4294967296]
 } -cleanup {
     bigClean
-} -constraints bug-c719fa8716
+}
 
 #
 # binary encode / decode hex
@@ -718,7 +795,7 @@ bigtestRO binary-encode/decode-uuencode-bigdata-1 "binary encode/decode uuencode
     set bin [bigBinary 4294967296]
 } -cleanup {
     bigClean
-} -constraints bug-2e3fed53ba
+}
 
 ################################################################
 # List commands
@@ -782,14 +859,15 @@ bigtest ledit-bigdata-2 "ledit - large result" {4294967304 4294967304 {a b c d e
     bigClean
 }
 
-bigtest ledit-bigdata-3 "ledit - small -> large result" {2147483651 2147483651} -body {
-    set l2 {a b c x y z}
-    list [llength [ledit l2 2 3 {*}$l]] [llength $l2]
+bigtest ledit-bigdata-3 "ledit - small -> large result" {2147483650 2147483650 {a b 0 1 2 3 4 5} {0 1 e f g h i j}} -body {
+    set l2 {a b c d e f g h i j}
+    list [llength [ledit l2 2 3 {*}$l]] [llength $l2] [lrange $l2 0 7] [lrange $l2 end-7 end]
 } -setup {
-    set l [bigList 2147483647]
+    # Note total number of arguments has to be less than INT_MAX
+    set l [bigList 2147483642]
 } -cleanup {
     bigClean
-} -constraints bug-7cddd2845c
+} -constraints memory-allocation-panic
 
 #
 # lindex
@@ -808,8 +886,8 @@ bigtestRO lindex-bigdata-1 "lindex" {6 7 5 {} 5 4 {} 9 {}} -body {
     set l [bigList 0x10000000a]
 } -cleanup {
     bigClean
-} -constraints bug-dcac54a685
-# TODO after bug fix - nested index
+}
+# TODO nested index
 
 #
 # linsert
@@ -831,15 +909,25 @@ bigtest linsert-bigdata-1 "linsert" {4294967330 1} -body {
 
 #
 # list and {*}
-bigtestRO list-bigdata-1 {list {*} } {4294967296 0 4294967295} -body {
-    unset -nocomplain l2
-    set l2 [list {*}$l]
-    list [llength $l2] [lindex $l2 0] [lindex $l2 end]
-} -setup {
+# TODO - compiled and uncompiled behave differently so tested separately
+test list-bigdata-1.compiled {list {*}}  -body {
     set l [bigList 0x100000000]
+    set l2 [list {*}$l]
+    unset l
+    list [llength $l2] [lindex $l2 0] [lindex $l2 end]
 } -cleanup {
     bigClean
-} -constraints bug-7cddd2845c
+} -constraints {
+    bigdata
+} -result {4294967296 0 5}
+test list-bigdata-1.uncompiled {list {*}}  -body {
+    set l [bigList 0x7fffffff]
+    testevalex {set l2 [list {*}$l]}
+} -cleanup {
+    bigClean
+} -constraints {
+    bigdata
+} -result {Number of words in command exceeds limit 2147483647.} -returnCodes error
 
 #
 # llength
@@ -871,9 +959,10 @@ bigtestRO lmap-bigdata-1 "lmap" 4294967296 -body {
 
 #
 # lrange
-bigtestRO lrange-bigdata-1 "lrange" {6 7 5 {} 5 4 {} 9 {}} -body {
+bigtestRO lrange-bigdata-1 "lrange" {6 {6 7} 7 5 {} 5 4 {} 9 {8 9} {}} -body {
     list \
         [lrange $l 0x100000000 0x100000000] \
+        [lrange $l 0x100000000 0x100000001] \
         [lrange $l 0x100000000+1 0x100000000+1] \
         [lrange $l 0x100000000-1 0x100000000-1] \
         [lrange $l 0x10000000a 0x10000000a] \
@@ -881,13 +970,14 @@ bigtestRO lrange-bigdata-1 "lrange" {6 7 5 {} 5 4 {} 9 {}} -body {
         [lrange $l end-1 end-1] \
         [lrange $l end+1 end+1] \
         [lrange $l end-0x100000000 end-0x100000000] \
+        [lrange $l end-0x100000001 end-0x100000000] \
         [lrange $l end-0x10000000a end-0x10000000a]
 } -setup {
     set l [bigList 0x10000000a]
 } -cleanup {
     bigClean
-} -constraints bug-dcac54a685
-# TODO - once above bug is fixed, add tests for large result range
+}
+# TODO - add tests for large result range
 
 #
 # lrepeat - use bigtest, not bigtestRO !!
@@ -1021,6 +1111,40 @@ bigtestRO concat-bigdata-1 "concat" {4294967296 {0 1 2 3 4} {6 7 0 1 2} {3 4 5 6
     set l [bigList 0x80000000]
 }
 
+test puts-bigdata-1 "puts" -setup {
+    set fpath [makeFile {} bug-0306a5563.data]
+} -constraints {
+    bigdata
+} -body {
+    set fd [open $fpath w]
+    puts -nonewline $fd [testbigdata string 0x80000001]
+    close $fd
+    set fd [open $fpath]
+    seek $fd 0x7FFFFFFA
+    set written [read $fd]
+    close $fd
+    set written
+} -result {2345678}
+
+test puts-bigdata-2 "puts" -setup {
+    set fpath [tcltest::makeFile {} bug-0306a5563.data]
+} -constraints {
+    bigdata
+} -body {
+    set fd [open $fpath w]
+    set s [testbigdata string 0x7FFFFFFE]
+    # The character to append in the next line is —, EM DASH,
+    # code point 0x2014 (decimal 8212, UTF-8 #xE2 #x80 #x94)
+    append s \u2014
+    puts -nonewline $fd $s
+    close $fd
+    set fd [open $fpath]
+    seek $fd 0x7FFFFFFA
+    set written [read $fd]
+    close $fd
+    set written
+} -result {2345—}
+
 #
 # TODO
 # lremove

tests/binary.test

@@ -15,11 +15,14 @@ if {"::tcltest" ni [namespace children]} {
     namespace import -force ::tcltest::*
 }
 ::tcltest::loadTestedCommands
+source [file join [file dirname [info script]] tcltests.tcl]
+
 catch [list package require -exact tcl::test [info patchlevel]]
 
 testConstraint bigEndian [expr {$tcl_platform(byteOrder) eq "bigEndian"}]
 testConstraint littleEndian [expr {$tcl_platform(byteOrder) eq "littleEndian"}]
 testConstraint testbytestring [llength [info commands testbytestring]]
+testConstraint pointerIs64bit [expr {$tcl_platform(pointerSize) >= 8}]
 
 # Big test for correct ordering of data in [expr]
 proc testIEEE {} {
@@ -3039,6 +3042,9 @@ test binary-80.3 {Tcl_GetBytesFromObj} -constraints testbytestring -returnCodes
 test binary-80.4 {Tcl_GetBytesFromObj} -constraints testbytestring -returnCodes 1 -body {
     testbytestring [testbytestring "\xC0\x80\xA0\xA0\xA0\xF0\x9F\x98\x81"]
 } -result "expected byte sequence but character 4 was '\U01F601' (U+01F601)"
+test binary-80.5 {Tcl_GetBytesFromObj} -constraints testbytestring -constraints {pointerIs64bit deprecated} -body {
+    testbytestring [string repeat A [expr 2**31]]
+} -returnCodes 1 -result "byte sequence length exceeds INT_MAX"
 
 # ----------------------------------------------------------------------
 # cleanup

tests/io.test

@@ -9512,7 +9512,7 @@ test io-75.14 {
     lappend res [gets $chan]
     set status [catch {gets $chan} cres copts]
     lappend res $status $cres
-    chan configure $chan -profile tcl8 
+    chan configure $chan -profile tcl8
     lappend res [gets $chan]
     lappend res [gets $chan]
     close $chan

tests/lseq.test

@@ -19,7 +19,7 @@ testConstraint arithSeriesShimmer 1
 testConstraint arithSeriesShimmerOk 1
 testConstraint has64BitLengths [expr {$tcl_platform(pointerSize) == 8}]
 
-## Arg errors
+# Arg errors
 test lseq-1.1 {error cases} -body {
     lseq
 } \
@@ -416,9 +416,9 @@ test lseq-3.30 {lreverse with double values} arithSeriesDouble {
 arithseries
 18.5 17.0 15.5 14.0 12.5 11.0 9.5 8.0 6.5 5.0 3.5}
 
-test lseq-3.31 {lreverse inplace with doubles} arithSeriesDouble {
+test lseq-3.31 {lreverse inplace with doubles} {arithSeriesDouble has64BitLengths} {
     lreverse [lseq 1.1 29.9 0.3]
-} {29.9 29.599999999999998 29.299999999999997 29.0 28.7 28.4 28.099999999999998 27.799999999999997 27.5 27.2 26.9 26.599999999999998 26.299999999999997 26.0 25.7 25.4 25.099999999999998 24.799999999999997 24.5 24.2 23.9 23.599999999999998 23.299999999999997 23.0 22.7 22.4 22.099999999999998 21.799999999999997 21.5 21.2 20.9 20.6 20.299999999999997 20.0 19.7 19.4 19.1 18.799999999999997 18.5 18.2 17.9 17.6 17.299999999999997 17.0 16.7 16.4 16.1 15.799999999999999 15.5 15.2 14.899999999999999 14.6 14.299999999999999 14.0 13.7 13.399999999999999 13.099999999999998 12.8 12.5 12.2 11.899999999999999 11.599999999999998 11.3 11.0 10.7 10.399999999999999 10.099999999999998 9.8 9.5 9.2 8.899999999999999 8.599999999999998 8.3 8.0 7.699999999999999 7.399999999999999 7.099999999999998 6.800000000000001 6.5 6.199999999999999 5.899999999999999 5.599999999999998 5.300000000000001 5.0 4.699999999999999 4.399999999999999 4.099999999999998 3.8000000000000007 3.5 3.1999999999999993 2.8999999999999986 2.599999999999998 2.3000000000000007 2.0 1.6999999999999993 1.3999999999999986 1.1000000000000014}
+} {29.9 29.6 29.3 29.0 28.7 28.4 28.1 27.8 27.5 27.2 26.9 26.6 26.3 26.0 25.7 25.4 25.1 24.8 24.5 24.2 23.9 23.6 23.3 23.0 22.7 22.4 22.1 21.8 21.5 21.2 20.9 20.6 20.3 20.0 19.7 19.4 19.1 18.8 18.5 18.2 17.9 17.6 17.3 17.0 16.7 16.4 16.1 15.8 15.5 15.2 14.9 14.6 14.3 14.0 13.7 13.4 13.1 12.8 12.5 12.2 11.9 11.6 11.3 11.0 10.7 10.4 10.1 9.8 9.5 9.2 8.9 8.6 8.3 8.0 7.7 7.4 7.1 6.8 6.5 6.2 5.9 5.6 5.3 5.0 4.7 4.4 4.1 3.8 3.5 3.2 2.9 2.6 2.3 2.0 1.7 1.4 1.1}
 
 test lseq-4.1 {end expressions} {
     set start 7
@@ -538,12 +538,12 @@ test lseq-4.8 {error case lrange} -body {
 } -returnCodes 1 \
     -result {bad index "fred": must be integer?[+-]integer? or end?[+-]integer?}
 
-test lseq-4.9 {error case lrange} -body {
-    set fred 7
-    set ginger 8
-    lrange [lseq 1 5] $fred $ginger
-} -returnCodes 1 \
-    -result {index 7 is out of bounds 0 to 4}
+test lseq-4.9 {lrange empty/partial sets} -body {
+    foreach {fred ginger} {7 8 4 9 0 15 9 9 4 2} {
+        lappend res [lrange [lseq 1 5] $fred $ginger]
+    }
+    set res
+} -result {{} 5 {1 2 3 4 5} {} {}}
 
 # Panic when using variable value?
 test lseq-4.10 {panic using variable index} {
@@ -551,6 +551,39 @@ test lseq-4.10 {panic using variable index} {
     lindex [lseq 10] $i
 } {0}
 
+test lseq-4.11 {bug lseq / lindex discrepancies} -constraints has64BitLengths -body {
+    lindex [lseq 0x7fffffff] 0x80000000
+} -result {}
+
+test lseq-4.12 {bug lseq} -constraints has64BitLengths -body {
+    llength [lseq 0x100000000]
+} -result {4294967296}
+
+test lseq-4.13 {bug lseq} -constraints has64BitLengths -body {
+    set l [lseq 0x7fffffffffffffff]
+    list \
+    [llength $l] \
+    [lindex $l end] \
+        [lindex $l 9223372036854775800]
+} -result {9223372036854775807 9223372036854775806 9223372036854775800}
+
+
+test lseq-4.14 {bug lseq - inconsistent rounding} has64BitLengths {
+    # using a non-integer increment, [lseq] rounding seems to be not consistent:
+    lseq 4 40 0.1
+} {4.0 4.1 4.2 4.3 4.4 4.5 4.6 4.7 4.8 4.9 5.0 5.1 5.2 5.3 5.4 5.5 5.6 5.7 5.8 5.9 6.0 6.1 6.2 6.3 6.4 6.5 6.6 6.7 6.8 6.9 7.0 7.1 7.2 7.3 7.4 7.5 7.6 7.7 7.8 7.9 8.0 8.1 8.2 8.3 8.4 8.5 8.6 8.7 8.8 8.9 9.0 9.1 9.2 9.3 9.4 9.5 9.6 9.7 9.8 9.9 10.0 10.1 10.2 10.3 10.4 10.5 10.6 10.7 10.8 10.9 11.0 11.1 11.2 11.3 11.4 11.5 11.6 11.7 11.8 11.9 12.0 12.1 12.2 12.3 12.4 12.5 12.6 12.7 12.8 12.9 13.0 13.1 13.2 13.3 13.4 13.5 13.6 13.7 13.8 13.9 14.0 14.1 14.2 14.3 14.4 14.5 14.6 14.7 14.8 14.9 15.0 15.1 15.2 15.3 15.4 15.5 15.6 15.7 15.8 15.9 16.0 16.1 16.2 16.3 16.4 16.5 16.6 16.7 16.8 16.9 17.0 17.1 17.2 17.3 17.4 17.5 17.6 17.7 17.8 17.9 18.0 18.1 18.2 18.3 18.4 18.5 18.6 18.7 18.8 18.9 19.0 19.1 19.2 19.3 19.4 19.5 19.6 19.7 19.8 19.9 20.0 20.1 20.2 20.3 20.4 20.5 20.6 20.7 20.8 20.9 21.0 21.1 21.2 21.3 21.4 21.5 21.6 21.7 21.8 21.9 22.0 22.1 22.2 22.3 22.4 22.5 22.6 22.7 22.8 22.9 23.0 23.1 23.2 23.3 23.4 23.5 23.6 23.7 23.8 23.9 24.0 24.1 24.2 24.3 24.4 24.5 24.6 24.7 24.8 24.9 25.0 25.1 25.2 25.3 25.4 25.5 25.6 25.7 25.8 25.9 26.0 26.1 26.2 26.3 26.4 26.5 26.6 26.7 26.8 26.9 27.0 27.1 27.2 27.3 27.4 27.5 27.6 27.7 27.8 27.9 28.0 28.1 28.2 28.3 28.4 28.5 28.6 28.7 28.8 28.9 29.0 29.1 29.2 29.3 29.4 29.5 29.6 29.7 29.8 29.9 30.0 30.1 30.2 30.3 30.4 30.5 30.6 30.7 30.8 30.9 31.0 31.1 31.2 31.3 31.4 31.5 31.6 31.7 31.8 31.9 32.0 32.1 32.2 32.3 32.4 32.5 32.6 32.7 32.8 32.9 33.0 33.1 33.2 33.3 33.4 33.5 33.6 33.7 33.8 33.9 34.0 34.1 34.2 34.3 34.4 34.5 34.6 34.7 34.8 34.9 35.0 35.1 35.2 35.3 35.4 35.5 35.6 35.7 35.8 35.9 36.0 36.1 36.2 36.3 36.4 36.5 36.6 36.7 36.8 36.9 37.0 37.1 37.2 37.3 37.4 37.5 37.6 37.7 37.8 37.9 38.0 38.1 38.2 38.3 38.4 38.5 38.6 38.7 38.8 38.9 39.0 39.1 39.2 39.3 39.4 39.5 39.6 39.7 39.8 39.9 40.0}
+
+test lseq-4.15 {bug lseq - inconsistent rounding} has64BitLengths {
+    # using a non-integer increment, [lseq] rounding seems to be not consistent:
+    lseq 6 40 0.1
+} {6.0 6.1 6.2 6.3 6.4 6.5 6.6 6.7 6.8 6.9 7.0 7.1 7.2 7.3 7.4 7.5 7.6 7.7 7.8 7.9 8.0 8.1 8.2 8.3 8.4 8.5 8.6 8.7 8.8 8.9 9.0 9.1 9.2 9.3 9.4 9.5 9.6 9.7 9.8 9.9 10.0 10.1 10.2 10.3 10.4 10.5 10.6 10.7 10.8 10.9 11.0 11.1 11.2 11.3 11.4 11.5 11.6 11.7 11.8 11.9 12.0 12.1 12.2 12.3 12.4 12.5 12.6 12.7 12.8 12.9 13.0 13.1 13.2 13.3 13.4 13.5 13.6 13.7 13.8 13.9 14.0 14.1 14.2 14.3 14.4 14.5 14.6 14.7 14.8 14.9 15.0 15.1 15.2 15.3 15.4 15.5 15.6 15.7 15.8 15.9 16.0 16.1 16.2 16.3 16.4 16.5 16.6 16.7 16.8 16.9 17.0 17.1 17.2 17.3 17.4 17.5 17.6 17.7 17.8 17.9 18.0 18.1 18.2 18.3 18.4 18.5 18.6 18.7 18.8 18.9 19.0 19.1 19.2 19.3 19.4 19.5 19.6 19.7 19.8 19.9 20.0 20.1 20.2 20.3 20.4 20.5 20.6 20.7 20.8 20.9 21.0 21.1 21.2 21.3 21.4 21.5 21.6 21.7 21.8 21.9 22.0 22.1 22.2 22.3 22.4 22.5 22.6 22.7 22.8 22.9 23.0 23.1 23.2 23.3 23.4 23.5 23.6 23.7 23.8 23.9 24.0 24.1 24.2 24.3 24.4 24.5 24.6 24.7 24.8 24.9 25.0 25.1 25.2 25.3 25.4 25.5 25.6 25.7 25.8 25.9 26.0 26.1 26.2 26.3 26.4 26.5 26.6 26.7 26.8 26.9 27.0 27.1 27.2 27.3 27.4 27.5 27.6 27.7 27.8 27.9 28.0 28.1 28.2 28.3 28.4 28.5 28.6 28.7 28.8 28.9 29.0 29.1 29.2 29.3 29.4 29.5 29.6 29.7 29.8 29.9 30.0 30.1 30.2 30.3 30.4 30.5 30.6 30.7 30.8 30.9 31.0 31.1 31.2 31.3 31.4 31.5 31.6 31.7 31.8 31.9 32.0 32.1 32.2 32.3 32.4 32.5 32.6 32.7 32.8 32.9 33.0 33.1 33.2 33.3 33.4 33.5 33.6 33.7 33.8 33.9 34.0 34.1 34.2 34.3 34.4 34.5 34.6 34.7 34.8 34.9 35.0 35.1 35.2 35.3 35.4 35.5 35.6 35.7 35.8 35.9 36.0 36.1 36.2 36.3 36.4 36.5 36.6 36.7 36.8 36.9 37.0 37.1 37.2 37.3 37.4 37.5 37.6 37.7 37.8 37.9 38.0 38.1 38.2 38.3 38.4 38.5 38.6 38.7 38.8 38.9 39.0 39.1 39.2 39.3 39.4 39.5 39.6 39.7 39.8 39.9 40.0}
+
+test lseq-4.16 {bug lseq - inconsistent rounding} {
+    # using a non-integer increment, [lseq] rounding seems to be not consistent:
+    set res {}
+    lappend res [lseq 4.07 6 0.1]
+    lappend res [lseq 4.03 4.208 0.013]
+} {{4.07 4.17 4.27 4.37 4.47 4.57 4.67 4.77 4.87 4.97 5.07 5.17 5.27 5.37 5.47 5.57 5.67 5.77 5.87 5.97} {4.03 4.043 4.056 4.069 4.082 4.095 4.108 4.121 4.134 4.147 4.16 4.173 4.186 4.199}}
 
 # cleanup
 ::tcltest::cleanupTests

tests/scan.test

@@ -858,6 +858,12 @@ test scan-13.8 {Tcl_ScanObjCmd, inline XPG case lots of arguments} {
     set msg [scan "10 20 30" {%100$d %5$d %200$d}]
     list [llength $msg] [lindex $msg 99] [lindex $msg 4] [lindex $msg 199]
 } {200 10 20 30}
+test scan-13.9 {Tcl_ScanObjCmd, inline XPG case limit error} -body {
+    # Note this applies to 64-bit builds as well so long as max number of
+    # command line arguments allowed for scan command is INT_MAX
+    scan abc {%2147483648$s}
+} -result {"%n$" argument index out of range} -returnCodes error
+
 
 # scan infinities - not working
 

tests/string.test

@@ -2433,11 +2433,11 @@ test string-29.11.$noComp {string cat, efficiency} -body {
 test string-29.12.$noComp {string cat, efficiency} -body {
     tcl::unsupported::representation \
 	[run {string cat [encoding convertto utf-8 {}] [list x]}]
-} -match glob -result {*, string representation "x"}
+} -match glob -result {*, no string representation}
 test string-29.13.$noComp {string cat, efficiency} -body {
     tcl::unsupported::representation [run {string cat \
 	[encoding convertto utf-8 {}] [encoding convertto utf-8 {}] [list x]}]
-} -match glob -result {*, string representation "x"}
+} -match glob -result {*, no string representation}
 test string-29.14.$noComp {string cat, efficiency} -setup {
     set e [encoding convertto utf-8 {}]
 } -cleanup {

tests/stringObj.test

@@ -517,7 +517,7 @@ test stringObj-16.9 {Tcl_GetRange: last = INT_MAX-1} testobj {
 } bcde
 test stringObj-16.10 {Tcl_GetRange: last = SIZE_MAX-1} testobj {
     teststringobj set 1 abcde
-    teststringobj range 1 1 [expr {$SIZE_MAX - 1}] 
+    teststringobj range 1 1 [expr {$SIZE_MAX - 1}]
 } bcde
 test stringObj-16.11 {Tcl_GetRange: first = last = INT_MAX-1} testobj {
     teststringobj set 1 abcde

tests/tailcall.test

@@ -708,6 +708,13 @@ test tailcall-14.1-bc {{in a deleted namespace} {byte compiled}} -body {
     }
 } -returnCodes 1 -result {namespace "::ns" not found}
 
+test tailcall-bug-784befb0ba {tailcall crash with 254 args} -body {
+    proc tccrash args {llength $args}
+    # Must be EXACTLY 254 for crash
+    proc p {} [list tailcall tccrash {*}[lrepeat 254 x]]
+    p
+} -result 254
+
 # cleanup
 ::tcltest::cleanupTests
 

unix/Makefile.in

@@ -314,7 +314,7 @@ GENERIC_OBJS = regcomp.o regexec.o regfree.o regerror.o tclAlloc.o \
 	tclPreserve.o tclProc.o tclProcess.o tclRegexp.o \
 	tclResolve.o tclResult.o tclScan.o tclStringObj.o \
 	tclStrToD.o tclThread.o \
-	tclThreadAlloc.o tclThreadJoin.o tclThreadStorage.o tclStubInit.o \
+	tclThreadAlloc.o tclThreadStorage.o tclStubInit.o \
 	tclTimer.o tclTrace.o tclUtf.o tclUtil.o tclVar.o tclZlib.o \
 	tclTomMathInterface.o tclZipfs.o
 
@@ -472,7 +472,6 @@ GENERIC_SRCS = \
 	$(GENERIC_DIR)/tclTestProcBodyObj.c \
 	$(GENERIC_DIR)/tclThread.c \
 	$(GENERIC_DIR)/tclThreadAlloc.c \
-	$(GENERIC_DIR)/tclThreadJoin.c \
 	$(GENERIC_DIR)/tclThreadStorage.c \
 	$(GENERIC_DIR)/tclTimer.c \
 	$(GENERIC_DIR)/tclTrace.c \
@@ -1574,9 +1573,6 @@ tclThread.o: $(GENERIC_DIR)/tclThread.c
 tclThreadAlloc.o: $(GENERIC_DIR)/tclThreadAlloc.c
 	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclThreadAlloc.c
 
-tclThreadJoin.o: $(GENERIC_DIR)/tclThreadJoin.c
-	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclThreadJoin.c
-
 tclThreadStorage.o: $(GENERIC_DIR)/tclThreadStorage.c
 	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclThreadStorage.c
 

unix/dltest/pkgt.c

@@ -16,10 +16,10 @@
 static int TraceProc2 (
     void *clientData,
     Tcl_Interp *interp,
-    ptrdiff_t level,
+    Tcl_Size level,
     const char *command,
     Tcl_Command commandInfo,
-    ptrdiff_t objc,
+    Tcl_Size objc,
     struct Tcl_Obj *const *objv)
 {
     (void)clientData;
@@ -55,12 +55,12 @@ static int
 Pkgt_EqObjCmd2(
     void *dummy,		/* Not used. */
     Tcl_Interp *interp,		/* Current interpreter. */
-    ptrdiff_t objc,			/* Number of arguments. */
+    Tcl_Size objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
     Tcl_WideInt result;
     const char *str1, *str2;
-    ptrdiff_t len1, len2;
+    Tcl_Size len1, len2;
     (void)dummy;
 
     if (objc != 3) {

unix/tclUnixInit.c

@@ -546,8 +546,8 @@ TclpInitLibraryPath(
     *encodingPtr = Tcl_GetEncoding(NULL, NULL);
 
     /*
-     * Note lengthPtr is (TCL_HASH_TYPE *) which is unsigned so cannot 
-     * pass directly to Tcl_GetStringFromObj. 
+     * Note lengthPtr is (TCL_HASH_TYPE *) which is unsigned so cannot
+     * pass directly to Tcl_GetStringFromObj.
      * TODO - why is the type TCL_HASH_TYPE anyways?
      */
     Tcl_Size length;

win/Makefile.in

@@ -354,7 +354,6 @@ GENERIC_OBJS = \
 	tclStubInit.$(OBJEXT) \
 	tclThread.$(OBJEXT) \
 	tclThreadAlloc.$(OBJEXT) \
-	tclThreadJoin.$(OBJEXT) \
 	tclThreadStorage.$(OBJEXT) \
 	tclTimer.$(OBJEXT) \
 	tclTomMathInterface.$(OBJEXT) \

win/makefile.vc

@@ -310,7 +310,6 @@ COREOBJS = \
 	$(TMP_DIR)\tclStubInit.obj \
 	$(TMP_DIR)\tclThread.obj \
 	$(TMP_DIR)\tclThreadAlloc.obj \
-	$(TMP_DIR)\tclThreadJoin.obj \
 	$(TMP_DIR)\tclThreadStorage.obj \
 	$(TMP_DIR)\tclTimer.obj \
 	$(TMP_DIR)\tclTomMathInterface.obj \

win/rules.vc

@@ -887,12 +887,12 @@ TCL_BUILD_FOR = 8
 !message *** Force 64-bit time_t
 _USE_64BIT_TIME_T = 1
 !endif
+!endif
 
 !if [nmakehlp -f $(OPTS) "utf16"]
 !message *** Force UTF-16 internally
 TCL_UTF_MAX = 3
 !endif
-!endif
 
 # Yes, it's weird that the "symbols" option controls DEBUG and
 # the "pdbs" option controls SYMBOLS. That's historical.

win/tcl.dsp

@@ -1320,10 +1320,6 @@ SOURCE=..\generic\tclThread.c
 # End Source File
 # Begin Source File
 
-SOURCE=..\generic\tclThreadJoin.c
-# End Source File
-# Begin Source File
-
 SOURCE=..\generic\tclThreadTest.c
 # End Source File
 # Begin Source File

win/tclWinConsole.c

@@ -84,18 +84,11 @@ static int gInitialized = 0;
  * Ring buffer for storing data. Actual data is from bufPtr[start]:bufPtr[size-1]
  * and bufPtr[0]:bufPtr[length - (size-start)].
  */
-#if TCL_MAJOR_VERSION > 8
-typedef ptrdiff_t RingSizeT; /* Tcl9 TODO */
-#define RingSizeT_MAX PTRDIFF_MAX
-#else
-typedef int RingSizeT;
-#define RingSizeT_MAX INT_MAX
-#endif
 typedef struct RingBuffer {
     char *bufPtr;	/* Pointer to buffer storage */
-    RingSizeT capacity;	/* Size of the buffer in RingBufferChar */
-    RingSizeT start;	/* Start of the data within the buffer. */
-    RingSizeT length;	/* Number of RingBufferChar*/
+    Tcl_Size capacity;	/* Size of the buffer in RingBufferChar */
+    Tcl_Size start;	/* Start of the data within the buffer. */
+    Tcl_Size length;	/* Number of RingBufferChar*/
 } RingBuffer;
 #define RingBufferLength(ringPtr_) ((ringPtr_)->length)
 #define RingBufferHasFreeSpace(ringPtr_) ((ringPtr_)->length < (ringPtr_)->capacity)
@@ -234,16 +227,16 @@ static void	ConsoleWatchProc(void *instanceData, int mask);
 static void	ProcExitHandler(void *clientData);
 static void	ConsoleThreadActionProc(void *instanceData, int action);
 static DWORD	ReadConsoleChars(HANDLE hConsole, WCHAR *lpBuffer,
-		    RingSizeT nChars, RingSizeT *nCharsReadPtr);
+		    Tcl_Size nChars, Tcl_Size *nCharsReadPtr);
 static DWORD	WriteConsoleChars(HANDLE hConsole,
-		    const WCHAR *lpBuffer, RingSizeT nChars,
-		    RingSizeT *nCharsWritten);
-static void	RingBufferInit(RingBuffer *ringPtr, RingSizeT capacity);
+		    const WCHAR *lpBuffer, Tcl_Size nChars,
+		    Tcl_Size *nCharsWritten);
+static void	RingBufferInit(RingBuffer *ringPtr, Tcl_Size capacity);
 static void	RingBufferClear(RingBuffer *ringPtr);
-static RingSizeT	RingBufferIn(RingBuffer *ringPtr, const char *srcPtr,
-			    RingSizeT srcLen, int partialCopyOk);
-static RingSizeT	RingBufferOut(RingBuffer *ringPtr, char *dstPtr,
-			    RingSizeT dstCapacity, int partialCopyOk);
+static Tcl_Size	RingBufferIn(RingBuffer *ringPtr, const char *srcPtr,
+			    Tcl_Size srcLen, int partialCopyOk);
+static Tcl_Size	RingBufferOut(RingBuffer *ringPtr, char *dstPtr,
+			    Tcl_Size dstCapacity, int partialCopyOk);
 static ConsoleHandleInfo *AllocateConsoleHandleInfo(HANDLE consoleHandle,
 			    int permissions);
 static ConsoleHandleInfo *FindConsoleInfo(const ConsoleChannelInfo *);
@@ -331,9 +324,9 @@ static const Tcl_ChannelType consoleChannelType = {
  *------------------------------------------------------------------------
  */
 static void
-RingBufferInit(RingBuffer *ringPtr, RingSizeT capacity)
+RingBufferInit(RingBuffer *ringPtr, Tcl_Size capacity)
 {
-    if (capacity <= 0 || capacity > RingSizeT_MAX) {
+    if (capacity <= 0 || capacity > TCL_SIZE_MAX) {
 	Tcl_Panic("Internal error: invalid ring buffer capacity requested.");
     }
     ringPtr->bufPtr = (char *)Tcl_Alloc(capacity);
@@ -384,15 +377,15 @@ RingBufferClear(RingBuffer *ringPtr)
  *
  *------------------------------------------------------------------------
  */
-static RingSizeT
+static Tcl_Size
 RingBufferIn(
     RingBuffer *ringPtr,
     const char *srcPtr, /* Source to be copied */
-    RingSizeT srcLen,	  /* Length of source */
+    Tcl_Size srcLen,	  /* Length of source */
     int partialCopyOk 		  /* If true, partial copy is permitted */
     )
 {
-    RingSizeT freeSpace;
+    Tcl_Size freeSpace;
 
     RINGBUFFER_ASSERT(ringPtr);
 
@@ -407,8 +400,8 @@ RingBufferIn(
 
     if (ringPtr->capacity - ringPtr->start > ringPtr->length) {
 	/* There is room at the back */
-	RingSizeT endSpaceStart = ringPtr->start + ringPtr->length;
-	RingSizeT endSpace      = ringPtr->capacity - endSpaceStart;
+	Tcl_Size endSpaceStart = ringPtr->start + ringPtr->length;
+	Tcl_Size endSpace      = ringPtr->capacity - endSpaceStart;
 	if (endSpace >= srcLen) {
 	    /* Everything fits at the back */
 	    memmove(endSpaceStart + ringPtr->bufPtr, srcPtr, srcLen);
@@ -419,7 +412,7 @@ RingBufferIn(
 	}
     } else {
 	/* No room at the back. Existing data wrap to front. */
-	RingSizeT wrapLen =
+	Tcl_Size wrapLen =
 	    ringPtr->start + ringPtr->length - ringPtr->capacity;
 	memmove(wrapLen + ringPtr->bufPtr, srcPtr, srcLen);
     }
@@ -447,13 +440,13 @@ RingBufferIn(
  *
  *------------------------------------------------------------------------
  */
-static RingSizeT
+static Tcl_Size
 RingBufferOut(RingBuffer *ringPtr,
 	      char *dstPtr,	      /* Buffer for output data. May be NULL */
-	      RingSizeT dstCapacity,  /* Size of buffer */
+	      Tcl_Size dstCapacity,  /* Size of buffer */
 	      int partialCopyOk)      /* If true, return what's available */
 {
-    RingSizeT leadLen;
+    Tcl_Size leadLen;
 
     RINGBUFFER_ASSERT(ringPtr);
 
@@ -477,7 +470,7 @@ RingBufferOut(RingBuffer *ringPtr,
 	}
 	ringPtr->start += dstCapacity;
     } else {
-	RingSizeT wrapLen = dstCapacity - leadLen;
+	Tcl_Size wrapLen = dstCapacity - leadLen;
 	if (dstPtr) {
 	    memmove(dstPtr,
 		    ringPtr->start + ringPtr->bufPtr,
@@ -529,8 +522,8 @@ static DWORD
 ReadConsoleChars(
     HANDLE hConsole,
     WCHAR *lpBuffer,
-    RingSizeT nChars,
-    RingSizeT *nCharsReadPtr)
+    Tcl_Size nChars,
+    Tcl_Size *nCharsReadPtr)
 {
     DWORD nRead;
     BOOL result;
@@ -589,8 +582,8 @@ static DWORD
 WriteConsoleChars(
     HANDLE hConsole,
     const WCHAR *lpBuffer,
-    RingSizeT nChars,
-    RingSizeT *nCharsWrittenPtr)
+    Tcl_Size nChars,
+    Tcl_Size *nCharsWrittenPtr)
 {
     DWORD nCharsWritten;
     BOOL result;
@@ -1090,7 +1083,7 @@ ConsoleInputProc(
 {
     ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData;
     ConsoleHandleInfo *handleInfoPtr;
-    RingSizeT numRead;
+    Tcl_Size numRead;
 
     if (chanInfoPtr->handle == INVALID_HANDLE_VALUE) {
 	return 0; /* EOF */
@@ -1160,7 +1153,7 @@ ConsoleInputProc(
 	    && bufSize > 1         /* Not single byte read */
 	) {
 	    DWORD lastError;
-	    RingSizeT numChars;
+	    Tcl_Size numChars;
 	    ReleaseSRWLockExclusive(&handleInfoPtr->lock);
 	    lastError = ReadConsoleChars(chanInfoPtr->handle,
 					 (WCHAR *)bufPtr,
@@ -1242,7 +1235,7 @@ ConsoleOutputProc(
 {
     ConsoleChannelInfo *chanInfoPtr = (ConsoleChannelInfo *)instanceData;
     ConsoleHandleInfo *handleInfoPtr;
-    RingSizeT numWritten;
+    Tcl_Size numWritten;
 
     *errorCode = 0;
 
@@ -1638,8 +1631,8 @@ ConsoleReaderThread(
     ConsoleHandleInfo *handleInfoPtr = (ConsoleHandleInfo *) arg;
     ConsoleHandleInfo **iterator;
     char inputChars[200]; /* Temporary buffer */
-    RingSizeT inputLen = 0;
-    RingSizeT inputOffset = 0;
+    Tcl_Size inputLen = 0;
+    Tcl_Size inputOffset = 0;
 
     /*
      * Keep looping until one of the following happens.
@@ -1670,7 +1663,7 @@ ConsoleReaderThread(
 	    HANDLE consoleHandle;
 	    if (inputLen > 0) {
 		/* Private buffer has data. Copy it over. */
-		RingSizeT nStored;
+		Tcl_Size nStored;
 
 		assert((inputLen - inputOffset) > 0);
 
@@ -1833,7 +1826,7 @@ ConsoleWriterThread(LPVOID arg)
     ConsoleHandleInfo *handleInfoPtr = (ConsoleHandleInfo *) arg;
     ConsoleHandleInfo **iterator;
     BOOL success;
-    RingSizeT numBytes;
+    Tcl_Size numBytes;
     /*
      * This buffer size has no relation really with the size of the shared
      * buffer. Could be bigger or smaller. Make larger as multiple threads
@@ -1904,7 +1897,7 @@ ConsoleWriterThread(LPVOID arg)
 	ReleaseSRWLockExclusive(&handleInfoPtr->lock);
 	offset = 0;
 	while (numBytes > 0) {
-	    RingSizeT numWChars = numBytes / sizeof(WCHAR);
+	    Tcl_Size numWChars = numBytes / sizeof(WCHAR);
 	    DWORD status;
 	    status = WriteConsoleChars(handleInfoPtr->console,
 				       (WCHAR *)(offset + buffer),

win/tclWinFCmd.c

@@ -1536,7 +1536,7 @@ GetWinFileAttributes(
 	 * We test for, and fix that case, here.
 	 */
 
-	size_t len;
+	Tcl_Size len;
 	const char *str = Tcl_GetStringFromObj(fileName, &len);
 
 	if (len < 4) {

win/tclWinFile.c

@@ -921,7 +921,7 @@ TclpMatchInDirectory(
 
 	    DWORD attr;
 	    WIN32_FILE_ATTRIBUTE_DATA data;
-	    size_t len = 0;
+	    Tcl_Size len = 0;
 	    const char *str = Tcl_GetStringFromObj(norm, &len);
 
 	    native = (const WCHAR *)Tcl_FSGetNativePath(pathPtr);
@@ -943,7 +943,7 @@ TclpMatchInDirectory(
 	WIN32_FIND_DATAW data;
 	const char *dirName;	/* UTF-8 dir name, later with pattern
 				 * appended. */
-	size_t dirLength;
+	Tcl_Size dirLength;
 	int matchSpecialDots;
 	Tcl_DString ds;		/* Native encoding of dir, also used
 				 * temporarily for other things. */
@@ -2796,7 +2796,7 @@ TclpObjNormalizePath(
 	     */
 
 	    Tcl_Obj *tmpPathPtr;
-	    size_t len;
+	    Tcl_Size len;
 
 	    tmpPathPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds),
 		    nextCheckpoint);
@@ -2885,7 +2885,7 @@ TclWinVolumeRelativeNormalize(
 	 * also on drive C.
 	 */
 
-	size_t cwdLen;
+	Tcl_Size cwdLen;
 	const char *drive = Tcl_GetStringFromObj(useThisCwd, &cwdLen);
 	char drive_cur = path[0];
 
@@ -3022,7 +3022,7 @@ TclNativeCreateNativeRep(
     WCHAR *nativePathPtr = NULL;
     const char *str;
     Tcl_Obj *validPathPtr;
-    size_t len;
+    Tcl_Size len;
     WCHAR *wp;
 
     if (TclFSCwdIsNative()) {

win/tclWinInit.c

@@ -131,7 +131,7 @@ TclpInitLibraryPath(
     Tcl_Obj *pathPtr;
     char installLib[LIBRARY_SIZE];
     const char *bytes;
-    size_t length;
+    Tcl_Size length;
 
     TclNewObj(pathPtr);
 

win/tclWinPipe.c

@@ -3191,7 +3191,7 @@ TclpOpenTemporaryFile(
     char *namePtr;
     HANDLE handle;
     DWORD flags = FILE_ATTRIBUTE_TEMPORARY;
-    size_t length;
+    Tcl_Size length;
     int counter, counter2;
     Tcl_DString buf;
 

win/tclWinThrd.c

@@ -21,109 +21,51 @@
 _CRTIMP unsigned int __cdecl _controlfp (unsigned int unNew, unsigned int unMask);
 #endif
 
-/*
- * This is the global lock used to serialize access to other serialization
- * data structures.
- */
+static struct tclWinGlobals {
+    INIT_ONCE init_once;	/* must be first member,
+		because of static initialziation */
 
-static CRITICAL_SECTION globalLock;
-static int initialized = 0;
+    /*
+     * This is the global lock used to serialize access to other serialization
+     * data structures.
+     */
+    CRITICAL_SECTION globalLock;
 
-/*
- * This is the global lock used to serialize initialization and finalization
- * of Tcl as a whole.
- */
+    /*
+     * This is the global lock used to serialize initialization and finalization
+     * of Tcl as a whole.
+     */
 
-static CRITICAL_SECTION initLock;
+    CRITICAL_SECTION initLock;
 
-/*
- * allocLock is used by Tcl's version of malloc for synchronization. For
- * obvious reasons, cannot use any dyamically allocated storage.
- */
+    /* holds the TLS key for the Tcl Thread_ID */
+    DWORD tls_thread_id;
+
+    /*
+     * allocLock is used by Tcl's version of malloc for synchronization. For
+     * obvious reasons, cannot use any dyamically allocated storage.
+     */
 
 #if TCL_THREADS
 
-static struct Tcl_Mutex_ {
-    CRITICAL_SECTION crit;
-} allocLock;
-static Tcl_Mutex allocLockPtr = &allocLock;
-static int allocOnce = 0;
+    struct Tcl_Mutex_ {
+	CRITICAL_SECTION crit;
+    } allocLock;
+    Tcl_Mutex allocLockPtr;
 
 #endif /* TCL_THREADS */
 
-/*
- * The joinLock serializes Create- and ExitThread. This is necessary to
- * prevent a race where a new joinable thread exits before the creating thread
- * had the time to create the necessary data structures in the emulation
- * layer.
- */
-
-static CRITICAL_SECTION joinLock;
-
-/*
- * Condition variables are implemented with a combination of a per-thread
- * Windows Event and a per-condition waiting queue. The idea is that each
- * thread has its own Event that it waits on when it is doing a ConditionWait;
- * it uses the same event for all condition variables because it only waits on
- * one at a time. Each condition variable has a queue of waiting threads, and
- * a mutex used to serialize access to this queue.
- *
- * Special thanks to David Nichols and Jim Davidson for advice on the
- * Condition Variable implementation.
- */
-
-/*
- * The per-thread event and queue pointers.
- */
+} TclWinGlobals = {
+    INIT_ONCE_STATIC_INIT
+};
 
 #if TCL_THREADS
-
-typedef struct ThreadSpecificData {
-    HANDLE condEvent;			/* Per-thread condition event */
-    struct ThreadSpecificData *nextPtr;	/* Queue pointers */
-    struct ThreadSpecificData *prevPtr;
-    int flags;				/* See flags below */
-} ThreadSpecificData;
-static Tcl_ThreadDataKey dataKey;
-
-#endif /* TCL_THREADS */
-
-/*
- * State bits for the thread.
- * WIN_THREAD_UNINIT		Uninitialized. Must be zero because of the way
- *				ThreadSpecificData is created.
- * WIN_THREAD_RUNNING		Running, not waiting.
- * WIN_THREAD_BLOCKED		Waiting, or trying to wait.
- */
-
-#define WIN_THREAD_UNINIT	0x0
-#define WIN_THREAD_RUNNING	0x1
-#define WIN_THREAD_BLOCKED	0x2
-
-/*
- * The per condition queue pointers and the Mutex used to serialize access to
- * the queue.
- */
-
-typedef struct {
-    CRITICAL_SECTION condLock;	/* Lock to serialize queuing on the
-				 * condition. */
-    struct ThreadSpecificData *firstPtr;	/* Queue pointers */
-    struct ThreadSpecificData *lastPtr;
+typedef struct Tcl_Condition_ {
+    CONDITION_VARIABLE cv;
 } WinCondition;
 
-/*
- * Additions by AOL for specialized thread memory allocator.
- */
+#endif /* TCL_THREADS */
 
-#ifdef USE_THREAD_ALLOC
-static DWORD tlsKey;
-
-typedef struct {
-    Tcl_Mutex	     tlock;
-    CRITICAL_SECTION wlock;
-} allocMutex;
-#endif /* USE_THREAD_ALLOC */
 
 /*
  * The per thread data passed from TclpThreadCreate
@@ -135,8 +77,50 @@ typedef struct {
   LPVOID lpParameter;		/* Original startup data */
   unsigned int fpControl;	/* Floating point control word from the
 				 * main thread */
+  HANDLE tHandle;		/* used to wait on thread completion */ 
+# if defined(_MSC_VER) || defined(__MSVCRT__)
+  unsigned
+# else
+  DWORD
+# endif
+    thread_id;		/* initialized but unused,
+			possibly useful for debugging */ 
 } WinThread;
 
+/* assuming alignment constraints result in lsb being constant 0 */
+# define	TCL_WIN_THREAD_JOIN_FLAG	((size_t) 1 << 0)
+
+# define	TCL_WIN_THREAD_ID(PTR, JOINABLE)\
+	    ((Tcl_ThreadId) ((sizeof ((PTR) - (WinThread *) 0),\
+	    (size_t) (PTR)) | ((JOINABLE)? TCL_WIN_THREAD_JOIN_FLAG: 0)))
+
+# define	TCL_WIN_THREAD_PTR(ID)\
+	    ((WinThread *) ((sizeof ((ID) == (Tcl_ThreadId) 0),\
+	    (size_t) (ID) & ~TCL_WIN_THREAD_JOIN_FLAG)))
+
+# define	TCL_WIN_THREAD_JOINABLE(ID)\
+	    (((sizeof ((ID) == (Tcl_ThreadId) 0),\
+	    (size_t) (ID) & TCL_WIN_THREAD_JOIN_FLAG)))
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclWinFailure --
+ *
+ *  	Call this when an unexpected WIN32 error occurs
+ *
+ * Does not return
+ *
+ *----------------------------------------------------------------------
+ */
+
+void TCL_NORETURN WINAPI
+TclWinFailure (
+    char const *const routine)
+{
+    Tcl_Panic ("%s failed, last error = %#x\n", routine, GetLastError ());
+}
 
 /*
  *----------------------------------------------------------------------
@@ -161,9 +145,8 @@ TclWinThreadStart(
     LPVOID lpParameter)		/* The WinThread structure pointer passed
 				 * from TclpThreadCreate */
 {
-    WinThread *winThreadPtr = (WinThread *) lpParameter;
-    LPTHREAD_START_ROUTINE lpOrigStartAddress;
-    LPVOID lpOrigParameter;
+    WinThread *const winThreadPtr = (WinThread *) lpParameter;
+    static DWORD result;
 
     if (!winThreadPtr) {
 	return TCL_ERROR;
@@ -175,11 +158,12 @@ TclWinThreadStart(
 #endif
     );
 
-    lpOrigStartAddress = winThreadPtr->lpStartAddress;
-    lpOrigParameter = winThreadPtr->lpParameter;
-
-    Tcl_Free(winThreadPtr);
-    return lpOrigStartAddress(lpOrigParameter);
+    if (!TlsSetValue (TclWinGlobals.tls_thread_id, winThreadPtr))
+	TclWinFailure ("TlsSetValue");
+    result = winThreadPtr->lpStartAddress (winThreadPtr->lpParameter);
+    if (!winThreadPtr->tHandle)
+	TclpSysFree (winThreadPtr);
+    return result;
 }
 
 /*
@@ -211,41 +195,50 @@ TclpThreadCreate(
     WinThread *winThreadPtr;		/* Per-thread startup info */
     HANDLE tHandle;
 
-    winThreadPtr = (WinThread *)Tcl_Alloc(sizeof(WinThread));
+    winThreadPtr = (WinThread *) TclpSysAlloc (sizeof *winThreadPtr);
+    if (!winThreadPtr)
+	TclWinFailure ("memory allocation");
     winThreadPtr->lpStartAddress = (LPTHREAD_START_ROUTINE) proc;
     winThreadPtr->lpParameter = clientData;
     winThreadPtr->fpControl = _controlfp(0, 0);
 
-    EnterCriticalSection(&joinLock);
-
-    *idPtr = 0; /* must initialize as Tcl_Thread is a pointer and
-                 * on WIN64 sizeof void* != sizeof unsigned
-		 */
-
 #if defined(_MSC_VER) || defined(__MSVCRT__)
     tHandle = (HANDLE) _beginthreadex(NULL, (unsigned) stackSize,
 	    (Tcl_ThreadCreateProc*) TclWinThreadStart, winThreadPtr,
-	    0, (unsigned *)idPtr);
+	    0 /* flags */,  &winThreadPtr->thread_id);
 #else
     tHandle = CreateThread(NULL, (DWORD) stackSize,
-	    TclWinThreadStart, winThreadPtr, 0, (LPDWORD)idPtr);
+	    TclWinThreadStart, winThreadPtr, 0 /* flags */,
+	    &winThreadPtr->thread_id);
 #endif
 
-    if (tHandle == NULL) {
-	LeaveCriticalSection(&joinLock);
+    if (!tHandle) {
+	TclpSysFree (winThreadPtr);
+# if	1
+	TclWinFailure ("CreateThread");
+# else
 	return TCL_ERROR;
+# endif
     } else {
-	if (flags & TCL_THREAD_JOINABLE) {
-	    TclRememberJoinableThread(*idPtr);
+	if (!(flags & TCL_THREAD_JOINABLE)) {
+	    /*
+	     * The only purpose of this is to decrement the reference count
+	     * so the OS resources will be reacquired when the thread closes.
+	     */
+	    if (!CloseHandle (tHandle))
+		TclWinFailure ("ClosseHandle");
+	    /* note: the WIN32 OpenHandle() can be used to open a HANDLE
+	    from the given threadID. However, if the thread
+	    terminates with a HANDLE count of zero, the kernel may clean up
+	    the thread, in particular its return status, immediately.
+	    Hence, joining the thread requires keeping a HANDLE open
+	    until the thread has been successfully joined. */ 
+
+	    tHandle = 0;
 	}
+	winThreadPtr->tHandle = tHandle;
 
-	/*
-	 * The only purpose of this is to decrement the reference count so the
-	 * OS resources will be reacquired when the thread closes.
-	 */
-
-	CloseHandle(tHandle);
-	LeaveCriticalSection(&joinLock);
+	*idPtr = TCL_WIN_THREAD_ID (winThreadPtr, 0 != tHandle);
 	return TCL_OK;
     }
 }
@@ -273,7 +266,26 @@ Tcl_JoinThread(
     int *result)		/* Reference to the storage the result of the
 				 * thread we wait upon will be written into. */
 {
-    return TclJoinThread(threadId, result);
+    if (!TCL_WIN_THREAD_JOINABLE (threadId))
+	return TCL_ERROR;
+
+    WinThread *winThreadPtr = TCL_WIN_THREAD_PTR (threadId);
+    HANDLE const tHandle = winThreadPtr->tHandle;
+    switch (WaitForSingleObject (tHandle, INFINITE)) {
+	DWORD exit_code;
+    default:
+	return TCL_ERROR;
+    case WAIT_FAILED:
+	TclWinFailure ("WaitForSingleObject");
+    case WAIT_OBJECT_0:
+	if (!GetExitCodeThread (tHandle, &exit_code))
+	    TclWinFailure ("GetExitCodeThread");
+	*result = exit_code;
+	if (!CloseHandle (tHandle))
+	    TclWinFailure ("CloseHandle");
+	TclpSysFree (winThreadPtr);
+	return TCL_OK;
+    }
 }
 
 /*
@@ -296,10 +308,12 @@ void
 TclpThreadExit(
     int status)
 {
-    EnterCriticalSection(&joinLock);
-    TclSignalExitThread(Tcl_GetCurrentThread(), status);
-    LeaveCriticalSection(&joinLock);
-
+    WinThread *winThreadPtr;
+    if (winThreadPtr = (WinThread *) TlsGetValue (
+	    TclWinGlobals.tls_thread_id)) {
+	if (!winThreadPtr->tHandle)
+	    TclpSysFree (winThreadPtr);
+    }
 #if defined(_MSC_VER) || defined(__MSVCRT__)
     _endthreadex((unsigned) status);
 #else
@@ -326,8 +340,64 @@ TclpThreadExit(
 Tcl_ThreadId
 Tcl_GetCurrentThread(void)
 {
-    return (Tcl_ThreadId)INT2PTR(GetCurrentThreadId());
+    WinThread *winThreadPtr;
+    if (!(winThreadPtr = (WinThread *) TlsGetValue (
+	    TclWinGlobals.tls_thread_id))) {
+	if (ERROR_SUCCESS != GetLastError ())
+	    TclWinFailure ("TlsGetValue in Tcl_GetCurrentThread");
+	/* this is an initial thread */
+	/* can't use TclAlloc, as the USE_THREAD_ALLOC per-thread allocator
+	calls Tcl_GetCurrentThread() */
+	if (!(winThreadPtr = (WinThread *) TclpSysAlloc (sizeof *winThreadPtr)))
+	    TclWinFailure ("memory allocation");
+	winThreadPtr->tHandle = 0;
+	winThreadPtr->thread_id = GetCurrentThreadId ();
+	if (!TlsSetValue (TclWinGlobals.tls_thread_id, winThreadPtr))
+	    TclWinFailure ("TlsSetValue");
+    }
+    return TCL_WIN_THREAD_ID (winThreadPtr, 0 != winThreadPtr->tHandle);
 }
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclWinInitOnce
+ *
+ *	Perform module initialization exactly once
+ *	storage keys.
+ *
+ * Results:
+ *	None.
+ *
+ *
+ *----------------------------------------------------------------------
+ */
+static BOOL
+TclWinInitOnce (
+    INIT_ONCE *init_once,
+    void *parameter,
+    void *context)
+{
+    struct tclWinGlobals *const twg = parameter;
+
+    InitializeCriticalSection(&twg->initLock);
+    InitializeCriticalSection(&twg->globalLock);
+    twg->tls_thread_id = TlsAlloc ();
+
+#if TCL_THREADS
+    InitializeCriticalSection(&twg->allocLock.crit);
+    twg->allocLockPtr = &twg->allocLock;
+#endif /* TCL_THREADS */
+
+    return TRUE;
+}
+
+# define	TCL_WIN_INITIALIZE_ONCE()\
+	InitOnceExecuteOnce (&TclWinGlobals.init_once,\
+	    TclWinInitOnce,\
+	    &TclWinGlobals,\
+	    0)
+
 
 /*
  *----------------------------------------------------------------------
@@ -351,20 +421,9 @@ Tcl_GetCurrentThread(void)
 void
 TclpInitLock(void)
 {
-    if (!initialized) {
-	/*
-	 * There is a fundamental race here that is solved by creating the
-	 * first Tcl interpreter in a single threaded environment. Once the
-	 * interpreter has been created, it is safe to create more threads
-	 * that create interpreters in parallel.
-	 */
-
-	initialized = 1;
-	InitializeCriticalSection(&joinLock);
-	InitializeCriticalSection(&initLock);
-	InitializeCriticalSection(&globalLock);
-    }
-    EnterCriticalSection(&initLock);
+    if (!TCL_WIN_INITIALIZE_ONCE ())
+	TclWinFailure ("InitOnceExecuteOnce");
+    EnterCriticalSection(&TclWinGlobals.initLock);
 }
 
 /*
@@ -387,7 +446,7 @@ TclpInitLock(void)
 void
 TclpInitUnlock(void)
 {
-    LeaveCriticalSection(&initLock);
+    LeaveCriticalSection(&TclWinGlobals.initLock);
 }
 
 /*
@@ -413,20 +472,9 @@ TclpInitUnlock(void)
 void
 TclpGlobalLock(void)
 {
-    if (!initialized) {
-	/*
-	 * There is a fundamental race here that is solved by creating the
-	 * first Tcl interpreter in a single threaded environment. Once the
-	 * interpreter has been created, it is safe to create more threads
-	 * that create interpreters in parallel.
-	 */
-
-	initialized = 1;
-	InitializeCriticalSection(&joinLock);
-	InitializeCriticalSection(&initLock);
-	InitializeCriticalSection(&globalLock);
-    }
-    EnterCriticalSection(&globalLock);
+    if (!TCL_WIN_INITIALIZE_ONCE ())
+	TclWinFailure ("InitOnceExecuteOnce");
+    EnterCriticalSection(&TclWinGlobals.globalLock);
 }
 
 /*
@@ -449,7 +497,7 @@ TclpGlobalLock(void)
 void
 TclpGlobalUnlock(void)
 {
-    LeaveCriticalSection(&globalLock);
+    LeaveCriticalSection(&TclWinGlobals.globalLock);
 }
 
 /*
@@ -475,11 +523,9 @@ Tcl_Mutex *
 Tcl_GetAllocMutex(void)
 {
 #if TCL_THREADS
-    if (!allocOnce) {
-	InitializeCriticalSection(&allocLock.crit);
-	allocOnce = 1;
-    }
-    return &allocLockPtr;
+    if (!TCL_WIN_INITIALIZE_ONCE ())
+	TclWinFailure ("InitOnceExecuteOnce");
+    return &TclWinGlobals.allocLockPtr;
 #else
     return NULL;
 #endif
@@ -506,36 +552,35 @@ Tcl_GetAllocMutex(void)
 void
 TclFinalizeLock(void)
 {
+    struct tclWinGlobals *const twg = &TclWinGlobals;
     TclpGlobalLock();
-    DeleteCriticalSection(&joinLock);
+
+    if (!TlsFree (twg->tls_thread_id))
+	TclWinFailure ("TlsFree");
 
     /*
      * Destroy the critical section that we are holding!
      */
 
-    DeleteCriticalSection(&globalLock);
-    initialized = 0;
+    DeleteCriticalSection(&twg->globalLock);
 
 #if TCL_THREADS
-    if (allocOnce) {
-	DeleteCriticalSection(&allocLock.crit);
-	allocOnce = 0;
-    }
+    DeleteCriticalSection(&twg->allocLock.crit);
 #endif
 
-    LeaveCriticalSection(&initLock);
+    LeaveCriticalSection(&twg->initLock);
 
     /*
      * Destroy the critical section that we were holding.
      */
 
-    DeleteCriticalSection(&initLock);
+    DeleteCriticalSection(&twg->initLock);
+
+    InitOnceInitialize (&twg->init_once);	/* assuming we want to
+	re-initialize at some point -- dubious */
 }
 
 #if TCL_THREADS
-
-/* locally used prototype */
-static void		FinalizeConditionEvent(void *data);
 
 /*
  *----------------------------------------------------------------------
@@ -558,25 +603,25 @@ void
 Tcl_MutexLock(
     Tcl_Mutex *mutexPtr)	/* The lock */
 {
-    CRITICAL_SECTION *csPtr;
+    struct Tcl_Mutex_ *mp;
 
     if (*mutexPtr == NULL) {
 	TclpGlobalLock();
 
 	/*
 	 * Double inside global lock check to avoid a race.
+	 * BROKEN: does work in relaxed memory models
 	 */
 
 	if (*mutexPtr == NULL) {
-	    csPtr = (CRITICAL_SECTION *)Tcl_Alloc(sizeof(CRITICAL_SECTION));
-	    InitializeCriticalSection(csPtr);
-	    *mutexPtr = (Tcl_Mutex)csPtr;
+	    mp = Tcl_Alloc (sizeof *mp);
+	    InitializeCriticalSection (&mp->crit);
+	    *mutexPtr = mp;
 	    TclRememberMutex(mutexPtr);
 	}
 	TclpGlobalUnlock();
     }
-    csPtr = *((CRITICAL_SECTION **)mutexPtr);
-    EnterCriticalSection(csPtr);
+    EnterCriticalSection (&(*mutexPtr)->crit);
 }
 
 /*
@@ -599,9 +644,7 @@ void
 Tcl_MutexUnlock(
     Tcl_Mutex *mutexPtr)	/* The lock */
 {
-    CRITICAL_SECTION *csPtr = *((CRITICAL_SECTION **)mutexPtr);
-
-    LeaveCriticalSection(csPtr);
+    LeaveCriticalSection (&(*mutexPtr)->crit);
 }
 
 /*
@@ -625,11 +668,9 @@ void
 TclpFinalizeMutex(
     Tcl_Mutex *mutexPtr)
 {
-    CRITICAL_SECTION *csPtr = *(CRITICAL_SECTION **)mutexPtr;
-
-    if (csPtr != NULL) {
-	DeleteCriticalSection(csPtr);
-	Tcl_Free(csPtr);
+    if (*mutexPtr) {
+	DeleteCriticalSection(&(*mutexPtr)->crit);
+	Tcl_Free(*mutexPtr);
 	*mutexPtr = NULL;
     }
 }
@@ -808,8 +849,8 @@ Tcl_ConditionWait(
  *
  *	This procedure is invoked to signal a condition variable.
  *
- *	The mutex must be held during this call to avoid races, but this
- *	interface does not enforce that.
+ *	The mutex does not need to be held during this call to avoid races
+ *	and should not be, to minimize the number of context switches
  *
  * Results:
  *	None.
@@ -824,68 +865,19 @@ void
 Tcl_ConditionNotify(
     Tcl_Condition *condPtr)
 {
-    WinCondition *winCondPtr;
-    ThreadSpecificData *tsdPtr;
+    /* double checked locking, i.e., BROKEN */
+    if (*condPtr == NULL) {
+	TclpGlobalLock();
 
-    if (*condPtr != NULL) {
-	winCondPtr = *((WinCondition **)condPtr);
-
-	if (winCondPtr == NULL) {
-	    return;
+	if (*condPtr == NULL) {
+	    WinCondition *winCondPtr;
+	    winCondPtr = (WinCondition *)Tcl_Alloc(sizeof *winCondPtr);
+	    InitializeConditionVariable (&winCondPtr->cv);
+	    *condPtr = winCondPtr;
 	}
-
-	/*
-	 * Loop through all the threads waiting on the condition and notify
-	 * them (i.e., broadcast semantics). The queue manipulation is guarded
-	 * by the per-condition coordinating mutex.
-	 */
-
-	EnterCriticalSection(&winCondPtr->condLock);
-	while (winCondPtr->firstPtr != NULL) {
-	    tsdPtr = winCondPtr->firstPtr;
-	    winCondPtr->firstPtr = tsdPtr->nextPtr;
-	    if (winCondPtr->lastPtr == tsdPtr) {
-		winCondPtr->lastPtr = NULL;
-	    }
-	    tsdPtr->flags = WIN_THREAD_RUNNING;
-	    tsdPtr->nextPtr = NULL;
-	    tsdPtr->prevPtr = NULL;	/* Not strictly necessary, see A: */
-	    SetEvent(tsdPtr->condEvent);
-	}
-	LeaveCriticalSection(&winCondPtr->condLock);
-    } else {
-	/*
-	 * No-one has used the condition variable, so there are no waiters.
-	 */
+	TclpGlobalUnlock();
     }
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * FinalizeConditionEvent --
- *
- *	This procedure is invoked to clean up the per-thread event used to
- *	implement condition waiting. This is only safe to call at the end of
- *	time.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	The per-thread event is closed.
- *
- *----------------------------------------------------------------------
- */
-
-static void
-FinalizeConditionEvent(
-    void *data)
-{
-    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) data;
-
-    tsdPtr->flags = WIN_THREAD_UNINIT;
-    CloseHandle(tsdPtr->condEvent);
+    WakeAllConditionVariable (&(*condPtr)->cv);
 }
 
 /*
@@ -911,7 +903,7 @@ void
 TclpFinalizeCondition(
     Tcl_Condition *condPtr)
 {
-    WinCondition *winCondPtr = *(WinCondition **)condPtr;
+    WinCondition *winCondPtr = *condPtr;
 
     /*
      * Note - this is called long after the thread-local storage is reclaimed.
@@ -921,7 +913,6 @@ TclpFinalizeCondition(
      */
 
     if (winCondPtr != NULL) {
-	DeleteCriticalSection(&winCondPtr->condLock);
 	Tcl_Free(winCondPtr);
 	*condPtr = NULL;
     }
@@ -935,6 +926,13 @@ TclpFinalizeCondition(
  */
 #ifdef USE_THREAD_ALLOC
 
+static DWORD tlsKey;
+
+typedef struct {
+    Tcl_Mutex	     tlock;
+    CRITICAL_SECTION wlock;
+} allocMutex;
+
 Tcl_Mutex *
 TclpNewAllocMutex(void)
 {