Merge unchained branch [22400aa71b] and resolve conflicts.

See: [https://github.com/tcltk/tcl/actions/runs/4956385513] for build failure

.github/workflows/linux-build.yml

@@ -15,8 +15,6 @@ jobs:
       matrix:
         cfgopt:
           - ""
-          - "CFLAGS=-DTCL_UTF_MAX=3"
-          - "CFLAGS=-DTCL_NO_DEPRECATED=1"
           - "--disable-shared"
           - "--enable-symbols"
           - "--enable-symbols=mem"

.github/workflows/win-build.yml

@@ -60,8 +60,6 @@ jobs:
       matrix:
         cfgopt:
           - ""
-          - "CFLAGS=-DTCL_UTF_MAX=3"
-          - "CFLAGS=-DTCL_NO_DEPRECATED=1"
           - "--disable-shared"
           - "--enable-symbols"
           - "--enable-symbols=mem"

.travis.yml

@@ -20,20 +20,12 @@ jobs:
       compiler: gcc
       env:
         - BUILD_DIR=unix
-    - name: "Linux/GCC/Shared: UTF_MAX=3"
-      os: linux
-      dist: focal
-      compiler: gcc
-      env:
-        - BUILD_DIR=unix
-        - CFGOPT="CFLAGS=-DTCL_UTF_MAX=3"
     - name: "Linux/GCC/Shared: NO_DEPRECATED"
       os: linux
       dist: focal
       compiler: gcc
       env:
         - BUILD_DIR=unix
-        - CFGOPT="CFLAGS=-DTCL_NO_DEPRECATED=1"
     - name: "Linux/GCC/Static"
       os: linux
       dist: focal
@@ -301,20 +293,6 @@ jobs:
         - touch generic/tclStubInit.c generic/tclOOStubInit.c generic/tclOOScript.h
         - choco install -y make zip
         - cd ${BUILD_DIR}
-    - name: "Windows/GCC/Shared: UTF_MAX=3"
-      os: windows
-      compiler: gcc
-      env:
-        - BUILD_DIR=win
-        - CFGOPT="--enable-64bit CFLAGS=-DTCL_UTF_MAX=3"
-      before_install: *makepreinst
-    - name: "Windows/GCC/Shared: NO_DEPRECATED"
-      os: windows
-      compiler: gcc
-      env:
-        - BUILD_DIR=win
-        - CFGOPT="--enable-64bit CFLAGS=-DTCL_NO_DEPRECATED=1"
-      before_install: *makepreinst
     - name: "Windows/GCC/Static"
       os: windows
       compiler: gcc
@@ -343,20 +321,6 @@ jobs:
       env:
         - BUILD_DIR=win
       before_install: *makepreinst
-    - name: "Windows/GCC-x86/Shared: UTF_MAX=3"
-      os: windows
-      compiler: gcc
-      env:
-        - BUILD_DIR=win
-        - CFGOPT="CFLAGS=-DTCL_UTF_MAX=3"
-      before_install: *makepreinst
-    - name: "Windows/GCC-x86/Shared: NO_DEPRECATED"
-      os: windows
-      compiler: gcc
-      env:
-        - BUILD_DIR=win
-        - CFGOPT="CFLAGS=-DTCL_NO_DEPRECATED=1"
-      before_install: *makepreinst
     - name: "Windows/GCC-x86/Static"
       os: windows
       compiler: gcc

generic/regcustom.h

@@ -84,15 +84,9 @@ typedef int celt;		/* Type to hold chr, or NOCELT */
 #define	NOCELT (-1)		/* Celt value which is not valid chr */
 #define	CHR(c) (UCHAR(c))	/* Turn char literal into chr literal */
 #define	DIGITVAL(c) ((c)-'0')	/* Turn chr digit into its value */
-#if TCL_UTF_MAX > 3
 #define	CHRBITS	32		/* Bits in a chr; must not use sizeof */
 #define	CHR_MIN	0x00000000	/* Smallest and largest chr; the value */
 #define	CHR_MAX	0x10FFFF	/* CHR_MAX-CHR_MIN+1 should fit in uchr */
-#else
-#define	CHRBITS	16		/* Bits in a chr; must not use sizeof */
-#define	CHR_MIN	0x0000		/* Smallest and largest chr; the value */
-#define	CHR_MAX	0xFFFF		/* CHR_MAX-CHR_MIN+1 should fit in uchr */
-#endif
 
 /*
  * Functions operating on chr.

generic/tcl.h

@@ -9,6 +9,7 @@
  * Copyright (c) 1994-1998 Sun Microsystems, Inc.
  * Copyright (c) 1998-2000 by Scriptics Corporation.
  * Copyright (c) 2002 by Kevin B. Kenny.  All rights reserved.
+ * Copyright (c) 2021 by Nathan Coulter.  All rights reserved.
  *
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -105,6 +106,9 @@ extern "C" {
 #include <stdio.h>
 #include <stddef.h>
 
+
+#define TCL_COMMENT(x)
+
 #if defined(__GNUC__) && (__GNUC__ > 2)
 #   if defined(_WIN32) && defined(__USE_MINGW_ANSI_STDIO) && __USE_MINGW_ANSI_STDIO
 #	define TCL_FORMAT_PRINTF(a,b) __attribute__ ((__format__ (__MINGW_PRINTF_FORMAT, a, b)))
@@ -208,10 +212,6 @@ extern "C" {
 #   endif
 #endif
 
-#if !defined(CONST86) && !defined(TCL_NO_DEPRECATED)
-#      define CONST86 const
-#endif
-
 /*
  * Make sure EXTERN isn't defined elsewhere.
  */
@@ -321,24 +321,12 @@ typedef unsigned TCL_WIDE_INT_TYPE	Tcl_WideUInt;
 #define Tcl_WideAsDouble(val)	((double)((Tcl_WideInt)(val)))
 #define Tcl_DoubleAsWide(val)	((Tcl_WideInt)((double)(val)))
 
-#if TCL_MAJOR_VERSION < 9
-    typedef int Tcl_Size;
-#   define TCL_SIZE_MODIFIER ""
-#   define TCL_SIZE_MAX INT_MAX
-#else
-    typedef ptrdiff_t Tcl_Size;
-#   define TCL_SIZE_MAX PTRDIFF_MAX
-#   define TCL_SIZE_MODIFIER TCL_T_MODIFIER
-#endif /* TCL_MAJOR_VERSION */
+typedef ptrdiff_t Tcl_Size;
+#define TCL_SIZE_MAX PTRDIFF_MAX
+#define TCL_SIZE_MODIFIER TCL_T_MODIFIER
 
 #ifdef _WIN32
-#   if TCL_MAJOR_VERSION > 8 || defined(_WIN64) || defined(_USE_64BIT_TIME_T)
-	typedef struct __stat64 Tcl_StatBuf;
-#   elif defined(_USE_32BIT_TIME_T)
-	typedef struct _stati64	Tcl_StatBuf;
-#   else
-	typedef struct _stat32i64 Tcl_StatBuf;
-#   endif
+typedef struct __stat64 Tcl_StatBuf;
 #elif defined(__CYGWIN__)
     typedef struct {
 	unsigned st_dev;
@@ -465,28 +453,18 @@ typedef void (Tcl_ThreadCreateProc) (void *clientData);
  */
 
 typedef struct Tcl_RegExpIndices {
-#if TCL_MAJOR_VERSION > 8
     Tcl_Size start;			/* Character offset of first character in
 				 * match. */
     Tcl_Size end;			/* Character offset of first character after
 				 * the match. */
-#else
-    long start;
-    long end;
-#endif
 } Tcl_RegExpIndices;
 
 typedef struct Tcl_RegExpInfo {
     Tcl_Size nsubs;			/* Number of subexpressions in the compiled
 				 * expression. */
     Tcl_RegExpIndices *matches;	/* Array of nsubs match offset pairs. */
-#if TCL_MAJOR_VERSION > 8
     Tcl_Size extendStart;		/* The offset at which a subsequent match
 				 * might begin. */
-#else
-    long extendStart;
-    long reserved;		/* Reserved for later use. */
-#endif
 } Tcl_RegExpInfo;
 
 /*
@@ -608,10 +586,6 @@ typedef void *(Tcl_InitNotifierProc) (void);
 typedef void (Tcl_FinalizeNotifierProc) (void *clientData);
 typedef void (Tcl_MainLoopProc) (void);
 
-#ifndef TCL_NO_DEPRECATED
-#   define Tcl_PackageInitProc Tcl_LibraryInitProc
-#   define Tcl_PackageUnloadProc Tcl_LibraryUnloadProc
-#endif
 
 /*
  *----------------------------------------------------------------------------
@@ -620,6 +594,10 @@ typedef void (Tcl_MainLoopProc) (void);
  * standard operations on objects of that type.
  */
 
+/* forward declaration */
+typedef struct Tcl_Obj Tcl_Obj;
+typedef struct Tcl_ObjInterface Tcl_ObjInterface;
+
 typedef struct Tcl_ObjType {
     const char *name;		/* Name of the type, e.g. "int". */
     Tcl_FreeInternalRepProc *freeIntRepProc;
@@ -672,7 +650,7 @@ typedef union Tcl_ObjInternalRep {	/* The internal representation: */
  * or both.
  */
 
-typedef struct Tcl_Obj {
+struct Tcl_Obj {
     Tcl_Size refCount;		/* When 0 the object will be freed. */
     char *bytes;		/* This points to the first byte of the
 				 * object's string representation. The array
@@ -692,7 +670,7 @@ typedef struct Tcl_Obj {
 				 * internal rep. NULL indicates the object has
 				 * no internal rep (has no type). */
     Tcl_ObjInternalRep internalRep;	/* The internal representation: */
-} Tcl_Obj;
+};
 
 
 /*
@@ -883,11 +861,7 @@ typedef struct Tcl_DString {
  * TCL_COMBINE Combine surrogates
  */
 
-#if TCL_MAJOR_VERSION > 8
-#    define TCL_COMBINE		0x1000000
-#else
-#    define TCL_COMBINE		0
-#endif
+#define TCL_COMBINE		0x1000000
 /*
  *----------------------------------------------------------------------------
  * Flag values passed to Tcl_RecordAndEval, Tcl_EvalObj, Tcl_EvalObjv.
@@ -1001,11 +975,7 @@ typedef struct Tcl_DString {
  */
 
 #ifndef TCL_HASH_TYPE
-#if TCL_MAJOR_VERSION > 8
-#  define TCL_HASH_TYPE size_t
-#else
-#  define TCL_HASH_TYPE unsigned
-#endif
+#define TCL_HASH_TYPE size_t
 #endif
 
 typedef struct Tcl_HashKeyType Tcl_HashKeyType;
@@ -1122,15 +1092,10 @@ struct Tcl_HashTable {
 				 * table. */
     Tcl_Size rebuildSize;		/* Enlarge table when numEntries gets to be
 				 * this large. */
-#if TCL_MAJOR_VERSION > 8
     size_t mask;		/* Mask value used in hashing function. */
-#endif
     int downShift;		/* Shift count used in hashing function.
 				 * Designed to use high-order bits of
 				 * randomized keys. */
-#if TCL_MAJOR_VERSION < 9
-    int mask;		/* Mask value used in hashing function. */
-#endif
     int keyType;		/* Type of keys used in this table. It's
 				 * either TCL_CUSTOM_KEYS, TCL_STRING_KEYS,
 				 * TCL_ONE_WORD_KEYS, or an integer giving the
@@ -1296,11 +1261,7 @@ typedef void (Tcl_ScaleTimeProc) (Tcl_Time *timebuf, void *clientData);
  * interface.
  */
 
-#if TCL_MAJOR_VERSION > 8
-#   define TCL_CLOSE2PROC		NULL
-#else
-#   define TCL_CLOSE2PROC		((void *) 1)
-#endif
+#define TCL_CLOSE2PROC		NULL
 
 /*
  * Channel version tag. This was introduced in 8.3.2/8.4.
@@ -1850,12 +1811,10 @@ typedef struct Tcl_Parse {
 				 * *tokenPtr. */
     int errorType;		/* One of the parsing error types defined
 				 * above. */
-#if TCL_MAJOR_VERSION > 8
     int incomplete;		/* This field is set to 1 by Tcl_ParseCommand
 				 * if the command appears to be incomplete.
 				 * This information is used by
 				 * Tcl_CommandComplete. */
-#endif
 
     /*
      * The fields below are intended only for the private use of the parser.
@@ -1874,9 +1833,6 @@ typedef struct Tcl_Parse {
 				 * beginning of region where the error
 				 * occurred (e.g. the open brace if the close
 				 * brace is missing). */
-#if TCL_MAJOR_VERSION < 9
-    int incomplete;
-#endif
     Tcl_Token staticTokens[NUM_STATIC_TOKENS];
 				/* Initial space for tokens for command. This
 				 * space should be large enough to accommodate
@@ -1933,7 +1889,7 @@ typedef struct Tcl_EncodingType {
  *				reset to an initial state. If the source
  *				buffer contains the entire input stream to be
  *				converted, this flag should be set.
- * TCL_ENCODING_STOPONERROR -	Not used any more.
+ * TCL_ENCODING_STOPONERROR -	Obsolete.
  * TCL_ENCODING_NO_TERMINATE - 	If set, Tcl_ExternalToUtf does not append a
  *				terminating NUL byte.  Since it does not need
  *				an extra byte for a terminating NUL, it fills
@@ -1958,11 +1914,7 @@ typedef struct Tcl_EncodingType {
 
 #define TCL_ENCODING_START		0x01
 #define TCL_ENCODING_END		0x02
-#if TCL_MAJOR_VERSION > 8
-#   define TCL_ENCODING_STOPONERROR	0x0 /* Not used any more */
-#else
-#   define TCL_ENCODING_STOPONERROR	0x04
-#endif
+#define TCL_ENCODING_STOPONERROR	0x0 /* Not used any more */
 #define TCL_ENCODING_NO_TERMINATE	0x08
 #define TCL_ENCODING_CHAR_LIMIT		0x10
 /* Internal use bits, do not define bits in this space. See above comment */
@@ -1975,11 +1927,7 @@ typedef struct Tcl_EncodingType {
 #define TCL_ENCODING_PROFILE_TCL8     0x01000000
 #define TCL_ENCODING_PROFILE_STRICT   0x02000000
 #define TCL_ENCODING_PROFILE_REPLACE  0x03000000
-#if TCL_MAJOR_VERSION < 9
-#define TCL_ENCODING_PROFILE_DEFAULT  TCL_ENCODING_PROFILE_TCL8
-#else
-#define TCL_ENCODING_PROFILE_DEFAULT  TCL_ENCODING_PROFILE_TCL8
-#endif
+#define TCL_ENCODING_PROFILE_DEFAULT  TCL_ENCODING_PROFILE_STRICT
 
 /*
  * The following definitions are the error codes returned by the conversion
@@ -2021,11 +1969,7 @@ typedef struct Tcl_EncodingType {
  */
 
 #ifndef TCL_UTF_MAX
-#   if TCL_MAJOR_VERSION > 8
 #	define TCL_UTF_MAX		4
-#   else
-#	define TCL_UTF_MAX		3
-#   endif
 #endif
 
 /*
@@ -2033,16 +1977,12 @@ typedef struct Tcl_EncodingType {
  * reflected in regcustom.h.
  */
 
-#if TCL_UTF_MAX > 3
-    /*
-     * int isn't 100% accurate as it should be a strict 4-byte value
-     * (perhaps int32_t). ILP64/SILP64 systems may have troubles. The
-     * size of this value must be reflected correctly in regcustom.h.
-     */
+/*
+ * int isn't 100% accurate as it should be a strict 4-byte value
+ * (perhaps int32_t). ILP64/SILP64 systems may have troubles. The
+ * size of this value must be reflected correctly in regcustom.h.
+ */
 typedef int Tcl_UniChar;
-#else
-typedef unsigned short Tcl_UniChar;
-#endif
 
 /*
  *----------------------------------------------------------------------------
@@ -2214,6 +2154,7 @@ typedef int (Tcl_ArgvGenFuncProc)(void *clientData, Tcl_Interp *interp,
 #define TCL_IO_FAILURE	((Tcl_Size)-1)
 #define TCL_AUTO_LENGTH	((Tcl_Size)-1)
 #define TCL_INDEX_NONE  ((Tcl_Size)-1)
+#define TCL_LENGTH_NONE  ((Tcl_Size)-1)
 
 /*
  *----------------------------------------------------------------------------
@@ -2229,11 +2170,7 @@ typedef int (Tcl_NRPostProc) (void *data[], Tcl_Interp *interp,
  * stubs tables.
  */
 
-#if TCL_MAJOR_VERSION > 8
-#   define TCL_STUB_MAGIC		((int) 0xFCA3BACB + (int) sizeof(void *))
-#else
-#   define TCL_STUB_MAGIC		((int) 0xFCA3BACF)
-#endif
+#define TCL_STUB_MAGIC		((int) 0xFCA3BACB + (int) sizeof(void *))
 
 /*
  * The following function is required to be defined in all stubs aware
@@ -2255,19 +2192,7 @@ void *			TclStubCall(void *arg);
 #endif
 
 #ifdef USE_TCL_STUBS
-#if TCL_MAJOR_VERSION < 9
-# if TCL_UTF_MAX < 4
-#   define Tcl_InitStubs(interp, version, exact) \
-	(Tcl_InitStubs)(interp, version, \
-	    (exact)|(TCL_MAJOR_VERSION<<8)|(0xFF<<16), \
-	    TCL_STUB_MAGIC)
-# else
-#   define Tcl_InitStubs(interp, version, exact) \
-	(Tcl_InitStubs)(interp, "8.7.0", \
-	    (exact)|(TCL_MAJOR_VERSION<<8)|(0xFF<<16), \
-	    TCL_STUB_MAGIC)
-# endif
-#elif TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE
+#if TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE
 #   define Tcl_InitStubs(interp, version, exact) \
 	(Tcl_InitStubs)(interp, version, \
 	    (exact)|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16), \
@@ -2279,9 +2204,7 @@ void *			TclStubCall(void *arg);
 	    TCL_STUB_MAGIC)
 #endif
 #else
-#if TCL_MAJOR_VERSION < 9
-#   error "Please define -DUSE_TCL_STUBS"
-#elif TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE
+#if TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE
 #   define Tcl_InitStubs(interp, version, exact) \
 	Tcl_PkgInitStubsCheck(interp, version, \
 		(exact)|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16))
@@ -2313,9 +2236,6 @@ EXTERN void		Tcl_StaticLibrary(Tcl_Interp *interp,
 			    const char *prefix,
 			    Tcl_LibraryInitProc *initProc,
 			    Tcl_LibraryInitProc *safeInitProc);
-#ifndef TCL_NO_DEPRECATED
-#   define Tcl_StaticPackage Tcl_StaticLibrary
-#endif
 EXTERN Tcl_ExitProc *Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc);
 #ifdef _WIN32
 EXTERN const char *TclZipfs_AppHook(int *argc, wchar_t ***argv);
@@ -2330,7 +2250,7 @@ EXTERN const char *TclZipfs_AppHook(int *argc, char ***argv);
     EXTERN TCL_NORETURN void Tcl_MainExW(Tcl_Size argc, wchar_t **argv,
 	    Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
 #endif
-#if defined(USE_TCL_STUBS) && (TCL_MAJOR_VERSION > 8)
+#if defined(USE_TCL_STUBS)
 #define Tcl_SetPanicProc(panicProc) \
     TclInitStubTable(((const char *(*)(Tcl_PanicProc *))TclStubCall((void *)panicProc))(panicProc))
 #define Tcl_InitSubsystems() \

generic/tclArithSeries.c

@@ -15,6 +15,7 @@
 #include <assert.h>
 #include <math.h>
 
+
 /* -------------------------- ArithSeries object ---------------------------- */
 
 /*
@@ -68,7 +69,7 @@ static inline ArithSeries*
 ArithSeriesGetInternalRep(Tcl_Obj *objPtr)
 {
     const Tcl_ObjInternalRep *irPtr;
-    irPtr = TclFetchInternalRep((objPtr), &tclArithSeriesType.objType);
+    irPtr = TclFetchInternalRep((objPtr), tclArithSeriesType);
     return irPtr ? (ArithSeries *)irPtr->twoPtrValue.ptr1 : NULL;
 }
 
@@ -102,7 +103,12 @@ 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);
+static  int	ArithSeriesObjIndex(Tcl_Interp *, Tcl_Obj *,
+			    Tcl_Size index, Tcl_Obj **resultPtr);
+static int	ArithSeriesObjLength(tclObjTypeInterfaceArgsListLength);
+static Tcl_Obj* ArithSeriesObjRange(tclObjTypeInterfaceArgsListRange);
+static Tcl_Obj*	ArithSeriesObjReverse(tclObjTypeInterfaceArgsListReverse);
+static int	ArithSeriesGetElements(tclObjTypeInterfaceArgsListAll);
 
 /*
  * The structure below defines the arithmetic series Tcl object type by
@@ -131,17 +137,39 @@ static Tcl_Size ArithSeriesObjLength(Tcl_Obj *arithSeriesPtr);
  * are valid and will be equivalent to the empty list.
  */
 
-const TclObjTypeWithAbstractList tclArithSeriesType = {
-    {"arithseries",			/* name */
+ObjInterface tclArithSeriesInterface = {
+    1,
+    {},
+    {
+		ArithSeriesGetElements,
+		NULL,
+		NULL,
+		ArithSeriesObjIndex,
+		NULL,
+		NULL,
+		ArithSeriesObjLength,
+		ArithSeriesObjRange,
+		NULL,
+		NULL,
+		NULL,
+		ArithSeriesObjReverse,
+	  	NULL,
+		NULL,
+    },
+};
+const ObjectType tclArithSeriesObjType = {
+    "arithseries",
     FreeArithSeriesInternalRep,		/* freeIntRepProc */
     DupArithSeriesInternalRep,		/* dupIntRepProc */
     UpdateStringOfArithSeries,		/* updateStringProc */
     SetArithSeriesFromAny,		/* setFromAnyProc */
-    TCL_OBJTYPE_V0_1(
-    ArithSeriesObjLength
-    )}
+    2,
+    (Tcl_ObjInterface *)&tclArithSeriesInterface
 };
 
+MODULE_SCOPE const Tcl_ObjType *tclArithSeriesType
+    = (Tcl_ObjType *)&tclArithSeriesObjType;
+
 /*
  *----------------------------------------------------------------------
  *
@@ -233,7 +261,7 @@ NewArithSeriesInt(Tcl_WideInt start, Tcl_WideInt end, Tcl_WideInt step, Tcl_Wide
     arithSeriesRepPtr->elements = NULL;
     arithSeriesObj->internalRep.twoPtrValue.ptr1 = arithSeriesRepPtr;
     arithSeriesObj->internalRep.twoPtrValue.ptr2 = NULL;
-    arithSeriesObj->typePtr = &tclArithSeriesType.objType;
+    arithSeriesObj->typePtr = tclArithSeriesType;
     if (length > 0)
     	Tcl_InvalidateStringRep(arithSeriesObj);
 
@@ -288,7 +316,7 @@ NewArithSeriesDbl(double start, double end, double step, Tcl_WideInt len)
     arithSeriesRepPtr->precision = maxPrecision(start,end,step);
     arithSeriesObj->internalRep.twoPtrValue.ptr1 = arithSeriesRepPtr;
     arithSeriesObj->internalRep.twoPtrValue.ptr2 = NULL;
-    arithSeriesObj->typePtr = &tclArithSeriesType.objType;
+    arithSeriesObj->typePtr = tclArithSeriesType;
 
     if (length > 0) {
     	Tcl_InvalidateStringRep(arithSeriesObj);
@@ -478,7 +506,7 @@ ArithSeriesObjStep(
     ArithSeries *arithSeriesRepPtr;
     Tcl_Obj *stepObj;
 
-    if (arithSeriesObj->typePtr != &tclArithSeriesType.objType) {
+    if (arithSeriesObj->typePtr != tclArithSeriesType) {
         Tcl_Panic("ArithSeriesObjStep called with a not ArithSeries Obj.");
     }
     arithSeriesRepPtr = ArithSeriesGetInternalRep(arithSeriesObj);
@@ -494,43 +522,43 @@ ArithSeriesObjStep(
 /*
  *----------------------------------------------------------------------
  *
- * TclArithSeriesObjIndex --
+ * ArithSeriesObjIndex --
  *
- *	Returns the element with the specified index in the list
- *	represented by the specified Arithmetic Sequence object.
- *	If the index is out of range, NULL is returned.
+ *	Stores in **resultPtr the element with the specified index in the list
+ *	represented by the specified Arithmetic Sequence object.  If the index
+ *	is out of range.
  *
  * Results:
  *
- * 	The element on success, NULL on index out of range.
- *
- * Side Effects:
- *
- * 	On success, the integer pointed by *element is modified.
+ * 	TCL_OK on success, and TCL_ERROR if the index is out of range.
  *
  *----------------------------------------------------------------------
  */
 
-Tcl_Obj *
-TclArithSeriesObjIndex(
+int
+ArithSeriesObjIndex(
     TCL_UNUSED(Tcl_Interp *),
     Tcl_Obj *arithSeriesObj,
-    Tcl_WideInt index)
+    Tcl_Size index,
+    Tcl_Obj **resultPtr)
 {
     ArithSeries *arithSeriesRepPtr;
 
-    if (arithSeriesObj->typePtr != &tclArithSeriesType.objType) {
-	Tcl_Panic("TclArithSeriesObjIndex called with a not ArithSeries Obj.");
+    if (arithSeriesObj->typePtr != tclArithSeriesType) {
+	Tcl_Panic("ArithSeriesObjIndex called with a not ArithSeries Obj.");
     }
     arithSeriesRepPtr = ArithSeriesGetInternalRep(arithSeriesObj);
-    if (index < 0 || (Tcl_Size)index >= arithSeriesRepPtr->len) {
-	return Tcl_NewObj();
+    if (index < 0 || index >= arithSeriesRepPtr->len) {
+	*resultPtr = Tcl_NewObj();
+	return TCL_OK;
     }
     /* List[i] = Start + (Step * index) */
     if (arithSeriesRepPtr->isDouble) {
-	return Tcl_NewDoubleObj(ArithSeriesIndexDbl(arithSeriesRepPtr, index));
+	*resultPtr = Tcl_NewDoubleObj(ArithSeriesIndexDbl(arithSeriesRepPtr, index));
+	return TCL_OK;
     } else {
-	return Tcl_NewWideIntObj(ArithSeriesIndexInt(arithSeriesRepPtr, index));
+	*resultPtr = Tcl_NewWideIntObj(ArithSeriesIndexInt(arithSeriesRepPtr, index));
+	return TCL_OK;
     }
 }
 
@@ -551,11 +579,13 @@ TclArithSeriesObjIndex(
  *
  *----------------------------------------------------------------------
  */
-Tcl_Size ArithSeriesObjLength(Tcl_Obj *arithSeriesObj)
+int ArithSeriesObjLength(TCL_UNUSED(Tcl_Interp *),
+    Tcl_Obj *arithSeriesObj, Tcl_Size *result)
 {
     ArithSeries *arithSeriesRepPtr = (ArithSeries*)
 	    arithSeriesObj->internalRep.twoPtrValue.ptr1;
-    return arithSeriesRepPtr->len;
+    *result = arithSeriesRepPtr->len;
+    return TCL_OK;
 }
 
 /*
@@ -638,7 +668,7 @@ DupArithSeriesInternalRep(
 	copyPtr->internalRep.twoPtrValue.ptr1 = copyArithSeriesRepPtr;
     }
     copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
-    copyPtr->typePtr = &tclArithSeriesType.objType;
+    copyPtr->typePtr = tclArithSeriesType;
 }
 
 /*
@@ -712,7 +742,7 @@ UpdateStringOfArithSeries(Tcl_Obj *arithSeriesObj)
 	Tcl_Panic("Unable to allocate string size %" TCL_Z_MODIFIER "u", length);
     }
     for (i = 0; i < arithSeriesRepPtr->len; i++) {
-	elemObj = TclArithSeriesObjIndex(NULL, arithSeriesObj, i);
+	ArithSeriesObjIndex(NULL, arithSeriesObj, i, &elemObj);
 	elem = Tcl_GetStringFromObj(elemObj, &slen);
 	if (((p - arithSeriesObj->bytes)+slen) > length) {
 	    break;
@@ -777,7 +807,7 @@ SetArithSeriesFromAny(
  */
 
 Tcl_Obj *
-TclArithSeriesObjRange(
+ArithSeriesObjRange(
     Tcl_Interp *interp,         /* For error message(s) */
     Tcl_Obj *arithSeriesObj,	/* List object to take a range from. */
     Tcl_Size fromIdx,		/* Index of first element to include. */
@@ -810,12 +840,12 @@ TclArithSeriesObjRange(
 	toIdx = arithSeriesRepPtr->len-1;
     }
 
-    startObj = TclArithSeriesObjIndex(interp, arithSeriesObj, fromIdx);
+    ArithSeriesObjIndex(interp, arithSeriesObj, fromIdx, &startObj);
     if (startObj == NULL) {
 	return NULL;
     }
     Tcl_IncrRefCount(startObj);
-    endObj = TclArithSeriesObjIndex(interp, arithSeriesObj, toIdx);
+    ArithSeriesObjIndex(interp, arithSeriesObj, toIdx, &endObj);
     if (endObj == NULL) {
 	return NULL;
     }
@@ -884,7 +914,7 @@ TclArithSeriesObjRange(
 /*
  *----------------------------------------------------------------------
  *
- * TclArithSeriesGetElements --
+ * ArithSeriesGetElements --
  *
  *	This function returns an (objc,objv) array of the elements in a list
  *	object.
@@ -911,7 +941,7 @@ TclArithSeriesObjRange(
  */
 
 int
-TclArithSeriesGetElements(
+ArithSeriesGetElements(
     Tcl_Interp *interp,		/* Used to report errors if not NULL. */
     Tcl_Obj *objPtr,		/* ArithSeries object for which an element
 				 * array is to be returned. */
@@ -920,7 +950,7 @@ TclArithSeriesGetElements(
     Tcl_Obj ***objvPtr)		/* Where to store the pointer to an array of
 				 * pointers to the list's objects. */
 {
-    if (TclHasInternalRep(objPtr,&tclArithSeriesType.objType)) {
+    if (TclHasInternalRep(objPtr,tclArithSeriesType)) {
 	ArithSeries *arithSeriesRepPtr;
 	Tcl_Obj **objv;
 	int i, objc;
@@ -945,7 +975,7 @@ TclArithSeriesGetElements(
 		}
 		arithSeriesRepPtr->elements = objv;
 		for (i = 0; i < objc; i++) {
-		    objv[i] = TclArithSeriesObjIndex(interp, objPtr, i);
+		    ArithSeriesObjIndex(interp, objPtr, i, &objv[i]);
 		    if (objv[i] == NULL) {
 			return TCL_ERROR;
 		    }
@@ -972,7 +1002,7 @@ TclArithSeriesGetElements(
 /*
  *----------------------------------------------------------------------
  *
- * TclArithSeriesObjReverse --
+ * ArithSeriesObjReverse --
  *
  *	Reverse the order of the ArithSeries value.
  *      *arithSeriesObj must be known to be a valid list.
@@ -989,7 +1019,7 @@ TclArithSeriesGetElements(
  */
 
 Tcl_Obj *
-TclArithSeriesObjReverse(
+ArithSeriesObjReverse(
     Tcl_Interp *interp,         /* For error message(s) */
     Tcl_Obj *arithSeriesObj)	/* List object to reverse. */
 {
@@ -1005,9 +1035,9 @@ TclArithSeriesObjReverse(
     isDouble = arithSeriesRepPtr->isDouble;
     len = arithSeriesRepPtr->len;
 
-    startObj = TclArithSeriesObjIndex(NULL, arithSeriesObj, (len-1));
+    ArithSeriesObjIndex(NULL, arithSeriesObj, (len-1), &startObj);
     Tcl_IncrRefCount(startObj);
-    endObj = TclArithSeriesObjIndex(NULL, arithSeriesObj, 0);
+    ArithSeriesObjIndex(NULL, arithSeriesObj, 0, &endObj);
     Tcl_IncrRefCount(endObj);
     stepObj = ArithSeriesObjStep(arithSeriesObj);
     Tcl_IncrRefCount(stepObj);

generic/tclArithSeries.h

@@ -34,14 +34,6 @@ typedef struct {
 } ArithSeriesDbl;
 
 
-MODULE_SCOPE  Tcl_Obj *TclArithSeriesObjIndex(Tcl_Interp *, Tcl_Obj *,
-			    Tcl_WideInt index);
-MODULE_SCOPE Tcl_Obj *	TclArithSeriesObjRange(Tcl_Interp *interp,
-			    Tcl_Obj *arithSeriesPtr, Tcl_Size fromIdx, Tcl_Size toIdx);
-MODULE_SCOPE Tcl_Obj *	TclArithSeriesObjReverse(Tcl_Interp *interp,
-			    Tcl_Obj *arithSeriesPtr);
-MODULE_SCOPE int	TclArithSeriesGetElements(Tcl_Interp *interp,
-			    Tcl_Obj *objPtr, Tcl_Size *objcPtr, Tcl_Obj ***objvPtr);
 MODULE_SCOPE int 	TclNewArithSeriesObj(Tcl_Interp *interp,
 			    Tcl_Obj **arithSeriesObj, int useDoubles,
 			    Tcl_Obj *startObj, Tcl_Obj *endObj,

generic/tclBasic.c

@@ -6152,7 +6152,7 @@ TclNREvalObjEx(
 	 */
 
 	Tcl_IncrRefCount(objPtr);
-	listPtr = TclDuplicatePureObj(interp, objPtr, &tclListType.objType);
+	listPtr = TclDuplicatePureObj(interp, objPtr, tclListType);
 	if (!listPtr) {
 	    Tcl_DecrRefCount(objPtr);
 	    return TCL_ERROR;
@@ -7050,7 +7050,7 @@ ExprCeilFunc(
     code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
 #ifdef ACCEPT_NAN
     if (code != TCL_OK) {
-	const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType.objType);
+	const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], tclDoubleType);
 
 	if (irPtr) {
 	    Tcl_SetObjResult(interp, objv[1]);
@@ -7090,7 +7090,7 @@ ExprFloorFunc(
     code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
 #ifdef ACCEPT_NAN
     if (code != TCL_OK) {
-	const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType.objType);
+	const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], tclDoubleType);
 
 	if (irPtr) {
 	    Tcl_SetObjResult(interp, objv[1]);
@@ -7236,7 +7236,7 @@ ExprSqrtFunc(
     code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
 #ifdef ACCEPT_NAN
     if (code != TCL_OK) {
-	const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType.objType);
+	const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], tclDoubleType);
 
 	if (irPtr) {
 	    Tcl_SetObjResult(interp, objv[1]);
@@ -7290,7 +7290,7 @@ ExprUnaryFunc(
     code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
 #ifdef ACCEPT_NAN
     if (code != TCL_OK) {
-	const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType.objType);
+	const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], tclDoubleType);
 
 	if (irPtr) {
 	    d = irPtr->doubleValue;
@@ -7354,7 +7354,7 @@ ExprBinaryFunc(
     code = Tcl_GetDoubleFromObj(interp, objv[1], &d1);
 #ifdef ACCEPT_NAN
     if (code != TCL_OK) {
-	const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType.objType);
+	const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], tclDoubleType);
 
 	if (irPtr) {
 	    d1 = irPtr->doubleValue;
@@ -7369,7 +7369,7 @@ ExprBinaryFunc(
     code = Tcl_GetDoubleFromObj(interp, objv[2], &d2);
 #ifdef ACCEPT_NAN
     if (code != TCL_OK) {
-	const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType.objType);
+	const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], tclDoubleType);
 
 	if (irPtr) {
 	    d2 = irPtr->doubleValue;
@@ -7530,7 +7530,7 @@ ExprDoubleFunc(
     }
     if (Tcl_GetDoubleFromObj(interp, objv[1], &dResult) != TCL_OK) {
 #ifdef ACCEPT_NAN
-	if (TclHasInternalRep(objv[1], &tclDoubleType.objType)) {
+	if (TclHasInternalRep(objv[1], tclDoubleType)) {
 	    Tcl_SetObjResult(interp, objv[1]);
 	    return TCL_OK;
 	}

generic/tclBinary.c

@@ -381,35 +381,6 @@ Tcl_GetBytesFromObj(
     return baPtr->bytes;
 }
 
-#if !defined(TCL_NO_DEPRECATED)
-unsigned char *
-TclGetBytesFromObj(
-    Tcl_Interp *interp,		/* For error reporting */
-    Tcl_Obj *objPtr,		/* Value to extract from */
-    void *numBytesPtr)		/* If non-NULL, write the number of bytes
-				 * in the array here */
-{
-    Tcl_Size numBytes = 0;
-    unsigned char *bytes = Tcl_GetBytesFromObj(interp, objPtr, &numBytes);
-
-    if (bytes && numBytesPtr) {
-	if (numBytes > INT_MAX) {
-	    /* Caller asked for numBytes to be written to an int, but the
-	     * value is outside the int range. */
-
-	    if (interp) {
-		Tcl_SetObjResult(interp, Tcl_NewStringObj(
-			"byte sequence length exceeds INT_MAX", -1));
-		Tcl_SetErrorCode(interp, "TCL", "API", "OUTDATED", NULL);
-	    }
-	    return NULL;
-	} else {
-	    *(int *)numBytesPtr = (int) numBytes;
-	}
-    }
-    return bytes;
-}
-#endif
 
 /*
  *----------------------------------------------------------------------
@@ -509,7 +480,7 @@ MakeByteArray(
 
     for (; src < srcEnd && dst < dstEnd; ) {
 	int ch;
-	int count = TclUtfToUCS4(src, &ch);
+	int count = Tcl_UtfToUniChar(src, &ch);
 
 	if (ch > 255) {
 	    proper = 0;
@@ -2001,7 +1972,7 @@ FormatNumber(
 	 */
 
 	if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) {
-	    const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(src, &tclDoubleType.objType);
+	    const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(src, tclDoubleType);
 	    if (irPtr == NULL) {
 		return TCL_ERROR;
 	    }
@@ -2021,7 +1992,7 @@ FormatNumber(
 	 */
 
 	if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) {
-	    const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(src, &tclDoubleType.objType);
+	    const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(src, tclDoubleType);
 
 	    if (irPtr == NULL) {
 		return TCL_ERROR;
@@ -2561,7 +2532,7 @@ BinaryDecodeHex(
     if (pure) {
 	ucs4 = c;
     } else {
-	TclUtfToUCS4((const char *)(data - 1), &ucs4);
+	Tcl_UtfToUniChar((const char *)(data - 1), &ucs4);
     }
     TclDecrRefCount(resultObj);
     Tcl_SetObjResult(interp, Tcl_ObjPrintf(
@@ -3026,7 +2997,7 @@ BinaryDecodeUu(
     if (pure) {
 	ucs4 = c;
     } else {
-	TclUtfToUCS4((const char *)(data - 1), &ucs4);
+	Tcl_UtfToUniChar((const char *)(data - 1), &ucs4);
     }
     Tcl_SetObjResult(interp, Tcl_ObjPrintf(
 	    "invalid uuencode character \"%c\" (U+%06X) at position %"
@@ -3201,7 +3172,7 @@ BinaryDecode64(
 	 * of a multi-byte character. */
 
 	/* Safe because we know data is NUL-terminated */
-	TclUtfToUCS4((const char *)(data - 1), &ucs4);
+	Tcl_UtfToUniChar((const char *)(data - 1), &ucs4);
     }
 
     Tcl_SetObjResult(interp, Tcl_ObjPrintf(

generic/tclClock.c

@@ -433,7 +433,7 @@ ClockGetdatefieldsObjCmd(
      * that it isn't.
      */
 
-    if (TclHasInternalRep(objv[1], &tclBignumType.objType)) {
+    if (TclHasInternalRep(objv[1], tclBignumType)) {
 	Tcl_SetObjResult(interp, lit[LIT_INTEGER_VALUE_TOO_LARGE]);
 	return TCL_ERROR;
     }

generic/tclCmdAH.c

@@ -17,7 +17,6 @@
 #ifdef _WIN32
 #   include "tclWinInt.h"
 #endif
-#include "tclArithSeries.h"
 
 /*
  * The state structure used by [foreach]. Note that the actual structure has
@@ -435,7 +434,7 @@ EncodingConvertParseOptions (
     Tcl_Encoding encoding;
     Tcl_Obj *dataObj;
     Tcl_Obj *failVarObj;
-    int profile = TCL_ENCODING_PROFILE_TCL8;
+    int profile = TCL_ENCODING_PROFILE_STRICT;
 
     /*
      * Possible combinations:
@@ -2789,7 +2788,7 @@ EachloopCmd(
 	/* List */
 	/* Variables */
 	statePtr->vCopyList[i] = TclDuplicatePureObj(
-	    interp, objv[1+i*2], &tclListType.objType);
+	    interp, objv[1+i*2], tclListType);
 	if (!statePtr->vCopyList[i]) {
 	    result = TCL_ERROR;
 	    goto done;
@@ -2814,19 +2813,25 @@ EachloopCmd(
 	    &statePtr->varcList[i], &statePtr->varvList[i]);
 
 	/* Values */
-	if (TclHasInternalRep(objv[2+i*2],&tclArithSeriesType.objType)) {
-	    /* Special case for Arith Series */
+	if (TclObjectHasInterface(objv[2+i*2], list, length)) {
+	    int status;
 	    statePtr->aCopyList[i] = Tcl_DuplicateObj(objv[2+i*2]);
+	    Tcl_IncrRefCount(statePtr->aCopyList[i]);
 	    if (statePtr->aCopyList[i] == NULL) {
 		result = TCL_ERROR;
 		goto done;
 	    }
 	    /* Don't compute values here, wait until the last moment */
-	    statePtr->argcList[i] = ABSTRACTLIST_PROC(statePtr->aCopyList[i], lengthProc)(statePtr->aCopyList[i]);
+	    TclObjectDispatchNoDefault(interp, status, statePtr->aCopyList[i], list,
+		length, interp, statePtr->aCopyList[i], &statePtr->argcList[i]);
+	    if (status != TCL_OK) {
+		result = TCL_ERROR;
+		goto done;
+	    }
 	} else {
 	    /* List values */
 	    statePtr->aCopyList[i] = TclDuplicatePureObj(
-		interp, objv[2+i*2], &tclListType.objType);
+		interp, objv[2+i*2], tclListType);
 	    if (!statePtr->aCopyList[i]) {
 		result = TCL_ERROR;
 		goto done;
@@ -2964,12 +2969,15 @@ ForeachAssignments(
     Tcl_Obj *valuePtr, *varValuePtr;
 
     for (i=0 ; i<statePtr->numLists ; i++) {
-	int isarithseries = TclHasInternalRep(statePtr->aCopyList[i],&tclArithSeriesType.objType);
+	TCL_UNUSEDVAR(int status);
+	int hasindexinterface = TclObjectHasInterface(
+	    statePtr->aCopyList[i], list, index);
 	for (v=0 ; v<statePtr->varcList[i] ; v++) {
 	    k = statePtr->index[i]++;
 	    if (k < statePtr->argcList[i]) {
-		if (isarithseries) {
-		    valuePtr = TclArithSeriesObjIndex(interp, statePtr->aCopyList[i], k);
+		if (hasindexinterface) {
+		    TclObjectDispatchNoDefault(interp, status, statePtr->aCopyList[i], list,
+			index, interp, statePtr->aCopyList[i], k, &valuePtr);
 		    if (valuePtr == NULL) {
 			Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
 			"\n    (setting %s loop variable \"%s\")",

generic/tclCmdIL.c

@@ -2203,8 +2203,8 @@ Tcl_JoinObjCmd(
     Tcl_Obj *const objv[])	/* The argument objects. */
 {
     Tcl_Size length, listLen;
-    int isArithSeries = 0;
-    Tcl_Obj *resObjPtr = NULL, *joinObjPtr, **elemPtrs;
+    int status;
+    Tcl_Obj *resObjPtr = NULL, *joinObjPtr, **elemPtrs = NULL;
 
     if ((objc < 2) || (objc > 3)) {
 	Tcl_WrongNumArgs(interp, 1, objv, "list ?joinString?");
@@ -2216,9 +2216,12 @@ Tcl_JoinObjCmd(
      * pointer to its array of element pointers.
      */
 
-    if (TclHasInternalRep(objv[1],&tclArithSeriesType.objType)) {
-	isArithSeries = 1;
-	listLen = ABSTRACTLIST_PROC(objv[1], lengthProc)(objv[1]);
+    if (TclObjectHasInterface(objv[1], list, length)) {
+	status = TclObjectDispatchNoDefault(interp, status, objv[1], list,
+	    length, interp, objv[1], &listLen);
+	if (status != TCL_OK ) {
+	    return TCL_ERROR;
+	}
     } else {
 	if (TclListObjGetElementsM(interp, objv[1], &listLen,
 	    &elemPtrs) != TCL_OK) {
@@ -2231,14 +2234,22 @@ Tcl_JoinObjCmd(
 	return TCL_OK;
     }
     if (listLen == 1) {
+	Tcl_Obj *valueObj;
 	/* One element; return it */
-	if (isArithSeries) {
-	    Tcl_Obj *valueObj = TclArithSeriesObjIndex(interp, objv[1], 0);
-	    if (valueObj == NULL) {
+	if (TclObjectHasInterface(objv[1], list, index)) {
+	    TclObjectDispatchNoDefault(interp, status, objv[1], list,
+		index, interp, objv[1], 0, &valueObj);
+	    if (status != TCL_OK) {
 		return TCL_ERROR;
 	    }
 	    Tcl_SetObjResult(interp, valueObj);
 	} else {
+	    if (elemPtrs == NULL) {
+		if (TclListObjGetElementsM(interp, objv[1], &listLen,
+		    &elemPtrs) != TCL_OK) {
+		    return TCL_ERROR;
+		}
+	    }
 	    Tcl_SetObjResult(interp, elemPtrs[0]);
 	}
 	return TCL_OK;
@@ -2249,12 +2260,16 @@ Tcl_JoinObjCmd(
 
     (void) Tcl_GetStringFromObj(joinObjPtr, &length);
     if (length == 0) {
+	if (TclListObjGetElementsM(interp, objv[1], &listLen,
+	    &elemPtrs) != TCL_OK) {
+	    return TCL_ERROR;
+	}
 	resObjPtr = TclStringCat(interp, listLen, elemPtrs, 0);
     } else {
 	Tcl_Size i;
 
 	TclNewObj(resObjPtr);
-	if (isArithSeries) {
+	if (TclObjectHasInterface(objv[1], list, index)) {
 	    Tcl_Obj *valueObj;
 	    for (i = 0;  i < listLen;  i++) {
 		if (i > 0) {
@@ -2268,14 +2283,21 @@ Tcl_JoinObjCmd(
 
 		    Tcl_AppendObjToObj(resObjPtr, joinObjPtr);
 		}
-		valueObj = TclArithSeriesObjIndex(interp, objv[1], i);
-		if (valueObj == NULL) {
+		TclObjectDispatchNoDefault(interp, status, objv[1], list,
+		    index, interp, objv[1], i, &valueObj);
+		if (status != TCL_OK) {
 		    return TCL_ERROR;
 		}
 		Tcl_AppendObjToObj(resObjPtr, valueObj);
-		Tcl_DecrRefCount(valueObj);
+		TclBounceRefCount(valueObj);
 	    }
 	} else {
+	    if (elemPtrs == NULL) {
+		if (TclListObjGetElementsM(interp, objv[1], &listLen,
+		    &elemPtrs) != TCL_OK) {
+		    return TCL_ERROR;
+		}
+	    }
 	    for (i = 0;  i < listLen;  i++) {
 		if (i > 0) {
 
@@ -2335,7 +2357,7 @@ Tcl_LassignObjCmd(
 	return TCL_ERROR;
     }
 
-    listCopyPtr = TclDuplicatePureObj(interp, objv[1], &tclListType.objType);
+    listCopyPtr = TclDuplicatePureObj(interp, objv[1], tclListType);
     if (!listCopyPtr) {
 	return TCL_ERROR;
     }
@@ -2505,7 +2527,7 @@ Tcl_LinsertObjCmd(
 
     listPtr = objv[1];
     if (Tcl_IsShared(listPtr)) {
-	listPtr = TclDuplicatePureObj(interp, listPtr, &tclListType.objType);
+	listPtr = TclDuplicatePureObj(interp, listPtr, tclListType);
 	if (!listPtr) {
 	    return TCL_ERROR;
 	}
@@ -2705,7 +2727,7 @@ Tcl_LpopObjCmd(
 
     if (objc == 2) {
 	if (Tcl_IsShared(listPtr)) {
-	    listPtr = TclDuplicatePureObj(interp, listPtr, &tclListType.objType);
+	    listPtr = TclDuplicatePureObj(interp, listPtr, tclListType);
 	    if (!listPtr) {
 		return TCL_ERROR;
 	    }
@@ -2764,8 +2786,8 @@ Tcl_LrangeObjCmd(
     Tcl_Obj *const objv[])
 				/* Argument objects. */
 {
-    int result;
-    Tcl_Size listLen, first, last;
+    int result, status;
+    Tcl_Size fromAnchor, first, fromIdx, last, listLen, toAnchor, toIdx;
     if (objc != 4) {
 	Tcl_WrongNumArgs(interp, 1, objv, "list first last");
 	return TCL_ERROR;
@@ -2776,27 +2798,48 @@ Tcl_LrangeObjCmd(
 	return result;
     }
 
-    result = TclGetIntForIndexM(interp, objv[2], /*endValue*/ listLen - 1,
-	    &first);
+    result = TclGetIntForIndexM(interp, objv[2], /*endValue*/ TCL_SIZE_MAX - 1,
+	&toIdx);
     if (result != TCL_OK) {
 	return result;
     }
 
-    result = TclGetIntForIndexM(interp, objv[3], /*endValue*/ listLen - 1,
-	    &last);
+    result = TclGetIntForIndexM(interp, objv[2], /*endValue*/ TCL_SIZE_MAX - 1,
+	&fromIdx);
     if (result != TCL_OK) {
 	return result;
     }
 
-    if (TclHasInternalRep(objv[1],&tclArithSeriesType.objType)) {
-	Tcl_Obj *rangeObj;
-	rangeObj = TclArithSeriesObjRange(interp, objv[1], first, last);
-	if (rangeObj) {
-	    Tcl_SetObjResult(interp, rangeObj);
-	} else {
+    toAnchor = TclIndexIsFromEnd(toIdx);
+    fromAnchor = TclIndexIsFromEnd(fromIdx);
+
+    if (!Tcl_LengthIsFinite(listLen)
+	&& (toAnchor == 1 || fromAnchor == 1)
+	&& TclObjectHasInterface(objv[1], list, rangeEnd)
+    ) {
+	Tcl_Obj *objResultPtr;
+
+	status = TclObjectDispatchNoDefault(interp, objResultPtr,
+	    objv[1], list, rangeEnd, interp, objv[1], toAnchor,
+	    toIdx, fromAnchor, fromIdx);
+	if (status != TCL_OK || objResultPtr == NULL) {
 	    return TCL_ERROR;
+	} else {
+	    Tcl_SetObjResult(interp, objResultPtr);
 	}
     } else {
+	result = TclGetIntForIndexM(interp, objv[2], /*endValue*/ listLen - 1,
+		&first);
+	if (result != TCL_OK) {
+	    return result;
+	}
+
+	result = TclGetIntForIndexM(interp, objv[3], /*endValue*/ listLen - 1,
+		&last);
+	if (result != TCL_OK) {
+	    return result;
+	}
+
 	Tcl_Obj *resultObj = TclListObjRange(interp, objv[1], first, last);
 	if (resultObj == NULL) {
 	    return TCL_ERROR;
@@ -2892,7 +2935,7 @@ Tcl_LremoveObjCmd(
      */
 
     if (Tcl_IsShared(listObj)) {
-	listObj = TclDuplicatePureObj(interp, listObj, &tclListType.objType);
+	listObj = TclDuplicatePureObj(interp, listObj, tclListType);
 	if (!listObj) {
 	    status = TCL_ERROR;
 	    goto done;
@@ -3147,7 +3190,7 @@ Tcl_LreplaceObjCmd(
 
     listPtr = objv[1];
     if (Tcl_IsShared(listPtr)) {
-	listPtr = TclDuplicatePureObj(interp, listPtr, &tclListType.objType);
+	listPtr = TclDuplicatePureObj(interp, listPtr, tclListType);
 	if (!listPtr) {
 	    return TCL_ERROR;
 	}
@@ -3207,19 +3250,18 @@ Tcl_LreverseObjCmd(
 	return TCL_ERROR;
     }
 
-    /*
-     *  Handle ArithSeries special case - don't shimmer a series into a list
-     *  just to reverse it.
-     */
-    if (TclHasInternalRep(objv[1],&tclArithSeriesType.objType)) {
-	Tcl_Obj *resObj = TclArithSeriesObjReverse(interp, objv[1]);
+    if (TclObjectHasInterface(objv[1], list, reverse)) {
+	TCL_UNUSEDVAR(int status);
+	Tcl_Obj *resObj;
+	TclObjectDispatchNoDefault(interp, resObj, objv[1], list,
+	    reverse, interp, objv[1]);
 	if (resObj) {
 	    Tcl_SetObjResult(interp, resObj);
 	    return TCL_OK;
 	} else {
 	    return TCL_ERROR;
 	}
-    } /* end ArithSeries */
+    }
 
     /* True List */
     if (TclListObjLengthM(interp, objv[1], &elemc) != TCL_OK) {
@@ -3314,7 +3356,7 @@ Tcl_LsearchObjCmd(
     int allMatches, inlineReturn, negatedMatch, returnSubindices, noCase;
     double patDouble, objDouble;
     SortInfo sortInfo;
-    Tcl_Obj *patObj, **listv, *listPtr, *startPtr, *itemPtr;
+    Tcl_Obj *patObj, *itemPtr, *item2Ptr, *listPtr, *subjectPtr, *startPtr;
     SortStrCmpFn_t strCmpFn = TclUtfCmp;
     Tcl_RegExp regexp = NULL;
     static const char *const options[] = {
@@ -3344,6 +3386,7 @@ Tcl_LsearchObjCmd(
     isIncreasing = 1;
     allMatches = 0;
     inlineReturn = 0;
+    itemPtr = NULL;
     returnSubindices = 0;
     negatedMatch = 0;
     bisect = 0;
@@ -3612,7 +3655,8 @@ Tcl_LsearchObjCmd(
      * pointer to its array of element pointers.
      */
 
-    result = TclListObjGetElementsM(interp, objv[objc - 2], &listc, &listv);
+    subjectPtr = objv[objc-2];
+    result = Tcl_ListObjLength(interp, subjectPtr, &listc);
     if (result != TCL_OK) {
 	goto done;
     }
@@ -3666,7 +3710,8 @@ Tcl_LsearchObjCmd(
      */
 
     if (startPtr) {
-	result = TclGetIntForIndexM(interp, startPtr, listc-1, &start);
+	result = TclGetIntForIndexM(interp, startPtr,
+	    (Tcl_LengthIsFinite(listc) ? listc - 1 : TCL_SIZE_MAX), &start);
 	if (result != TCL_OK) {
 	    goto done;
 	}
@@ -3675,16 +3720,17 @@ Tcl_LsearchObjCmd(
 	}
 
 	/*
-	 * If the search started past the end of the list, we just return a
+	 * If the search started past the end of the list, just return a
 	 * "did not match anything at all" result straight away. [Bug 1374778]
 	 */
 
-	if (start >= listc) {
+	if (Tcl_LengthIsFinite(listc) && start >= listc) {
 	    if (allMatches || inlineReturn) {
 		Tcl_ResetResult(interp);
 	    } else {
 		TclNewIntObj(itemPtr, -1);
 		Tcl_SetObjResult(interp, itemPtr);
+		itemPtr = NULL;
 	    }
 	    goto done;
 	}
@@ -3713,11 +3759,9 @@ Tcl_LsearchObjCmd(
 	    }
 
 	    /*
-	     * List representation might have been shimmered; restore it. [Bug
-	     * 1844789]
+	     * [Bug 1844789], "lsearch -exact -integer ..." crashes, was
+	     * previously fixed at this point.
 	     */
-
-	    TclListObjGetElementsM(NULL, objv[objc - 2], &listc, &listv);
 	    break;
 	case REAL:
 	    result = Tcl_GetDoubleFromObj(interp, patObj, &patDouble);
@@ -3726,11 +3770,9 @@ Tcl_LsearchObjCmd(
 	    }
 
 	    /*
-	     * List representation might have been shimmered; restore it. [Bug
-	     * 1844789]
+	     * [Bug 1844789], "lsearch -exact -integer ..." crashes, was
+	     * previously fixed at this point.
 	     */
-
-	    TclListObjGetElementsM(NULL, objv[objc - 2], &listc, &listv);
 	    break;
 	}
     } else {
@@ -3746,6 +3788,7 @@ Tcl_LsearchObjCmd(
     match = 0;
 
     if (mode == SORTED && !allMatches && !negatedMatch) {
+	int isfinite;
 	/*
 	 * If the data is sorted, we can do a more intelligent search. Note
 	 * that there is no point in being smart when -all was specified; in
@@ -3758,18 +3801,57 @@ Tcl_LsearchObjCmd(
 	 */
 
 	lower = start - groupSize;
-	upper = listc;
-	while (lower + groupSize != upper && sortInfo.resultCode == TCL_OK) {
-	    i = (lower + upper)/2;
+	isfinite = Tcl_LengthIsFinite(listc);
+	if (isfinite) {
+	    upper = listc;
+	} else {
+	    upper = 1;
+	}
+	while (
+	    (lower + groupSize < upper && sortInfo.resultCode == TCL_OK)
+	    || !isfinite
+	) {
+	    i = (lower + upper) / 2;
+	    if (i < 0) {
+		result = TCL_ERROR;
+		Tcl_SetObjResult(interp, Tcl_NewStringObj("sorted list is incoherent", -1));
+		goto done;
+	    }
 	    i -= i % groupSize;
+	    result = Tcl_ListObjIndex(interp, subjectPtr, i+groupOffset, &itemPtr);
+	    if (result != TCL_OK) {
+		if (isfinite) {
+		    goto done;
+		} else {
+		    if (Tcl_ListObjLength(interp, subjectPtr, &listc) == TCL_OK) {
+			isfinite = Tcl_LengthIsFinite(listc);
+			if (isfinite) {
+			    if (listc - 1 > i) {
+				upper = listc = 1;
+				break;
+			    } else {
+				goto done;
+			    }
+			} else {
+			    goto done;
+			}
+		    } else {
+			goto done;
+		    }
+		}
+	    }
+	    Tcl_IncrRefCount(itemPtr);
 	    if (sortInfo.indexc != 0) {
-		itemPtr = SelectObjFromSublist(listv[i+groupOffset], &sortInfo);
+		item2Ptr = SelectObjFromSublist(itemPtr, &sortInfo);
 		if (sortInfo.resultCode != TCL_OK) {
 		    result = sortInfo.resultCode;
 		    goto done;
 		}
-	    } else {
-		itemPtr = listv[i+groupOffset];
+		/* Increment item2Ptr refcount first in case it's the same
+		 * object as itemPtr. */
+		Tcl_IncrRefCount(item2Ptr);
+		Tcl_DecrRefCount(itemPtr);
+		itemPtr = item2Ptr;
 	    }
 	    switch (dataType) {
 	    case ASCII:
@@ -3807,6 +3889,8 @@ Tcl_LsearchObjCmd(
 		}
 		break;
 	    }
+	    Tcl_DecrRefCount(itemPtr);
+	    itemPtr = NULL;
 	    if (match == 0) {
 		/*
 		 * Normally, binary search is written to stop when it finds a
@@ -3833,14 +3917,22 @@ Tcl_LsearchObjCmd(
 	    } else if (match > 0) {
 		if (isIncreasing) {
 		    lower = i;
+		    if (!isfinite) {
+			upper *= 2;
+		    }
 		} else {
 		    upper = i;
+		    isfinite = 1;
 		}
 	    } else {
 		if (isIncreasing) {
 		    upper = i;
+		    isfinite = 1;
 		} else {
 		    lower = i;
+		    if (!isfinite) {
+			upper *= 2;
+		    }
 		}
 	    }
 	}
@@ -3858,10 +3950,15 @@ Tcl_LsearchObjCmd(
 	if (allMatches) {
 	    listPtr = Tcl_NewListObj(0, NULL);
 	}
-	for (i = start; i < listc; i += groupSize) {
+	for (i = start; listc < 0 || i < listc; i += groupSize) {
 	    match = 0;
+	    result = Tcl_ListObjIndex(interp, subjectPtr, i+groupOffset, &itemPtr);
+	    if (result != TCL_OK) {
+		goto done;
+	    }
+	    Tcl_IncrRefCount(itemPtr);
 	    if (sortInfo.indexc != 0) {
-		itemPtr = SelectObjFromSublist(listv[i+groupOffset], &sortInfo);
+		item2Ptr = SelectObjFromSublist(itemPtr, &sortInfo);
 		if (sortInfo.resultCode != TCL_OK) {
 		    if (listPtr != NULL) {
 			Tcl_DecrRefCount(listPtr);
@@ -3869,8 +3966,11 @@ Tcl_LsearchObjCmd(
 		    result = sortInfo.resultCode;
 		    goto done;
 		}
-	    } else {
-		itemPtr = listv[i+groupOffset];
+		/* Increment item2Ptr refcount first in case it's the same
+		 * object as itemPtr. */
+		Tcl_IncrRefCount(item2Ptr);
+		Tcl_DecrRefCount(itemPtr);
+		itemPtr = item2Ptr;
 	    }
 
 	    switch (mode) {
@@ -3948,41 +4048,66 @@ Tcl_LsearchObjCmd(
 		match = !match;
 	    }
 	    if (!match) {
+		Tcl_DecrRefCount(itemPtr);
+		itemPtr = NULL;
 		continue;
 	    }
 	    if (!allMatches) {
 		index = i;
+		Tcl_DecrRefCount(itemPtr);
+		itemPtr = NULL;
 		break;
 	    } else if (inlineReturn) {
 		/*
-		 * Note that these appends are not expected to fail.
+		 * These append operations are expected to not fail.
 		 */
+		Tcl_DecrRefCount(itemPtr);
+		itemPtr = NULL;
 
 		if (returnSubindices && (sortInfo.indexc != 0)) {
-		    itemPtr = SelectObjFromSublist(listv[i+groupOffset],
-			    &sortInfo);
-		    Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
+		    result = Tcl_ListObjIndex(interp, subjectPtr, i+groupOffset, &itemPtr);
+		    if (result != TCL_OK) {
+			goto done;
+		    }
+		    Tcl_IncrRefCount(itemPtr);
+		    item2Ptr = SelectObjFromSublist(itemPtr, &sortInfo);
+		    Tcl_ListObjAppendElement(interp, listPtr, item2Ptr);
+		    Tcl_DecrRefCount(itemPtr);
 		} else if (groupSize > 1) {
-		    Tcl_ListObjReplace(interp, listPtr, LIST_MAX, 0,
-			    groupSize, &listv[i]);
+		    Tcl_Size j;
+		    for (j = 0; j < groupSize; j++) {
+			result = Tcl_ListObjIndex(interp, subjectPtr,
+			    i+j, &itemPtr);
+			if (result != TCL_OK) {
+			    goto done;
+			}
+			Tcl_ListObjReplace(interp, listPtr, LIST_MAX, 0,
+				1, &itemPtr);
+		    }
 		} else {
-		    itemPtr = listv[i];
+		    result = Tcl_ListObjIndex(interp, subjectPtr, i, &itemPtr);
+		    if (result != TCL_OK) {
+			goto done;
+		    }
 		    Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
 		}
 	    } else if (returnSubindices) {
 		Tcl_Size j;
 
+		Tcl_DecrRefCount(itemPtr);
 		TclNewIndexObj(itemPtr, i+groupOffset);
 		for (j=0 ; j<sortInfo.indexc ; j++) {
 		    Tcl_Obj *elObj;
-		    size_t elValue = TclIndexDecode(sortInfo.indexv[j], listc);
+		    Tcl_Size elValue = TclIndexDecode(sortInfo.indexv[j], listc);
 		    TclNewIndexObj(elObj, elValue);
 		    Tcl_ListObjAppendElement(interp, itemPtr, elObj);
 		}
 		Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
 	    } else {
+		Tcl_DecrRefCount(itemPtr);
 		Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewWideIntObj(i));
 	    }
+	    itemPtr = NULL;
 	}
     }
 
@@ -4004,9 +4129,10 @@ Tcl_LsearchObjCmd(
 		Tcl_ListObjAppendElement(interp, itemPtr, elObj);
 	    }
 	    Tcl_SetObjResult(interp, itemPtr);
+	    itemPtr = NULL;
 	} else {
-		Tcl_Obj *elObj;
-		TclNewIndexObj(elObj, index);
+	    Tcl_Obj *elObj;
+	    TclNewIndexObj(elObj, index);
 	    Tcl_SetObjResult(interp, elObj);
 	}
     } else if (index < 0) {
@@ -4018,13 +4144,32 @@ Tcl_LsearchObjCmd(
 	Tcl_SetObjResult(interp, Tcl_NewObj());
     } else {
 	if (returnSubindices) {
-	    Tcl_SetObjResult(interp, SelectObjFromSublist(listv[i+groupOffset],
-		    &sortInfo));
+	    result = Tcl_ListObjIndex(interp, subjectPtr, i+groupOffset, &itemPtr);
+	    if (result != TCL_OK) {
+		goto done;
+	    }
+	    item2Ptr = SelectObjFromSublist(itemPtr, &sortInfo);
+	    Tcl_SetObjResult(interp, item2Ptr);
 	} else if (groupSize > 1) {
-	    Tcl_SetObjResult(interp, Tcl_NewListObj(groupSize, &listv[index]));
+	    Tcl_Size j;
+	    listPtr = Tcl_NewListObj(0, NULL);
+	    for (j = 0; j < groupSize; j++) {
+		result = Tcl_ListObjIndex(interp, subjectPtr, index + j, &itemPtr);
+		if (result != TCL_OK) {
+		    Tcl_DecrRefCount(listPtr);
+		    goto done;
+		}
+		Tcl_ListObjAppendElement(interp, listPtr, itemPtr);
+	    }
+	    Tcl_SetObjResult(interp, listPtr);
 	} else {
-	    Tcl_SetObjResult(interp, listv[index]);
+	    result = Tcl_ListObjIndex(interp, subjectPtr, index, &itemPtr);
+	    if (result != TCL_OK) {
+		goto done;
+	    }
+	    Tcl_SetObjResult(interp, itemPtr);
 	}
+	itemPtr = NULL;
     }
     result = TCL_OK;
 
@@ -4033,6 +4178,9 @@ Tcl_LsearchObjCmd(
      */
 
   done:
+    if (itemPtr != NULL) {
+	Tcl_DecrRefCount(itemPtr);
+    }
     if (startPtr != NULL) {
 	Tcl_DecrRefCount(startPtr);
     }
@@ -4041,6 +4189,7 @@ Tcl_LsearchObjCmd(
     }
     return result;
 }
+
 
 /*
  *----------------------------------------------------------------------
@@ -4771,7 +4920,7 @@ Tcl_LsortObjCmd(
 	 * 1675116]
 	 */
 
-	listObj = TclDuplicatePureObj(interp ,listObj, &tclListType.objType);
+	listObj = TclDuplicatePureObj(interp ,listObj, tclListType);
 	if (listObj == NULL) {
 	    sortInfo.resultCode = TCL_ERROR;
 	    goto done;
@@ -4796,9 +4945,10 @@ Tcl_LsortObjCmd(
 	sortInfo.compareCmdPtr = newCommandPtr;
     }
 
-    if (TclHasInternalRep(listObj,&tclArithSeriesType.objType)) {
-	sortInfo.resultCode = TclArithSeriesGetElements(interp,
-	    listObj, &length, &listObjPtrs);
+    if (TclObjectHasInterface(listObj, list, all)) {
+	TCL_UNUSEDVAR(int status);
+	sortInfo.resultCode = TclObjectDispatchNoDefault(interp, status,
+	    listObj, list, all, interp, listObj, &length, &listObjPtrs);
     } else {
 	sortInfo.resultCode = TclListObjGetElementsM(interp, listObj,
 	    &length, &listObjPtrs);
@@ -4992,7 +5142,7 @@ Tcl_LsortObjCmd(
 	ListObjGetRep(resultPtr, &listRep);
 	newArray = ListRepElementsBase(&listRep);
 	if (group) {
-	    for (i=0; elementPtr!=NULL ; elementPtr=elementPtr->nextPtr) {
+	    for (i=0; elementPtr != NULL ; elementPtr = elementPtr->nextPtr) {
 		idx = elementPtr->payload.index;
 		for (j = 0; j < groupSize; j++) {
 		    if (indices) {
@@ -5127,7 +5277,7 @@ Tcl_LeditObjCmd(
     }
 
     if (Tcl_IsShared(listPtr)) {
-	listPtr = TclDuplicatePureObj(interp, listPtr, &tclListType.objType);
+	listPtr = TclDuplicatePureObj(interp, listPtr, tclListType);
 	if (!listPtr) {
 	    return TCL_ERROR;
 	}
@@ -5465,8 +5615,8 @@ DictionaryCompare(
 	 */
 
 	if ((*left != '\0') && (*right != '\0')) {
-	    left += TclUtfToUCS4(left, &uniLeft);
-	    right += TclUtfToUCS4(right, &uniRight);
+	    left += Tcl_UtfToUniChar(left, &uniLeft);
+	    right += Tcl_UtfToUniChar(right, &uniRight);
 
 	    /*
 	     * Convert both chars to lower for the comparison, because

generic/tclCmdMZ.c

@@ -24,6 +24,7 @@
 
 static inline Tcl_Obj *	During(Tcl_Interp *interp, int resultCode,
 			    Tcl_Obj *oldOptions, Tcl_Obj *errorInfo);
+
 static Tcl_NRPostProc	SwitchPostProc;
 static Tcl_NRPostProc	TryPostBody;
 static Tcl_NRPostProc	TryPostFinal;
@@ -1217,7 +1218,7 @@ Tcl_SplitObjCmd(
 	Tcl_InitHashTable(&charReuseTable, TCL_ONE_WORD_KEYS);
 
 	for ( ; stringPtr < end; stringPtr += len) {
-	    len = TclUtfToUCS4(stringPtr, &ch);
+	    len = Tcl_UtfToUniChar(stringPtr, &ch);
 	    hPtr = Tcl_CreateHashEntry(&charReuseTable, INT2PTR(ch), &isNew);
 	    if (isNew) {
 		TclNewStringObj(objPtr, stringPtr, len);
@@ -1263,9 +1264,9 @@ Tcl_SplitObjCmd(
 	splitEnd = splitChars + splitCharLen;
 
 	for (element = stringPtr; stringPtr < end; stringPtr += len) {
-	    len = TclUtfToUCS4(stringPtr, &ch);
+	    len = Tcl_UtfToUniChar(stringPtr, &ch);
 	    for (p = splitChars; p < splitEnd; p += splitLen) {
-		splitLen = TclUtfToUCS4(p, &splitChar);
+		splitLen = Tcl_UtfToUniChar(p, &splitChar);
 		if (ch == splitChar) {
 		    TclNewStringObj(objPtr, element, stringPtr - element);
 		    Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
@@ -1311,7 +1312,7 @@ StringFirstCmd(
 
     if (objc < 3 || objc > 4) {
 	Tcl_WrongNumArgs(interp, 1, objv,
-		"needleString haystackString ?startIndex?");
+	    "needleString haystackString ?startIndex?");
 	return TCL_ERROR;
     }
 
@@ -1402,44 +1403,51 @@ StringIndexCmd(
 	return TCL_ERROR;
     }
 
-    /*
-     * Get the char length to calculate what 'end' means.
-     */
-
-    end = Tcl_GetCharLength(objv[1]) - 1;
-    if (TclGetIntForIndexM(interp, objv[2], end, &index) != TCL_OK) {
-	return TCL_ERROR;
-    }
-
-    if ((index >= 0) && (index <= end)) {
-	int ch = Tcl_GetUniChar(objv[1], index);
-
-	if (ch == -1) {
+    if (TclObjectHasInterface(objv[1], string, index)) {
+	int status;
+	Tcl_Obj *charPtr;
+	status = TclStringIndexInterface(interp, objv[1], objv[2], &charPtr) ;
+	if (status != TCL_OK) {
+	    return status;
+	} else {
+	    Tcl_SetObjResult(interp, charPtr);
 	    return TCL_OK;
 	}
-
+    } else {
 	/*
-	 * If we have a ByteArray object, we're careful to generate a new
-	 * bytearray for a result.
+	 * Get the char length to calculate what 'end' means.
 	 */
 
-	if (TclIsPureByteArray(objv[1])) {
-	    unsigned char uch = UCHAR(ch);
-
-	    Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(&uch, 1));
-	} else {
-	    char buf[4] = "";
-
-	    end = Tcl_UniCharToUtf(ch, buf);
-#if TCL_UTF_MAX < 4
-	    if ((ch >= 0xD800) && (end < 3)) {
-		end += Tcl_UniCharToUtf(-1, buf + end);
-	    }
-#endif
-	    Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, end));
+	end = Tcl_GetCharLength(objv[1]) - 1;
+	if (TclGetIntForIndexM(interp, objv[2], end, &index) != TCL_OK) {
+	    return TCL_ERROR;
 	}
+
+	if ((index >= 0) && (index <= end)) {
+	    int ch = Tcl_GetUniChar(objv[1], index);
+
+	    if (ch == -1) {
+		return TCL_OK;
+	    }
+
+	    /*
+	     * If we have a ByteArray object, we're careful to generate a new
+	     * bytearray for a result.
+	     */
+
+	    if (TclIsPureByteArray(objv[1])) {
+		unsigned char uch = UCHAR(ch);
+
+		Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(&uch, 1));
+	    } else {
+		char buf[4] = "";
+
+		end = Tcl_UniCharToUtf(ch, buf);
+		Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, end));
+	    }
+	}
+	return TCL_OK;
     }
-    return TCL_OK;
 }
 
 /*
@@ -1612,7 +1620,7 @@ StringIsCmd(
     case STR_IS_BOOL:
     case STR_IS_TRUE:
     case STR_IS_FALSE:
-	if (!TclHasInternalRep(objPtr, &tclBooleanType.objType)
+	if (!TclHasInternalRep(objPtr, tclBooleanType)
 		&& (TCL_OK != TclSetBooleanFromAny(NULL, objPtr))) {
 	    if (strict) {
 		result = 0;
@@ -1681,9 +1689,9 @@ StringIsCmd(
 	chcomp = Tcl_UniCharIsDigit;
 	break;
     case STR_IS_DOUBLE: {
-	if (TclHasInternalRep(objPtr, &tclDoubleType.objType) ||
-		TclHasInternalRep(objPtr, &tclIntType.objType) ||
-		TclHasInternalRep(objPtr, &tclBignumType.objType)) {
+	if (TclHasInternalRep(objPtr, tclDoubleType) ||
+		TclHasInternalRep(objPtr, tclIntType) ||
+		TclHasInternalRep(objPtr, tclBignumType)) {
 	    break;
 	}
 	string1 = Tcl_GetStringFromObj(objPtr, &length1);
@@ -1712,8 +1720,8 @@ StringIsCmd(
 	break;
     case STR_IS_INT:
     case STR_IS_ENTIER:
-	if (TclHasInternalRep(objPtr, &tclIntType.objType) ||
-		TclHasInternalRep(objPtr, &tclBignumType.objType)) {
+	if (TclHasInternalRep(objPtr, tclIntType) ||
+		TclHasInternalRep(objPtr, tclBignumType)) {
 	    break;
 	}
 	string1 = Tcl_GetStringFromObj(objPtr, &length1);
@@ -1896,7 +1904,7 @@ StringIsCmd(
 	for (; string1 < end; string1 += length2, failat++) {
 	    int ucs4;
 
-	    length2 = TclUtfToUCS4(string1, &ucs4);
+	    length2 = Tcl_UtfToUniChar(string1, &ucs4);
 	    if (!chcomp(ucs4)) {
 		result = 0;
 		break;
@@ -2524,7 +2532,7 @@ StringStartCmd(
     if (index > 0) {
 	p = &string[index];
 
-	(void)TclUniCharToUCS4(p, &ch);
+	ch = *p;
 	for (cur = index; cur != TCL_INDEX_NONE; cur--) {
 	    int delta = 0;
 	    const Tcl_UniChar *next;
@@ -2533,10 +2541,11 @@ StringStartCmd(
 		break;
 	    }
 
-	    next = TclUCS4Prev(p, string);
+		next = p > string ? p - 1 : p;
 	    do {
 		next += delta;
-		delta = TclUniCharToUCS4(next, &ch);
+		delta = 1;
+		ch = *next;
 	    } while (next + delta < p);
 	    p = next;
 	}
@@ -2594,7 +2603,7 @@ StringEndCmd(
 	p = &string[index];
 	end = string+length;
 	for (cur = index; p < end; cur++) {
-	    p += TclUniCharToUCS4(p, &ch);
+	    ch = *p++;
 	    if (!Tcl_UniCharIsWordChar(ch)) {
 		break;
 	    }

generic/tclCompCmdsGR.c

@@ -41,7 +41,7 @@ static int		IndexTailVarIfKnown(Tcl_Interp *interp,
  *
  * Side effects:
  *	When TCL_OK is returned, the encoded index value is written
- *	to *index.
+ *	to *indexPtr.
  *
  *----------------------------------------------------------------------
  */
@@ -1411,6 +1411,13 @@ TclCompileLreplaceCmd(
     Tcl_Token *tokenPtr;
     int i;
 
+    /* 
+     * For now, disable compilation of lreplace.  Figure out later if any
+     * compilation can be done given that any Tcl_ObjType may implement
+     * lreplace, and should return an object of the same type. 
+     */
+    return TCL_ERROR;
+
     if (parsePtr->numWords < 4) {
 	return TCL_ERROR;
     }

generic/tclCompExpr.c

@@ -2111,7 +2111,7 @@ ParseLexeme(
 	     * Example: Inf + luence + () becomes a valid function call.
 	     * [Bug 3401704]
 	     */
-	    if (TclHasInternalRep(literal, &tclDoubleType.objType)) {
+	    if (TclHasInternalRep(literal, tclDoubleType)) {
 		const char *p = start;
 
 		while (p < end) {
@@ -2149,13 +2149,13 @@ ParseLexeme(
     if (!TclIsBareword(*start) || *start == '_') {
 	Tcl_Size scanned;
 	if (Tcl_UtfCharComplete(start, numBytes)) {
-	    scanned = TclUtfToUCS4(start, &ch);
+	    scanned = Tcl_UtfToUniChar(start, &ch);
 	} else {
 	    char utfBytes[8];
 
 	    memcpy(utfBytes, start, numBytes);
 	    utfBytes[numBytes] = '\0';
-	    scanned = TclUtfToUCS4(utfBytes, &ch);
+	    scanned = Tcl_UtfToUniChar(utfBytes, &ch);
 	}
 	*lexemePtr = INVALID;
 	Tcl_DecrRefCount(literal);

generic/tclCompile.h

@@ -316,10 +316,8 @@ typedef struct CompileEnv {
 				 * array byte. */
     int mallocedCodeArray;	/* Set 1 if code array was expanded and
 				 * codeStart points into the heap.*/
-#if TCL_MAJOR_VERSION > 8
     int mallocedExceptArray;	/* 1 if ExceptionRange array was expanded and
 				 * exceptArrayPtr points in heap, else 0. */
-#endif
     LiteralEntry *literalArrayPtr;
     				/* Points to start of LiteralEntry array. */
     Tcl_Size literalArrayNext;	/* Index of next free object array entry. */
@@ -335,9 +333,6 @@ typedef struct CompileEnv {
 				 * current range's array entry. */
     Tcl_Size exceptArrayEnd;		/* Index after the last ExceptionRange array
 				 * entry. */
-#if TCL_MAJOR_VERSION < 9
-    int mallocedExceptArray;
-#endif
     ExceptionAux *exceptAuxArrayPtr;
 				/* Array of information used to restore the
 				 * state when processing BREAK/CONTINUE
@@ -350,19 +345,14 @@ typedef struct CompileEnv {
     Tcl_Size cmdMapEnd;		/* Index after last CmdLocation entry. */
     int mallocedCmdMap;		/* 1 if command map array was expanded and
 				 * cmdMapPtr points in the heap, else 0. */
-#if TCL_MAJOR_VERSION > 8
     int mallocedAuxDataArray;	/* 1 if aux data array was expanded and
 				 * auxDataArrayPtr points in heap else 0. */
-#endif
     AuxData *auxDataArrayPtr;	/* Points to auxiliary data array start. */
     Tcl_Size auxDataArrayNext;	/* Next free compile aux data array index.
 				 * auxDataArrayNext is the number of aux data
 				 * items and (auxDataArrayNext-1) is index of
 				 * current aux data array entry. */
     Tcl_Size auxDataArrayEnd;	/* Index after last aux data array entry. */
-#if TCL_MAJOR_VERSION < 9
-    int mallocedAuxDataArray;
-#endif
     unsigned char staticCodeSpace[COMPILEENV_INIT_CODE_BYTES];
 				/* Initial storage for code. */
     LiteralEntry staticLiteralSpace[COMPILEENV_INIT_NUM_OBJECTS];
@@ -1064,7 +1054,6 @@ typedef struct {
  *----------------------------------------------------------------
  */
 
-#if TCL_MAJOR_VERSION > 8
 MODULE_SCOPE Tcl_ObjCmdProc	TclNRInterpCoroutine;
 
 /*
@@ -1203,7 +1192,6 @@ MODULE_SCOPE Tcl_Obj	*TclNewInstNameObj(unsigned char inst);
 MODULE_SCOPE int	TclPushProcCallFrame(void *clientData,
 			    Tcl_Interp *interp, Tcl_Size objc,
 			    Tcl_Obj *const objv[], int isLambda);
-#endif /* TCL_MAJOR_VERSION > 8 */
 
 
 /*

generic/tclDecls.h

@@ -27,10 +27,8 @@
 
 #if !defined(BUILD_tcl)
 # define TCL_DEPRECATED(msg) EXTERN TCL_DEPRECATED_API(msg)
-#elif defined(TCL_NO_DEPRECATED)
-# define TCL_DEPRECATED(msg) MODULE_SCOPE
 #else
-# define TCL_DEPRECATED(msg) EXTERN
+# define TCL_DEPRECATED(msg) MODULE_SCOPE
 #endif
 
 
@@ -4027,77 +4025,29 @@ extern const TclStubs *tclStubsPtr;
 	Tcl_GetStringFromObj(objPtr, (Tcl_Size *)NULL)
 #define Tcl_GetUnicode(objPtr) \
 	Tcl_GetUnicodeFromObj(objPtr, (Tcl_Size *)NULL)
-#if TCL_MAJOR_VERSION < 9 || !defined(TCL_NO_DEPRECATED)
-#   undef Tcl_GetBytesFromObj
-#   undef Tcl_GetStringFromObj
-#   undef Tcl_GetUnicodeFromObj
-#endif
 #undef Tcl_GetIndexFromObjStruct
 #undef Tcl_GetBooleanFromObj
 #undef Tcl_GetBoolean
 #undef TclGetByteArrayFromObj
 #undef Tcl_GetByteArrayFromObj
 #if defined(USE_TCL_STUBS)
-#   if TCL_MAJOR_VERSION < 9 || !defined(TCL_NO_DEPRECATED)
-#	define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) \
-		(sizeof(*(sizePtr)) <= sizeof(int) ? \
-			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, (sizePtr)) : \
-			tclStubsPtr->tcl_GetStringFromObj(objPtr, (Tcl_Size *)(void *)(sizePtr)))
-#	define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \
-		(sizeof(*(sizePtr)) <= sizeof(int) ? \
-			tclStubsPtr->tclGetUnicodeFromObj(objPtr, (sizePtr)) : \
-			tclStubsPtr->tcl_GetUnicodeFromObj(objPtr, (Tcl_Size *)(void *)(sizePtr)))
-#   endif
-#define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \
-	(tclStubsPtr->tcl_GetIndexFromObjStruct((interp), (objPtr), (tablePtr), (offset), (msg), \
+#define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg,\
+	flags, indexPtr) \
+	(tclStubsPtr->tcl_GetIndexFromObjStruct(\
+	    (interp), (objPtr), (tablePtr), (offset), (msg), \
 		(flags)|(int)(sizeof(*(indexPtr))<<1), (indexPtr)))
 #define Tcl_GetBooleanFromObj(interp, objPtr, boolPtr) \
-	((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? tclStubsPtr->tcl_GetBooleanFromObj(interp, objPtr, (int *)(boolPtr)) : \
-	Tcl_GetBoolFromObj(interp, objPtr, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr)))
+	(Tcl_GetBoolFromObj(interp, objPtr,\
+	     (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr)))
 #define Tcl_GetBoolean(interp, src, boolPtr) \
-	((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? tclStubsPtr->tcl_GetBoolean(interp, src, (int *)(boolPtr)) : \
-	Tcl_GetBool(interp, src, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr)))
-#if TCL_MAJOR_VERSION > 8
+	(Tcl_GetBool(interp, src, (TCL_NULL_OK-2)&(int)sizeof(\
+	    (*(boolPtr))), (char *)(boolPtr)))
 #define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \
-	(sizeof(*(sizePtr)) <= sizeof(int) ? \
-		tclStubsPtr->tclGetBytesFromObj(NULL, objPtr, (sizePtr)) : \
-		tclStubsPtr->tcl_GetBytesFromObj(NULL, objPtr, (Tcl_Size *)(void *)(sizePtr)))
+	(tclStubsPtr->tcl_GetBytesFromObj(\
+	    NULL, objPtr, (Tcl_Size *)(void *)(sizePtr)))
 #else
 #define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \
-	(sizeof(*(sizePtr)) <= sizeof(int) ? \
-		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, (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), \
-		(flags)|(int)(sizeof(*(indexPtr))<<1), (indexPtr)))
-#define Tcl_GetBooleanFromObj(interp, objPtr, boolPtr) \
-	((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? Tcl_GetBooleanFromObj(interp, objPtr, (int *)(boolPtr)) : \
-	Tcl_GetBoolFromObj(interp, objPtr, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr)))
-#define Tcl_GetBoolean(interp, src, boolPtr) \
-	((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? Tcl_GetBoolean(interp, src, (int *)(boolPtr)) : \
-	Tcl_GetBool(interp, src, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr)))
-#define Tcl_GetStringFromObj(objPtr, sizePtr) \
-	(sizeof(*(sizePtr)) <= sizeof(int) ? \
-		TclGetStringFromObj(objPtr, (sizePtr)) : \
-		(Tcl_GetStringFromObj)(objPtr, (Tcl_Size *)(void *)(sizePtr)))
-#define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \
-	(sizeof(*(sizePtr)) <= sizeof(int) ? \
-		TclGetBytesFromObj(NULL, objPtr, (sizePtr)) : \
-		(Tcl_GetBytesFromObj)(NULL, objPtr, (Tcl_Size *)(void *)(sizePtr)))
-#define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \
-	(sizeof(*(sizePtr)) <= sizeof(int) ? \
-		TclGetUnicodeFromObj(objPtr, (sizePtr)) : \
-		(Tcl_GetUnicodeFromObj)(objPtr, (Tcl_Size *)(void *)(sizePtr)))
+	(Tcl_GetBytesFromObj)(NULL, objPtr, (Tcl_Size *)(void *)(sizePtr))
 #endif
 
 #ifdef TCL_MEM_DEBUG
@@ -4126,36 +4076,6 @@ extern const TclStubs *tclStubsPtr;
 #define Tcl_BackgroundError(interp)	Tcl_BackgroundException((interp), TCL_ERROR)
 #define Tcl_StringMatch(str, pattern) Tcl_StringCaseMatch((str), (pattern), 0)
 
-#if TCL_UTF_MAX < 4
-#   undef Tcl_UniCharToUtfDString
-#   define Tcl_UniCharToUtfDString Tcl_Char16ToUtfDString
-#   undef Tcl_UtfToUniCharDString
-#   define Tcl_UtfToUniCharDString Tcl_UtfToChar16DString
-#   undef Tcl_UtfToUniChar
-#   define Tcl_UtfToUniChar Tcl_UtfToChar16
-#   undef Tcl_UniCharLen
-#   define Tcl_UniCharLen Tcl_Char16Len
-#   undef Tcl_UniCharToUtf
-#   if defined(USE_TCL_STUBS)
-#	define Tcl_UniCharToUtf(c, p) \
-		(tclStubsPtr->tcl_UniCharToUtf((c)|TCL_COMBINE, (p)))
-#   else
-#	define Tcl_UniCharToUtf(c, p) \
-		((Tcl_UniCharToUtf)((c)|TCL_COMBINE, (p)))
-#   endif
-#if !defined(BUILD_tcl)
-#   undef Tcl_NumUtfChars
-#   define Tcl_NumUtfChars TclNumUtfChars
-#   undef Tcl_GetCharLength
-#   define Tcl_GetCharLength TclGetCharLength
-#   undef Tcl_UtfAtIndex
-#   define Tcl_UtfAtIndex TclUtfAtIndex
-#   undef Tcl_GetRange
-#   define Tcl_GetRange TclGetRange
-#   undef Tcl_GetUniChar
-#   define Tcl_GetUniChar TclGetUniChar
-#endif
-#endif
 #if defined(USE_TCL_STUBS)
 #   define Tcl_WCharToUtfDString (sizeof(wchar_t) != sizeof(short) \
 		? (char *(*)(const wchar_t *, Tcl_Size, Tcl_DString *))tclStubsPtr->tcl_UniCharToUtfDString \
@@ -4169,36 +4089,6 @@ 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), (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), (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), (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), (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), (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), (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), (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 \
@@ -4212,29 +4102,6 @@ extern const TclStubs *tclStubsPtr;
 #   define Tcl_WCharLen (sizeof(wchar_t) != sizeof(short) \
 		? (Tcl_Size (*)(wchar_t *))Tcl_UniCharLen \
 		: (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), (objcPtr), (objvPtr)) \
-		: (Tcl_ListObjGetElements)((interp), (listPtr), (Tcl_Size *)(void *)(objcPtr), (objvPtr)))
-#   define Tcl_ListObjLength(interp, listPtr, lengthPtr) (sizeof(*(lengthPtr)) == sizeof(int) \
-		? 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), (sizePtr)) \
-		: (Tcl_DictObjSize)((interp), (dictPtr), (Tcl_Size *)(void *)(sizePtr)))
-#   define Tcl_SplitList(interp, listStr, argcPtr, argvPtr) (sizeof(*(argcPtr)) == sizeof(int) \
-		? 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), (argcPtr), (argvPtr)) \
-		: (Tcl_SplitPath)((path), (Tcl_Size *)(void *)(argcPtr), (argvPtr)))
-#   define Tcl_FSSplitPath(pathPtr, lenPtr) (sizeof(*(lenPtr)) == sizeof(int) \
-		? 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), (objcPtr), (objv), (remObjv)) \
-		: (Tcl_ParseArgsObjv)((interp), (argTable), (Tcl_Size *)(void *)(objcPtr), (objv), (remObjv)))
-#endif /* !defined(BUILD_tcl) */
 #endif
 
 /*
@@ -4246,24 +4113,11 @@ extern const TclStubs *tclStubsPtr;
 #define Tcl_GlobalEvalObj(interp, objPtr) \
     Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL)
 
-#if TCL_MAJOR_VERSION > 8
-#   undef Tcl_Close
-#   define Tcl_Close(interp, chan) Tcl_CloseEx(interp, chan, 0)
-#endif
+# undef Tcl_Close
+# define Tcl_Close(interp, chan) Tcl_CloseEx(interp, chan, 0)
 
 #undef TclUtfCharComplete
 #undef TclUtfNext
 #undef TclUtfPrev
-#ifndef TCL_NO_DEPRECATED
-#   define Tcl_CreateSlave Tcl_CreateChild
-#   define Tcl_GetSlave Tcl_GetChild
-#   define Tcl_GetMaster Tcl_GetParent
-#endif
-
-/* TIP #660 for 8.7 */
-#if TCL_MAJOR_VERSION < 9
-#   undef Tcl_GetSizeIntFromObj
-#   define Tcl_GetSizeIntFromObj Tcl_GetIntFromObj
-#endif
 
 #endif /* _TCLDECLS */

generic/tclDictObj.c

@@ -150,7 +150,7 @@ const Tcl_ObjType tclDictType = {
     TCL_OBJTYPE_V0
 };
 
-#define DictSetInternalRep(objPtr, dictRepPtr)				\
+#define DictSetIntRep(objPtr, dictRepPtr)				\
     do {                                                                \
         Tcl_ObjInternalRep ir;                                               \
         ir.twoPtrValue.ptr1 = (dictRepPtr);                             \
@@ -396,7 +396,7 @@ DupDictInternalRep(
      * Store in the object.
      */
 
-    DictSetInternalRep(copyPtr, newDict);
+    DictSetIntRep(copyPtr, newDict);
 }
 
 /*
@@ -603,7 +603,7 @@ SetDictFromAny(
      * the conversion from lists to dictionaries.
      */
 
-    if (TclHasInternalRep(objPtr, &tclListType.objType)) {
+    if (TclHasInternalRep(objPtr, tclListType)) {
 	Tcl_Size objc, i;
 	Tcl_Obj **objv;
 
@@ -711,7 +711,7 @@ SetDictFromAny(
     dict->epoch = 1;
     dict->chain = NULL;
     dict->refCount = 1;
-    DictSetInternalRep(objPtr, dict);
+    DictSetIntRep(objPtr, dict);
     return TCL_OK;
 
   missingValue:
@@ -890,7 +890,7 @@ InvalidateDictChain(
 	dict->refCount++;
 	TclInvalidateStringRep(dictObj);
 	TclFreeInternalRep(dictObj);
-	DictSetInternalRep(dictObj, dict);
+	DictSetIntRep(dictObj, dict);
 
 	dict->epoch++;
 	dictObj = dict->chain;
@@ -945,7 +945,7 @@ Tcl_DictObjPut(
     hPtr = CreateChainEntry(dict, keyPtr, &isNew);
     dict->refCount++;
     TclFreeInternalRep(dictPtr)
-    DictSetInternalRep(dictPtr, dict);
+    DictSetIntRep(dictPtr, dict);
     Tcl_IncrRefCount(valuePtr);
     if (!isNew) {
 	Tcl_Obj *oldValuePtr = (Tcl_Obj *)Tcl_GetHashValue(hPtr);
@@ -1426,7 +1426,7 @@ Tcl_NewDictObj(void)
     dict->epoch = 1;
     dict->chain = NULL;
     dict->refCount = 1;
-    DictSetInternalRep(dictPtr, dict);
+    DictSetIntRep(dictPtr, dict);
     return dictPtr;
 #endif
 }
@@ -1474,7 +1474,7 @@ Tcl_DbNewDictObj(
     dict->epoch = 1;
     dict->chain = NULL;
     dict->refCount = 1;
-    DictSetInternalRep(dictPtr, dict);
+    DictSetIntRep(dictPtr, dict);
     return dictPtr;
 }
 #else /* !TCL_MEM_DEBUG */
@@ -1509,7 +1509,7 @@ Tcl_DbNewDictObj(
 
 static int
 DictCreateCmd(
-    TCL_UNUSED(void *),
+    TCL_UNUSED(ClientData),
     Tcl_Interp *interp,
     int objc,
     Tcl_Obj *const *objv)
@@ -1559,7 +1559,7 @@ DictCreateCmd(
 
 static int
 DictGetCmd(
-    TCL_UNUSED(void *),
+    TCL_UNUSED(ClientData),
     Tcl_Interp *interp,
     int objc,
     Tcl_Obj *const *objv)
@@ -1652,7 +1652,7 @@ DictGetCmd(
 
 static int
 DictGetDefCmd(
-    TCL_UNUSED(void *),
+    TCL_UNUSED(ClientData),
     Tcl_Interp *interp,
     int objc,
     Tcl_Obj *const *objv)
@@ -1717,7 +1717,7 @@ DictGetDefCmd(
 
 static int
 DictReplaceCmd(
-    TCL_UNUSED(void *),
+    TCL_UNUSED(ClientData),
     Tcl_Interp *interp,
     int objc,
     Tcl_Obj *const *objv)
@@ -1765,7 +1765,7 @@ DictReplaceCmd(
 
 static int
 DictRemoveCmd(
-    TCL_UNUSED(void *),
+    TCL_UNUSED(ClientData),
     Tcl_Interp *interp,
     int objc,
     Tcl_Obj *const *objv)
@@ -1813,7 +1813,7 @@ DictRemoveCmd(
 
 static int
 DictMergeCmd(
-    TCL_UNUSED(void *),
+    TCL_UNUSED(ClientData),
     Tcl_Interp *interp,
     int objc,
     Tcl_Obj *const *objv)
@@ -1900,7 +1900,7 @@ DictMergeCmd(
 
 static int
 DictKeysCmd(
-    TCL_UNUSED(void *),
+    TCL_UNUSED(ClientData),
     Tcl_Interp *interp,
     int objc,
     Tcl_Obj *const *objv)
@@ -1979,7 +1979,7 @@ DictKeysCmd(
 
 static int
 DictValuesCmd(
-    TCL_UNUSED(void *),
+    TCL_UNUSED(ClientData),
     Tcl_Interp *interp,
     int objc,
     Tcl_Obj *const *objv)
@@ -2039,7 +2039,7 @@ DictValuesCmd(
 
 static int
 DictSizeCmd(
-    TCL_UNUSED(void *),
+    TCL_UNUSED(ClientData),
     Tcl_Interp *interp,
     int objc,
     Tcl_Obj *const *objv)
@@ -2078,7 +2078,7 @@ DictSizeCmd(
 
 static int
 DictExistsCmd(
-    TCL_UNUSED(void *),
+    TCL_UNUSED(ClientData),
     Tcl_Interp *interp,
     int objc,
     Tcl_Obj *const *objv)
@@ -2120,7 +2120,7 @@ DictExistsCmd(
 
 static int
 DictInfoCmd(
-    TCL_UNUSED(void *),
+    TCL_UNUSED(ClientData),
     Tcl_Interp *interp,
     int objc,
     Tcl_Obj *const *objv)
@@ -2164,7 +2164,7 @@ DictInfoCmd(
 
 static int
 DictIncrCmd(
-    TCL_UNUSED(void *),
+    TCL_UNUSED(ClientData),
     Tcl_Interp *interp,
     int objc,
     Tcl_Obj *const *objv)
@@ -2285,7 +2285,7 @@ DictIncrCmd(
 
 static int
 DictLappendCmd(
-    TCL_UNUSED(void *),
+    TCL_UNUSED(ClientData),
     Tcl_Interp *interp,
     int objc,
     Tcl_Obj *const *objv)
@@ -2372,7 +2372,7 @@ DictLappendCmd(
 
 static int
 DictAppendCmd(
-    TCL_UNUSED(void *),
+    TCL_UNUSED(ClientData),
     Tcl_Interp *interp,
     int objc,
     Tcl_Obj *const *objv)
@@ -2474,7 +2474,7 @@ DictAppendCmd(
 
 static int
 DictForNRCmd(
-    TCL_UNUSED(void *),
+    TCL_UNUSED(ClientData),
     Tcl_Interp *interp,
     int objc,
     Tcl_Obj *const *objv)
@@ -2670,7 +2670,7 @@ DictForLoopCallback(
 
 static int
 DictMapNRCmd(
-    TCL_UNUSED(void *),
+    TCL_UNUSED(ClientData),
     Tcl_Interp *interp,
     int objc,
     Tcl_Obj *const *objv)
@@ -2883,7 +2883,7 @@ DictMapLoopCallback(
 
 static int
 DictSetCmd(
-    TCL_UNUSED(void *),
+    TCL_UNUSED(ClientData),
     Tcl_Interp *interp,
     int objc,
     Tcl_Obj *const *objv)
@@ -2943,7 +2943,7 @@ DictSetCmd(
 
 static int
 DictUnsetCmd(
-    TCL_UNUSED(void *),
+    TCL_UNUSED(ClientData),
     Tcl_Interp *interp,
     int objc,
     Tcl_Obj *const *objv)
@@ -3002,7 +3002,7 @@ DictUnsetCmd(
 
 static int
 DictFilterCmd(
-    TCL_UNUSED(void *),
+    TCL_UNUSED(ClientData),
     Tcl_Interp *interp,
     int objc,
     Tcl_Obj *const *objv)
@@ -3288,7 +3288,7 @@ DictFilterCmd(
 
 static int
 DictUpdateCmd(
-    TCL_UNUSED(void *),
+    TCL_UNUSED(ClientData),
     Tcl_Interp *interp,
     int objc,
     Tcl_Obj *const *objv)
@@ -3447,7 +3447,7 @@ FinalizeDictUpdate(
 
 static int
 DictWithCmd(
-    TCL_UNUSED(void *),
+    TCL_UNUSED(ClientData),
     Tcl_Interp *interp,
     int objc,
     Tcl_Obj *const *objv)

generic/tclDisassemble.c

@@ -875,7 +875,7 @@ PrintSourceToObj(
     for (;  (*p != '\0') && (i < maxChars);  p+=len) {
 	int ucs4;
 
-	len = TclUtfToUCS4(p, &ucs4);
+	len = Tcl_UtfToUniChar(p, &ucs4);
 	switch (ucs4) {
 	case '"':
 	    Tcl_AppendToObj(appendObj, "\\\"", -1);

generic/tclEncoding.c

@@ -655,11 +655,6 @@ TclInitEncodingSubsystem(void)
     type.clientData	= INT2PTR(leFlags);
     Tcl_CreateEncoding(&type);
 
-#ifndef TCL_NO_DEPRECATED
-    type.encodingName   = "unicode";
-    Tcl_CreateEncoding(&type);
-#endif
-
     /*
      * Need the iso8859-1 encoding in order to process binary data, so force
      * it to always be embedded. Note that this encoding *must* be a proper
@@ -1154,7 +1149,7 @@ Tcl_ExternalToUtfDString(
 				 * converted string is stored. */
 {
     Tcl_ExternalToUtfDStringEx(
-	NULL, encoding, src, srcLen, TCL_ENCODING_PROFILE_TCL8, dstPtr, NULL);
+	NULL, encoding, src, srcLen, TCL_ENCODING_PROFILE_STRICT, dstPtr, NULL);
     return Tcl_DStringValue(dstPtr);
 }
 
@@ -1628,7 +1623,7 @@ Tcl_UtfToExternalDStringEx(
 		    Tcl_Size pos = Tcl_NumUtfChars(srcStart, nBytesProcessed);
 		    int ucs4;
 		    char buf[TCL_INTEGER_SPACE];
-		    TclUtfToUCS4(&srcStart[nBytesProcessed], &ucs4);
+		    Tcl_UtfToUniChar(&srcStart[nBytesProcessed], &ucs4);
 		    snprintf(buf, sizeof(buf), "%" TCL_Z_MODIFIER "u", nBytesProcessed);
 		    Tcl_SetObjResult(
 			interp,
@@ -2531,16 +2526,6 @@ UtfToUtfProc(
     flags |= PTR2INT(clientData);
     dstEnd = dst + dstLen - ((flags & ENCODING_UTF) ? TCL_UTF_MAX : 6);
 
-
-#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++) {
 
@@ -2588,10 +2573,10 @@ UtfToUtfProc(
 	} else if (!Tcl_UtfCharComplete(src, srcEnd - src)) {
 	    /*
 	     * Incomplete byte sequence.
-		 * Always check before using TclUtfToUCS4. Not doing so can cause it
-		 * run beyond the end of the buffer! If we happen on such an incomplete
-		 * char its bytes are made to represent themselves unless the user has
-		 * explicitly asked to be told.
+	     * Always check before using Tcl_UtfToUniChar. Not doing can so cause
+	     * it to run beyond the end of the buffer! If we happen such an
+	     * incomplete char its bytes are made to represent themselves
+	     * unless the user has explicitly asked to be told.
 	     */
 
 	    if (flags & ENCODING_INPUT) {
@@ -2610,12 +2595,12 @@ UtfToUtfProc(
 		/* TCL_ENCODING_PROFILE_TCL8 */
 		char chbuf[2];
 		chbuf[0] = UCHAR(*src++); chbuf[1] = 0;
-		TclUtfToUCS4(chbuf, &ch);
+		Tcl_UtfToUniChar(chbuf, &ch);
 	    }
 	    dst += Tcl_UniCharToUtf(ch, dst);
 	} else {
 	    int isInvalid = 0;
-	    size_t len = TclUtfToUCS4(src, &ch);
+	    size_t len = Tcl_UtfToUniChar(src, &ch);
 	    if (flags & ENCODING_INPUT) {
 		if ((len < 2) && (ch != 0)) {
 		    isInvalid = 1;
@@ -2643,44 +2628,10 @@ UtfToUtfProc(
 		    *dst++ = (char) (((ch >> 10) & 0x3F) | 0x80);
 		    ch = (ch & 0x0CFF) | 0xDC00;
 		}
-#if TCL_UTF_MAX < 4
-	    cesu8:
-#endif
 		*dst++ = (char) (((ch >> 12) | 0xE0) & 0xEF);
 		*dst++ = (char) (((ch >> 6) | 0x80) & 0xBF);
 		*dst++ = (char) ((ch | 0x80) & 0xBF);
 		continue;
-#if TCL_UTF_MAX < 4
-	    } else if (SURROGATE(ch)) {
-		/*
-		 * A surrogate character is detected, handle especially.
-		 */
-		if (PROFILE_STRICT(profile) && (flags & ENCODING_UTF)) {
-		    result = TCL_CONVERT_UNKNOWN;
-		    src = saveSrc;
-		    break;
-		}
-		if (PROFILE_REPLACE(profile)) {
-		    /* TODO - is this right for cesu8 or should we fall through below? */
-		    ch = UNICODE_REPLACE_CHAR;
-		} else {
-		    int low = ch;
-		    len = (src <= srcEnd - 3) ? TclUtfToUCS4(src, &low) : 0;
-
-		    if ((!LOW_SURROGATE(low)) || (ch & 0x400)) {
-
-			if (PROFILE_STRICT(profile)) {
-			    result = TCL_CONVERT_UNKNOWN;
-			    src = saveSrc;
-			    break;
-			}
-			goto cesu8;
-		    }
-		    src += len;
-		    dst += Tcl_UniCharToUtf(ch, dst);
-		    ch = low;
-		}
-#endif
 	    } else if (PROFILE_STRICT(profile) &&
 		       (!(flags & ENCODING_INPUT)) &&
 		       SURROGATE(ch)) {
@@ -2755,15 +2706,6 @@ 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))
      */
@@ -2773,21 +2715,6 @@ Utf32ToUtfProc(
 	srcLen -= bytesLeft;
     }
 
-#if TCL_UTF_MAX < 4
-    /*
-     * If last code point is a high surrogate, we cannot handle that yet,
-     * unless we are at the end.
-     */
-
-    if (!(flags & TCL_ENCODING_END) && (srcLen >= 4) &&
-	    ((src[srcLen - ((flags & TCL_ENCODING_LE)?3:2)] & 0xFC) == 0xD8) &&
-	    ((src[srcLen - ((flags & TCL_ENCODING_LE)?2:3)]) == 0) &&
-	    ((src[srcLen - ((flags & TCL_ENCODING_LE)?1:4)]) == 0)) {
-	result = TCL_CONVERT_MULTIBYTE;
-	srcLen-= 4;
-    }
-#endif
-
     srcStart = src;
     srcEnd = src + srcLen;
 
@@ -2800,20 +2727,11 @@ Utf32ToUtfProc(
 	    break;
 	}
 
-#if TCL_UTF_MAX < 4
-	int prev = ch;
-#endif
 	if (flags & TCL_ENCODING_LE) {
 	    ch = (unsigned int)(src[3] & 0xFF) << 24 | (src[2] & 0xFF) << 16 | (src[1] & 0xFF) << 8 | (src[0] & 0xFF);
 	} else {
 	    ch = (unsigned int)(src[0] & 0xFF) << 24 | (src[1] & 0xFF) << 16 | (src[2] & 0xFF) << 8 | (src[3] & 0xFF);
 	}
-#if TCL_UTF_MAX < 4
-	if (HIGH_SURROGATE(prev) && !LOW_SURROGATE(ch)) {
-	    /* Bug [10c2c17c32]. If Hi surrogate not followed by Lo surrogate, finish 3-byte UTF-8 */
-	    dst += Tcl_UniCharToUtf(-1, dst);
-	}
-#endif
 
 	if ((unsigned)ch > 0x10FFFF) {
 	    ch = UNICODE_REPLACE_CHAR;
@@ -2823,9 +2741,6 @@ Utf32ToUtfProc(
 	    }
 	} else if (PROFILE_STRICT(flags) && SURROGATE(ch)) {
 	    result = TCL_CONVERT_SYNTAX;
-#if TCL_UTF_MAX < 4
-	    ch = 0;
-#endif
 	    break;
 	} else if (PROFILE_REPLACE(flags) && SURROGATE(ch)) {
 	    ch = UNICODE_REPLACE_CHAR;
@@ -2839,11 +2754,6 @@ Utf32ToUtfProc(
 	if ((unsigned)ch - 1 < 0x7F) {
 	    *dst++ = (ch & 0xFF);
 	} else {
-#if TCL_UTF_MAX < 4
-	    if (!HIGH_SURROGATE(prev) && LOW_SURROGATE(ch)) {
-		*dst = 0; /* In case of lower surrogate, don't try to combine */
-	    }
-#endif
 	    dst += Tcl_UniCharToUtf(ch, dst);
 	}
 	src += 4;
@@ -2853,13 +2763,6 @@ Utf32ToUtfProc(
      * If we had a truncated code unit at the end AND this is the last
      * fragment AND profile is not "strict", stick FFFD in its place.
      */
-#if TCL_UTF_MAX < 4
-    if (HIGH_SURROGATE(ch)) {
-	/* Bug [10c2c17c32]. If Hi surrogate, finish 3-byte UTF-8 */
-	dst += Tcl_UniCharToUtf(-1, dst);
-    }
-#endif
-
     if ((flags & TCL_ENCODING_END) && (result == TCL_CONVERT_MULTIBYTE)) {
 	if (dst > dstEnd) {
 	    result = TCL_CONVERT_NOSPACE;
@@ -2952,7 +2855,7 @@ UtfToUtf32Proc(
 	    result = TCL_CONVERT_NOSPACE;
 	    break;
 	}
-	len = TclUtfToUCS4(src, &ch);
+	len = Tcl_UtfToUniChar(src, &ch);
 	if (SURROGATE(ch)) {
 	    if (PROFILE_STRICT(flags)) {
 		result = TCL_CONVERT_UNKNOWN;
@@ -3033,15 +2936,6 @@ 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))
      */
@@ -3240,7 +3134,7 @@ UtfToUtf16Proc(
 	    result = TCL_CONVERT_NOSPACE;
 	    break;
 	}
-	len = TclUtfToUCS4(src, &ch);
+	len = Tcl_UtfToUniChar(src, &ch);
 	if (SURROGATE(ch)) {
 	    if (PROFILE_STRICT(flags)) {
 		result = TCL_CONVERT_UNKNOWN;
@@ -3349,18 +3243,7 @@ UtfToUcs2Proc(
 	    result = TCL_CONVERT_NOSPACE;
 	    break;
 	}
-#if TCL_UTF_MAX < 4
-	len = TclUtfToUniChar(src, &ch);
-	if ((ch >= 0xD800) && (len < 3)) {
-	    if (PROFILE_STRICT(flags)) {
-		result = TCL_CONVERT_UNKNOWN;
-		break;
-	    }
-	    src += len;
-	    src += TclUtfToUniChar(src, &ch);
-	    ch = UNICODE_REPLACE_CHAR;
-	}
-#else
+
 	len = TclUtfToUniChar(src, &ch);
 	if (ch > 0xFFFF) {
 	    if (PROFILE_STRICT(flags)) {
@@ -3369,7 +3252,6 @@ UtfToUcs2Proc(
 	    }
 	    ch = UNICODE_REPLACE_CHAR;
 	}
-#endif
 	if (PROFILE_STRICT(flags) && SURROGATE(ch)) {
 	    result = TCL_CONVERT_SYNTAX;
 	    break;
@@ -3455,15 +3337,6 @@ 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];
@@ -3608,17 +3481,12 @@ TableFromUtfProc(
 	}
 	len = TclUtfToUniChar(src, &ch);
 
-#if TCL_UTF_MAX > 3
 	/* Unicode chars > +U0FFFF cannot be represented in any table encoding */
 	if (ch & 0xFFFF0000) {
 	    word = 0;
-	} else
-#else
-	if (!len) {
-	    word = 0;
-	} else
-#endif
+	} else {
 	    word = fromUnicode[(ch >> 8)][ch & 0xFF];
+	}
 
 	if ((word == 0) && (ch != 0)) {
 	    if (PROFILE_STRICT(flags)) {
@@ -3705,15 +3573,6 @@ 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;
@@ -3815,24 +3674,14 @@ Iso88591FromUtfProc(
 	 * Check for illegal characters.
 	 */
 
-	if (ch > 0xFF
-#if TCL_UTF_MAX < 4
-		|| ((ch >= 0xD800) && (len < 3))
-#endif
-		) {
+	if (ch > 0xFF) {
 	    if (PROFILE_STRICT(flags)) {
 		result = TCL_CONVERT_UNKNOWN;
 		break;
 	    }
-#if TCL_UTF_MAX < 4
-	    if ((ch >= 0xD800) && (len < 3)) {
-		len = 4;
-	    }
-#endif
 	    /*
 	     * Plunge on, using '?' as a fallback character.
 	     */
-
 	    ch = (Tcl_UniChar) '?'; /* Profiles TCL8 and REPLACE */
 	}
 
@@ -3953,15 +3802,6 @@ 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;

generic/tclEnsemble.c

@@ -607,7 +607,7 @@ TclNamespaceEnsembleCmd(
 			cmd = TclGetString(listv[0]);
 			if (!(cmd[0] == ':' && cmd[1] == ':')) {
 			    Tcl_Obj *newList = TclDuplicatePureObj(
-				interp, listObj, &tclListType.objType);
+				interp, listObj, tclListType);
 			    if (!newList) {
 				if (patchedDict) {
 				    Tcl_DecrRefCount(patchedDict);
@@ -624,7 +624,7 @@ TclNamespaceEnsembleCmd(
 				    &newCmd);
 			    if (patchedDict == NULL) {
 				patchedDict = TclDuplicatePureObj(
-				    interp, objv[1], &tclListType.objType);
+				    interp, objv[1], tclListType);
 				if (!patchedDict) {
 				    goto freeMapAndError;
 				}
@@ -1926,7 +1926,7 @@ NsEnsembleImplementationCmdNR(
 
 	if (objc == 2) {
 	    copyPtr = TclDuplicatePureObj(
-		interp, prefixObj, &tclListType.objType);
+		interp, prefixObj, tclListType);
 	    if (!copyPtr) {
 		return TCL_ERROR;
 	    }
@@ -2330,7 +2330,7 @@ EnsembleUnknownCallback(
      */
 
     unknownCmd = TclDuplicatePureObj(
-	interp, ensemblePtr->unknownHandler, &tclListType.objType);
+	interp, ensemblePtr->unknownHandler, tclListType);
     if (!unknownCmd) {
 	return TCL_ERROR;
     }

generic/tclEvent.c

@@ -233,7 +233,7 @@ HandleBgErrors(
 	 */
 
 	Tcl_Obj *copyObj = TclDuplicatePureObj(
-	    interp, assocPtr->cmdPrefix, &tclListType.objType);
+	    interp, assocPtr->cmdPrefix, tclListType);
 	if (!copyObj) {
 	    return;
 	}
@@ -1088,9 +1088,6 @@ static const struct {
 #ifdef USE_NMAKE
 	    ".nmake"
 #endif
-#ifdef TCL_NO_DEPRECATED
-	    ".no-deprecate"
-#endif
 #if !TCL_THREADS
 	    ".no-thread"
 #endif
@@ -1112,9 +1109,6 @@ static const struct {
 #ifdef STATIC_BUILD
 	    ".static"
 #endif
-#if TCL_UTF_MAX < 4
-	    ".utf-16"
-#endif
 }};
 
 const char *

generic/tclExecute.c

@@ -10,6 +10,7 @@
  * Copyright © 2005-2007 Donal K. Fellows.
  * Copyright © 2007 Daniel A. Steffen <das@users.sourceforge.net>
  * Copyright © 2006-2008 Joe Mistachkin.  All rights reserved.
+ * Copyright © 2021 Nathan Coulter.  All rights reserved.
  *
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -19,7 +20,6 @@
 #include "tclCompile.h"
 #include "tclOOInt.h"
 #include "tclTomMath.h"
-#include "tclArithSeries.h"
 #include <math.h>
 #include <assert.h>
 
@@ -451,11 +451,11 @@ VarHashCreateVar(
  */
 
 #define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \
-    ((TclHasInternalRep((objPtr), &tclIntType.objType))					\
+    ((TclHasInternalRep((objPtr), tclIntType))					\
 	?	(*(tPtr) = TCL_NUMBER_INT,				\
 		*(ptrPtr) = (void *)				\
 		    (&((objPtr)->internalRep.wideValue)), TCL_OK) :	\
-    TclHasInternalRep((objPtr), &tclDoubleType.objType)				\
+    TclHasInternalRep((objPtr), tclDoubleType)				\
 	?	(((isnan((objPtr)->internalRep.doubleValue))		\
 		    ?	(*(tPtr) = TCL_NUMBER_NAN)			\
 		    :	(*(tPtr) = TCL_NUMBER_DOUBLE)),			\
@@ -1481,7 +1481,7 @@ CompileExprObj(
  * DupExprCodeInternalRep --
  *
  *	Part of the Tcl object type implementation for Tcl expression
- *	bytecode. We do not copy the bytecode internalrep. Instead, we return
+ *	bytecode. We do not copy the bytecode intrep. Instead, we return
  *	without setting copyPtr->typePtr, so the copy is a plain string copy
  *	of the expression value, and if it is to be used as a compiled
  *	expression, it will just need a recompile.
@@ -1490,7 +1490,7 @@ CompileExprObj(
  *	usual (only?) time Tcl_DuplicateObj() will be called is when the copy
  *	is about to be modified, which would invalidate any copied bytecode
  *	anyway. The only reason it might make sense to copy the bytecode is if
- *	we had some modifying routines that operated directly on the internalrep,
+ *	we had some modifying routines that operated directly on the intrep,
  *	like we do for lists and dicts.
  *
  * Results:
@@ -3375,7 +3375,7 @@ TEBCresume(
 	}
 	if (Tcl_IsShared(objResultPtr)) {
 	    Tcl_Obj *newValue = TclDuplicatePureObj(
-		    interp, objResultPtr, &tclListType.objType);
+		    interp, objResultPtr, tclListType);
 	    if (!newValue) {
 		TRACE_ERROR(interp);
 		goto gotError;
@@ -3439,7 +3439,7 @@ TEBCresume(
 	    } else {
 		if (Tcl_IsShared(objResultPtr)) {
 		    valueToAssign = TclDuplicatePureObj(
-			interp, objResultPtr, &tclListType.objType);
+			interp, objResultPtr, tclListType);
 		    if (!valueToAssign) {
 			goto errorInLappendListPtr;
 		    }
@@ -4638,7 +4638,8 @@ TEBCresume(
      */
 
     {
-	int numIndices, nocase, match, cflags;
+	int dstatus, numIndices, nocase, match, cflags,
+	    toIdxAnchor, fromIdxAnchor;
 	Tcl_Size slength, length2, fromIdx, toIdx, index, s1len, s2len;
 	const char *s1, *s2;
 
@@ -4667,66 +4668,79 @@ TEBCresume(
 	value2Ptr = OBJ_AT_TOS;
 	valuePtr = OBJ_UNDER_TOS;
 	TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
+	if (
+	    TclHasInternalRep(value2Ptr, tclListType)
+	    ||
+	    TclObjectHasInterface(value2Ptr, list, length)
+	) {
+	    Tcl_Size value2Length;
+	    if (Tcl_ListObjLength(interp,value2Ptr,&value2Length),
+		value2Length == 1) {
+		if (TclHasInternalRep(value2Ptr, tclListType)) {
+		    value2Ptr = TclListObjGetElement(value2Ptr, 0);
+		} else {
+		    Tcl_ListObjIndex(interp, value2Ptr, 0, &value2Ptr);
+		}
+	    } else {
+		goto TclLindexList;
+	    }
+	}
 
+	if (TclObjectHasInterface(valuePtr, list, length)
+	    || TclHasInternalRep(valuePtr, tclListType)) {
+	    int code, haveElements = 0, status;
 
-	/* special case for ArithSeries */
-	if (TclHasInternalRep(valuePtr,&tclArithSeriesType.objType)) {
-	    length = ABSTRACTLIST_PROC(valuePtr, lengthProc)(valuePtr);
-	    if (TclGetIntForIndexM(interp, value2Ptr, length-1, &index)!=TCL_OK) {
-		CACHE_STACK_INFO();
+	    if (TclHasInternalRep(valuePtr, tclListType)) {
+		/* since the type is tclListtype, this can't fail */
+		TclListObjGetElementsM(interp, valuePtr, &objc, &objv);
+		haveElements = 1;
+	    } else {
+		TclObjectDispatchNoDefault(interp, status, valuePtr, list,
+		    length, interp, valuePtr, &objc);
+		if (status != TCL_OK) {
+		    CACHE_STACK_INFO();
+		    TRACE_ERROR(interp);
+		    goto gotError;
+		}
+
+		if (objc < 0) {
+		    objc = TCL_SIZE_MAX;
+		}
+	    } 
+
+	    Tcl_IncrRefCount(value2Ptr);
+	    DECACHE_STACK_INFO();
+	    code = TclGetIntForIndexM(interp, value2Ptr, objc-1, &index);
+	    CACHE_STACK_INFO();
+	    if (code != TCL_OK) {
+		goto TclLindexList;
+	    }
+	    Tcl_DecrRefCount(value2Ptr);
+
+	    if (haveElements && code == TCL_OK) {
+		tosPtr--;
+		pcAdjustment = 1;
+		goto lindexFastPath;
+	    }
+
+	    Tcl_ResetResult(interp);
+	    TclObjectDispatchNoDefault(interp, status, valuePtr, list,
+		index, interp, valuePtr, index, &objResultPtr);
+	    if (status != TCL_OK) {
 		TRACE_ERROR(interp);
 		goto gotError;
 	    }
-	    objResultPtr = TclArithSeriesObjIndex(interp, valuePtr, index);
 	    if (objResultPtr == NULL) {
-		CACHE_STACK_INFO();
-		TRACE_ERROR(interp);
-		goto gotError;
+		TclNewObj(objResultPtr);
 	    }
 	    Tcl_IncrRefCount(objResultPtr); // reference held here
 	    goto lindexDone;
-	}
 
+	}
+    TclLindexList:
 	/*
 	 * Extract the desired list element.
 	 */
-
-	{
-	    Tcl_Size value2Length;
-	    Tcl_Obj *indexListPtr = value2Ptr;
-	    if ((TclListObjGetElementsM(interp, valuePtr, &objc, &objv) == TCL_OK)
-		&& (
-		    !TclHasInternalRep(value2Ptr, &tclListType.objType)
-		    ||
-		    ((Tcl_ListObjLength(interp,value2Ptr,&value2Length),
-			value2Length == 1
-			    ? (indexListPtr = TclListObjGetElement(value2Ptr, 0), 1)
-			    : 0
-		    ))
-		)
-	    ) {
-		int code;
-
-		/* increment the refCount of value2Ptr because TclListObjGetElement may
-		 * have just extracted it from a list in the condition for this block.
-		 */
-		Tcl_IncrRefCount(indexListPtr);
-
-		DECACHE_STACK_INFO();
-		code = TclGetIntForIndexM(interp, indexListPtr, objc-1, &index);
-		TclDecrRefCount(indexListPtr);
-		CACHE_STACK_INFO();
-		if (code == TCL_OK) {
-		    Tcl_DecrRefCount(value2Ptr);
-		    tosPtr--;
-		    pcAdjustment = 1;
-		    goto lindexFastPath;
-		}
-		Tcl_ResetResult(interp);
-	    }
-	}
-
-	DECACHE_STACK_INFO();
 	objResultPtr = TclLindexList(interp, valuePtr, value2Ptr);
 	CACHE_STACK_INFO();
 
@@ -4754,9 +4768,10 @@ TEBCresume(
 	opnd = TclGetInt4AtPtr(pc+1);
 	TRACE(("\"%.30s\" %d => ", O2S(valuePtr), opnd));
 
-	/* special case for ArithSeries */
-	if (TclHasInternalRep(valuePtr,&tclArithSeriesType.objType)) {
-	    length = ABSTRACTLIST_PROC(valuePtr, lengthProc)(valuePtr);
+	if (TclObjectHasInterface(valuePtr, list, length)) {
+	    TCL_UNUSEDVAR(int status);
+	    TclObjectDispatchNoDefault(interp, status, valuePtr, list,
+		length, interp, valuePtr, &length);
 
 	    /* Decode end-offset index values. */
 
@@ -4764,7 +4779,8 @@ TEBCresume(
 
 	    /* Compute value @ index */
 	    if (index >= 0 && index < length) {
-		objResultPtr = TclArithSeriesObjIndex(interp, valuePtr, index);
+		TclObjectDispatchNoDefault(interp, status, valuePtr, list,
+		    index, interp, valuePtr, index, &objResultPtr);
 		if (objResultPtr == NULL) {
 		    CACHE_STACK_INFO();
 		    TRACE_ERROR(interp);
@@ -4782,15 +4798,52 @@ TEBCresume(
 	 * in the process.
 	 */
 
-	if (TclListObjGetElementsM(interp, valuePtr, &objc, &objv) != TCL_OK) {
-	    TRACE_ERROR(interp);
-	    goto gotError;
+	if (!TclHasInternalRep(valuePtr, tclListType)
+	    && TclObjectHasInterface(valuePtr, list, index)) {
+	    if (Tcl_ListObjLength(interp, valuePtr, &objc) != TCL_OK) {
+		TRACE_ERROR(interp);
+		goto gotError;
+	    }
+
+	    if (TclIndexIsFromEnd(opnd) && !Tcl_LengthIsFinite(objc)) {
+		/* end-relative index, and list end is indeterminate */
+		if (TclObjectDispatchNoDefault(interp, dstatus, valuePtr, list, indexEnd,
+		    interp, valuePtr, index, &objResultPtr) != TCL_OK
+		    || dstatus != TCL_OK) {
+		    TRACE_ERROR(interp);
+		    goto gotError;
+		}
+	    } else {
+		index = TclIndexDecode(opnd, TclIndexLast(objc));
+		if (Tcl_ListObjIndex(interp, valuePtr, index, &objResultPtr)
+		    != TCL_OK) {
+		    TRACE_ERROR(interp);
+		    goto gotError;
+		}
+	    }
+	    if (objResultPtr == NULL) {
+		TclNewObj(objResultPtr);
+	    }
+	    Tcl_IncrRefCount(objResultPtr);
+
+	    /*
+	     * Stash the list element on the stack.
+	     */
+
+	    TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
+	    /* Already has the correct refCount */
+	    NEXT_INST_F(5, 1, -1);
+	} else {
+	    if (TclListObjGetElementsM(interp, valuePtr, &objc, &objv) != TCL_OK) {
+		TRACE_ERROR(interp);
+		goto gotError;
+	    }
+	    /* Decode end-offset index values. */
+
+	    index = TclIndexDecode(opnd, TclIndexLast(objc));
+	    pcAdjustment = 5;
 	}
 
-	/* Decode end-offset index values. */
-
-	index = TclIndexDecode(opnd, objc - 1);
-	pcAdjustment = 5;
 
     lindexFastPath:
 	if (index >= 0 && index < objc) {
@@ -4957,34 +5010,43 @@ TEBCresume(
 	    TRACE_APPEND(("\"%.30s\"", O2S(objResultPtr)));
 	    NEXT_INST_F(9, 1, 1);
 	}
-	toIdx = TclIndexDecode(toIdx, objc - 1);
-	if (toIdx == TCL_INDEX_NONE) {
-	    goto emptyList;
-	} else if (toIdx >= objc) {
-	    toIdx = objc - 1;
-	}
 
-	assert (toIdx >= 0 && toIdx < objc);
-	/*
-	assert ( fromIdx != TCL_INDEX_NONE );
-	 *
-	 * Extra safety for legacy bytecodes:
-	 */
-	if (fromIdx == TCL_INDEX_NONE) {
-	    fromIdx = TCL_INDEX_START;
-	}
+	toIdxAnchor = TclIndexIsFromEnd(toIdx);
+	fromIdxAnchor = TclIndexIsFromEnd(fromIdx);
 
-	fromIdx = TclIndexDecode(fromIdx, objc - 1);
+	if (!Tcl_LengthIsFinite(objc)
+	    && (toIdxAnchor == 1 || fromIdxAnchor == 1)) {
 
-	if (TclHasInternalRep(valuePtr,&tclArithSeriesType.objType)) {
-	    objResultPtr = TclArithSeriesObjRange(interp, valuePtr, fromIdx, toIdx);
+	    toIdx = TclIndexDecode(toIdx, SIZE_MAX);
+	    fromIdx = TclIndexDecode(fromIdx, SIZE_MAX);
+	    dstatus = TclObjectDispatchNoDefault(interp, objResultPtr,
+		valuePtr, list, rangeEnd, interp, valuePtr, toIdxAnchor,
+		toIdx, fromIdxAnchor, fromIdx);
+	    if (dstatus != TCL_OK || objResultPtr == NULL) {
+		goto gotError;
+	    }
 	} else {
+	    toIdx = TclIndexDecode(toIdx, TclIndexLast(objc));
+	    if (toIdx == TCL_INDEX_NONE) {
+		goto emptyList;
+	    } else if (Tcl_LengthIsFinite(objc) && toIdx + 1 >= objc + 1) {
+		toIdx = TclIndexLast(objc);
+	    }
+
+	    assert (toIdx < objc);
+	    /*
+	    assert ( fromIdx != TCL_INDEX_NONE );
+	     *
+	     * Extra safety for legacy bytecodes:
+	     */
+	    if (fromIdx == TCL_INDEX_NONE) {
+		fromIdx = TCL_INDEX_START;
+	    }
+
+	    fromIdx = TclIndexDecode(fromIdx, objc - 1);
+
 	    objResultPtr = TclListObjRange(interp, valuePtr, fromIdx, toIdx);
 	}
-	if (objResultPtr == NULL) {
-	    TRACE_ERROR(interp);
-	    goto gotError;
-	}
 
 	TRACE_APPEND(("\"%.30s\"", O2S(objResultPtr)));
 	NEXT_INST_F(9, 1, 1);
@@ -5004,14 +5066,19 @@ TEBCresume(
 	if (length > 0) {
 	    Tcl_Size i = 0;
 	    Tcl_Obj *o;
-	    int isArithSeries = TclHasInternalRep(value2Ptr,&tclArithSeriesType.objType);
 	    /*
 	     * An empty list doesn't match anything.
 	     */
 
 	    do {
-		if (isArithSeries) {
-		    o = TclArithSeriesObjIndex(NULL, value2Ptr, i);
+		if (TclObjectHasInterface(valuePtr, list, index)) {
+		    TCL_UNUSEDVAR(int status);
+		    TclObjectDispatchNoDefault(interp, status, value2Ptr, list,
+			index, interp, value2Ptr, i, &o);
+		    if (!o) {
+			TRACE_ERROR(interp);
+			goto gotError;
+		    }
 		} else {
 		    Tcl_ListObjIndex(NULL, value2Ptr, i, &o);
 		}
@@ -5024,9 +5091,7 @@ TEBCresume(
 		if (s1len == s2len) {
 		    match = (memcmp(s1, s2, s1len) == 0);
 		}
-		if (isArithSeries) {
-		    TclDecrRefCount(o);
-		}
+		TclBounceRefCount(o);
 		i++;
 	    } while (i < length && match == 0);
 	}
@@ -5293,44 +5358,46 @@ TEBCresume(
 	 */
 
 	slength = Tcl_GetCharLength(valuePtr);
-	DECACHE_STACK_INFO();
-	if (TclGetIntForIndexM(interp, value2Ptr, slength-1, &index)!=TCL_OK) {
-	    CACHE_STACK_INFO();
-	    TRACE_ERROR(interp);
-	    goto gotError;
-	}
-	CACHE_STACK_INFO();
-
-	if (index < 0 || index >= slength) {
-	    TclNewObj(objResultPtr);
-	} else if (TclIsPureByteArray(valuePtr)) {
-	    objResultPtr = Tcl_NewByteArrayObj(
-		    Tcl_GetByteArrayFromObj(valuePtr, (Tcl_Size *)NULL)+index, 1);
-	} else if (valuePtr->bytes && slength == valuePtr->length) {
-	    objResultPtr = Tcl_NewStringObj((const char *)
-		    valuePtr->bytes+index, 1);
+	if (TclObjectHasInterface(valuePtr, string, index)) {
+	    int status;
+	    status = TclStringIndexInterface(interp, valuePtr, value2Ptr, &objResultPtr);
+	    if (status != TCL_OK) {
+		goto gotError;
+	    }
 	} else {
-	    char buf[4] = "";
-	    int ch = Tcl_GetUniChar(valuePtr, index);
+	    DECACHE_STACK_INFO();
+	    if (TclGetIntForIndexM(interp, value2Ptr, slength-1, &index)!=TCL_OK) {
+		CACHE_STACK_INFO();
+		TRACE_ERROR(interp);
+		goto gotError;
+	    }
+	    CACHE_STACK_INFO();
 
-	    /*
-	     * This could be: Tcl_NewUnicodeObj((const Tcl_UniChar *)&ch, 1)
-	     * but creating the object as a string seems to be faster in
-	     * practical use.
-	     */
-	    if (ch == -1) {
+	    if (index < 0 || index >= slength) {
 		TclNewObj(objResultPtr);
+	    } else if (TclIsPureByteArray(valuePtr)) {
+		objResultPtr = Tcl_NewByteArrayObj(
+			Tcl_GetByteArrayFromObj(valuePtr, NULL)+index, 1);
+	    } else if (valuePtr->bytes && slength == valuePtr->length) {
+		objResultPtr = Tcl_NewStringObj((const char *)
+			valuePtr->bytes+index, 1);
 	    } else {
-		slength = Tcl_UniCharToUtf(ch, buf);
-#if TCL_UTF_MAX < 4
-		if ((ch >= 0xD800) && (slength < 3)) {
-		    slength += Tcl_UniCharToUtf(-1, buf + slength);
+		char buf[4] = "";
+		int ch = Tcl_GetUniChar(valuePtr, index);
+
+		/*
+		 * This could be: Tcl_NewUnicodeObj((const Tcl_UniChar *)&ch, 1)
+		 * but creating the object as a string seems to be faster in
+		 * practical use.
+		 */
+		if (ch == -1) {
+		    TclNewObj(objResultPtr);
+		} else {
+		    slength = Tcl_UniCharToUtf(ch, buf);
+		    objResultPtr = Tcl_NewStringObj(buf, slength);
 		}
-#endif
-		objResultPtr = Tcl_NewStringObj(buf, slength);
 	    }
 	}
-
 	TRACE_APPEND(("\"%s\"\n", O2S(objResultPtr)));
 	NEXT_INST_F(1, 2, 1);
 
@@ -5375,14 +5442,73 @@ TEBCresume(
 	    NEXT_INST_F(9, 0, 0);
 	}
 
-	/* Decode index operands. */
+	if (TclObjectHasInterface(valuePtr, list, index)) {
+	    if ((TclIndexIsFromEnd(toIdx) || TclIndexIsFromEnd(fromIdx))
+		&& !Tcl_LengthIsFinite(slength)) {
 
-	toIdx = TclIndexDecode(toIdx, slength - 1);
-	fromIdx = TclIndexDecode(fromIdx, slength - 1);
-	if (toIdx == TCL_INDEX_NONE) {
-	    TclNewObj(objResultPtr);
+		fromIdx = TclIndexDecode(fromIdx, TclIndexLast(slength));
+		toIdx = TclIndexDecode(toIdx, TclIndexLast(slength));
+
+		if (TclObjectDispatchNoDefault(interp, objResultPtr, valuePtr,
+		    string, rangeEnd, valuePtr, fromIdx, toIdx) != TCL_OK
+		    || objResultPtr == NULL) {
+		    TRACE_ERROR(interp);
+		    goto gotError;
+		}
+	    } else {
+		fromIdx = TclIndexDecode(fromIdx, TclIndexLast(slength));
+		toIdx = TclIndexDecode(toIdx, TclIndexLast(slength));
+		if (TclObjectDispatchNoDefault(interp, objResultPtr, valuePtr,
+		    string, range, valuePtr, fromIdx, toIdx) != TCL_OK
+		    || objResultPtr == NULL) {
+		    TRACE_ERROR(interp);
+		    goto gotError;
+		}
+	    }
 	} else {
-	    objResultPtr = Tcl_GetRange(valuePtr, fromIdx, toIdx);
+	    /* Decode index operands. */
+
+	    /*
+	    assert ( toIdx != TCL_INDEX_NONE );
+	     *
+	     * Extra safety for legacy bytecodes:
+	     */
+	    if (toIdx == TCL_INDEX_NONE) {
+		goto emptyRange;
+	    }
+
+	    toIdx = TclIndexDecode(toIdx, slength - 1);
+	    if (toIdx == TCL_INDEX_NONE) {
+		goto emptyRange;
+	    } else if (toIdx >= slength) {
+		toIdx = slength - 1;
+	    }
+
+	    assert ( toIdx != TCL_INDEX_NONE && toIdx < slength );
+
+	    /*
+	    assert ( fromIdx != TCL_INDEX_NONE );
+	     *
+	     * Extra safety for legacy bytecodes:
+	     */
+	    if (fromIdx == TCL_INDEX_NONE) {
+		fromIdx = TCL_INDEX_START;
+	    }
+
+	    fromIdx = TclIndexDecode(fromIdx, slength - 1);
+	    if (fromIdx == TCL_INDEX_NONE) {
+		fromIdx = TCL_INDEX_START;
+	    }
+
+	    if (fromIdx + 1 <= toIdx + 1) {
+		objResultPtr = Tcl_GetRange(valuePtr, fromIdx, toIdx);
+		if (objResultPtr == NULL) {
+		    goto gotError;
+		}
+	    } else {
+	    emptyRange:
+		TclNewObj(objResultPtr);
+	    }
 	}
 	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
 	NEXT_INST_F(9, 1, 1);
@@ -5538,7 +5664,7 @@ TEBCresume(
 	    int ch;
 	    end = ustring1 + slength;
 	    for (p=ustring1 ; p<end ; ) {
-		p += TclUniCharToUCS4(p, &ch);
+		ch = *p++;
 		if (!tclStringClassTable[opnd].comparator(ch)) {
 		    match = 0;
 		    break;
@@ -6343,7 +6469,7 @@ TEBCresume(
 	if (Tcl_IsShared(valuePtr)) {
 	    /*
 	     * Here we do some surgery within the Tcl_Obj internals. We want
-	     * to copy the internalrep, but not the string, so we temporarily hide
+	     * to copy the intrep, but not the string, so we temporarily hide
 	     * the string so we do not copy it.
 	     */
 
@@ -6368,7 +6494,7 @@ TEBCresume(
 
     case INST_TRY_CVT_TO_BOOLEAN:
 	valuePtr = OBJ_AT_TOS;
-	if (TclHasInternalRep(valuePtr,  &tclBooleanType.objType)) {
+	if (TclHasInternalRep(valuePtr, tclBooleanType)) {
 	    objResultPtr = TCONST(1);
 	} else {
 	    int res = (TclSetBooleanFromAny(NULL, valuePtr) == TCL_OK);
@@ -6436,7 +6562,7 @@ TEBCresume(
 	    }
 	    if (Tcl_IsShared(listPtr)) {
 		objPtr = TclDuplicatePureObj(
-		    interp, listPtr, &tclListType.objType);
+		    interp, listPtr, tclListType);
 		if (!objPtr) {
 		    goto gotError;
 		}
@@ -6521,7 +6647,6 @@ TEBCresume(
 		    goto gotError;
 		}
 
-
 		valIndex = (iterNum * numVars);
 		for (j = 0;  j < numVars;  j++) {
 		    if (valIndex >= listLen) {
@@ -7050,7 +7175,7 @@ TEBCresume(
 
 	    /*
 	     * dictPtr is no longer on the stack, and we're not
-	     * moving it into the internalrep of an iterator.  We need
+	     * moving it into the intrep of an iterator.  We need
 	     * to drop the refcount [Tcl Bug 9b352768e6].
 	     */
 
@@ -8398,7 +8523,7 @@ ExecuteExtendedBinaryMathOp(
     overflowExpon:
 
 	if ((TclGetWideIntFromObj(NULL, value2Ptr, &w2) != TCL_OK)
-		|| (value2Ptr->typePtr != &tclIntType.objType)
+		|| (value2Ptr->typePtr != tclIntType)
 		|| (Tcl_WideUInt)w2 >= (1<<28)) {
 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		    "exponent too large", -1));

generic/tclIO.c

@@ -1664,6 +1664,10 @@ Tcl_CreateChannel(
     }
     statePtr->channelName = tmp;
     statePtr->flags = mask;
+	/* uncomment this to make default encoding error handling strict */
+	/*
+    statePtr->flags |= CHANNEL_ENCODING_STRICT;
+	*/
     statePtr->maxPerms = mask; /* Save max privileges for close callback */
 
     /*
@@ -1681,11 +1685,11 @@ Tcl_CreateChannel(
     statePtr->inputEncodingState  = NULL;
     statePtr->inputEncodingFlags  = TCL_ENCODING_START;
     ENCODING_PROFILE_SET(statePtr->inputEncodingFlags,
-			     TCL_ENCODING_PROFILE_TCL8);
+			     TCL_ENCODING_PROFILE_DEFAULT);
     statePtr->outputEncodingState = NULL;
     statePtr->outputEncodingFlags = TCL_ENCODING_START;
     ENCODING_PROFILE_SET(statePtr->outputEncodingFlags,
-			     TCL_ENCODING_PROFILE_TCL8);
+			     TCL_ENCODING_PROFILE_DEFAULT);
 
     /*
      * Set the channel up initially in AUTO input translation mode to accept
@@ -5931,6 +5935,7 @@ DoReadChars(
 	ResetFlag(statePtr, CHANNEL_EOF|CHANNEL_ENCODING_ERROR);
 	/* TODO: UpdateInterest not needed here? */
 	UpdateInterest(chanPtr);
+
 	Tcl_SetErrno(EILSEQ);
 	return -1;
     }
@@ -6031,6 +6036,7 @@ DoReadChars(
 	    if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR)
 		    && !GotFlag(statePtr, CHANNEL_STICKY_EOF)
 		    && (!GotFlag(statePtr, CHANNEL_NONBLOCKING))) {
+		copied = -1;
 		goto finish;
 	    }
 	}
@@ -6110,6 +6116,9 @@ finish:
 	copied = -1;
     }
     TclChannelRelease((Tcl_Channel)chanPtr);
+    if (copied == TCL_INDEX_NONE) {
+	ResetFlag(statePtr, CHANNEL_ENCODING_ERROR|CHANNEL_EOF);
+    }
     return copied;
 }
 
@@ -8205,9 +8214,7 @@ Tcl_SetChannelOption(
 	return TCL_OK;
     } else if (HaveOpt(2, "-eofchar")) {
 	if (!newValue[0] || (!(newValue[0] & 0x80) && (!newValue[1]
-#ifndef TCL_NO_DEPRECATED
 		|| !strcmp(newValue+1, " {}")
-#endif
 		))) {
 	    if (GotFlag(statePtr, TCL_READABLE)) {
 		statePtr->inEofChar = newValue[0];

generic/tclIO.h

@@ -158,10 +158,6 @@ typedef struct ChannelState {
 				 * of line sequences in output? */
     int inEofChar;		/* If nonzero, use this as a signal of EOF on
 				 * input. */
-#if TCL_MAJOR_VERSION < 9
-    int outEofChar;		/* If nonzero, append this to the channel when
-				 * it is closed if it is open for writing. For Tcl 8.x only */
-#endif
     int unreportedError;	/* Non-zero if an error report was deferred
 				 * because it happened in the background. The
 				 * value is the POSIX error code. */

generic/tclIOCmd.c

@@ -283,7 +283,7 @@ Tcl_GetsObjCmd(
     Tcl_Channel chan;		/* The channel to read from. */
     Tcl_Size lineLen;		/* Length of line just read. */
     int mode;			/* Mode in which channel is opened. */
-    Tcl_Obj *linePtr, *chanObjPtr;
+    Tcl_Obj *linePtr, *chanObjPtr, *resultDictPtr, *returnOptsPtr;
     int code = TCL_OK;
 
     if ((objc != 2) && (objc != 3)) {
@@ -306,7 +306,6 @@ Tcl_GetsObjCmd(
     lineLen = Tcl_GetsObj(chan, linePtr);
     if (lineLen == TCL_IO_FAILURE) {
 	if (!Tcl_Eof(chan) && !Tcl_InputBlocked(chan)) {
-	    Tcl_DecrRefCount(linePtr);
 
 	    /*
 	     * TIP #219.
@@ -320,7 +319,14 @@ Tcl_GetsObjCmd(
 			"error reading \"%s\": %s",
 			TclGetString(chanObjPtr), Tcl_PosixError(interp)));
 	    }
+	    resultDictPtr = Tcl_NewDictObj();
+	    Tcl_DictObjPut(NULL, resultDictPtr, Tcl_NewStringObj("read", -1)
+	    , linePtr);
+	    returnOptsPtr = Tcl_NewDictObj();
+	    Tcl_DictObjPut(NULL, returnOptsPtr, Tcl_NewStringObj("-result", -1)
+	    , resultDictPtr);
 	    code = TCL_ERROR;
+	    Tcl_SetReturnOptions(interp, returnOptsPtr);
 	    goto done;
 	}
 	lineLen = TCL_IO_FAILURE;
@@ -371,7 +377,7 @@ Tcl_ReadObjCmd(
     Tcl_WideInt toRead;			/* How many bytes to read? */
     Tcl_Size charactersRead;		/* How many characters were read? */
     int mode;			/* Mode in which channel is opened. */
-    Tcl_Obj *resultPtr, *chanObjPtr;
+    Tcl_Obj *resultPtr, *resultDictPtr, *returnOptsPtr, *chanObjPtr;
 
     if ((objc != 2) && (objc != 3)) {
 	Interp *iPtr;
@@ -433,7 +439,6 @@ Tcl_ReadObjCmd(
     TclChannelPreserve(chan);
     charactersRead = Tcl_ReadChars(chan, resultPtr, toRead, 0);
     if (charactersRead == TCL_IO_FAILURE) {
-	Tcl_DecrRefCount(resultPtr);
 	/*
 	 * TIP #219.
 	 * Capture error messages put by the driver into the bypass area and
@@ -446,7 +451,14 @@ Tcl_ReadObjCmd(
 		    "error reading \"%s\": %s",
 		    TclGetString(chanObjPtr), Tcl_PosixError(interp)));
 	}
+	resultDictPtr = Tcl_NewDictObj();
+	Tcl_DictObjPut(NULL, resultDictPtr, Tcl_NewStringObj("read", -1)
+	    , resultPtr);
+	returnOptsPtr = Tcl_NewDictObj();
+	Tcl_DictObjPut(NULL, returnOptsPtr, Tcl_NewStringObj("-result", -1)
+	    , resultDictPtr);
 	TclChannelRelease(chan);
+	Tcl_SetReturnOptions(interp, returnOptsPtr);
 	return TCL_ERROR;
     }
 

generic/tclIOGT.c

@@ -380,7 +380,7 @@ ExecuteCallback(
     Tcl_InterpState state = NULL;
     int res = TCL_OK;
     Tcl_Obj *command = TclDuplicatePureObj(
-	interp, dataPtr->command, &tclListType.objType);
+	interp, dataPtr->command, tclListType);
     if (!command) {
 	return TCL_ERROR;
     }

generic/tclIORChan.c

@@ -2261,7 +2261,7 @@ NewReflectedChannel(
     rcPtr->mode = mode;
     rcPtr->interest = 0;		/* Initially no interest registered */
 
-    rcPtr->cmd = TclDuplicatePureObj(interp, cmdpfxObj, &tclListType.objType);
+    rcPtr->cmd = TclDuplicatePureObj(interp, cmdpfxObj, tclListType);
     if (!rcPtr->cmd) {
 	return NULL;
     }
@@ -2401,7 +2401,7 @@ InvokeTclMethod(
      * before the channel id.
      */
 
-    cmd = TclDuplicatePureObj(NULL, rcPtr->cmd, &tclListType.objType);
+    cmd = TclDuplicatePureObj(NULL, rcPtr->cmd, tclListType);
     if (!cmd) {
 	return TCL_ERROR;
     }

generic/tclIOUtil.c

@@ -1734,6 +1734,11 @@ Tcl_FSEvalFileEx(
 	Tcl_CloseEx(interp,chan,0);
 	return result;
     }
+    if (Tcl_SetChannelOption(interp, chan, "-profile", "strict")
+	    != TCL_OK) {
+	Tcl_CloseEx(interp,chan,0);
+	return result;
+    }
 
     TclNewObj(objPtr);
     Tcl_IncrRefCount(objPtr);

generic/tclInt.h

@@ -11,6 +11,7 @@
  * Copyright (c) 2007 Daniel A. Steffen <das@users.sourceforge.net>
  * Copyright (c) 2006-2008 by Joe Mistachkin.  All rights reserved.
  * Copyright (c) 2008 by Miguel Sofer. All rights reserved.
+ * Copyright (c) 2021 by Nathan Coulter. All rights reserved.
  *
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -46,10 +47,13 @@
 
 #if defined(__cplusplus)
 #   define TCL_UNUSED(T) T
+#   define TCL_UNUSEDVAR(T) T
 #elif defined(__GNUC__) && (__GNUC__ > 2)
 #   define TCL_UNUSED(T) T JOIN(dummy, __LINE__) __attribute__((unused))
+#   define TCL_UNUSEDVAR(T) T __attribute__((unused))
 #else
 #   define TCL_UNUSED(T) T JOIN(dummy, __LINE__)
+#   define TCL_UNUSEDVAR(T) T
 #endif
 
 /*
@@ -206,6 +210,223 @@ typedef struct Tcl_ResolverInfo {
 
 #define TCL_AVOID_RESOLVERS 0x40000
 
+/*
+ *----------------------------------------------------------------
+ * Object type
+ *----------------------------------------------------------------
+ */
+
+/* version is a pointer so that it can be overridden if ever needed */
+typedef struct TclObjectTypeType {
+    int *version;
+} TclObjectTypeType;
+
+
+/* keep this structure in sync with Tcl_ObjType */
+typedef struct ObjectType {
+    const char *name;		/* Name of the type, e.g. "int". */
+    Tcl_FreeInternalRepProc *freeIntRepProc;
+				/* Called to free any storage for the type's
+				 * internal rep. NULL if the internal rep does
+				 * not need freeing. */
+    Tcl_DupInternalRepProc *dupIntRepProc;
+				/* Called to create a new object as a copy of
+				 * an existing object. */
+    Tcl_UpdateStringProc *updateStringProc;
+				/* Called to update the string rep from the
+				 * type's internal representation. */
+    Tcl_SetFromAnyProc *setFromAnyProc;
+				/* Called to convert the object's internal rep
+				 * to this type. Frees the internal rep of the
+				 * old type. Returns TCL_ERROR on failure. */
+    int version;
+    Tcl_ObjInterface *interface;
+} ObjectType;
+
+#define TclObjectInterfaceCall(objPtr, iface, proc, ...)		    \
+    ((ObjInterface *)((ObjectType *)(objPtr)->typePtr)->interface)	    \
+	->iface.proc(__VA_ARGS__)
+
+#define TclObjectDispatch(objPtr, default, iface, proc, ...)		    \
+    TclObjectHasInterface((objPtr), iface, proc)			    \
+    ? TclObjectInterfaceCall(objPtr, iface, proc, __VA_ARGS__)		    \
+    : default(__VA_ARGS__)
+
+
+#define TclObjectDispatchNoDefault(interp, res, objPtr, iface, proc, ...)   \
+    (TclObjectHasInterface((objPtr), iface, proc)			    \
+    ? (res = TclObjectInterfaceCall((objPtr), iface, proc, __VA_ARGS__),    \
+	TCL_OK)   \
+    : (Tcl_SetObjResult((interp),					    \
+	    Tcl_ObjPrintf("interface not provided interface %s proc %s"	    \
+		, #iface, #proc )), TCL_ERROR))
+
+
+#define TclObjectHasInterface(objPtr, iface, proc)			    \
+    ((objPtr)->typePtr != NULL						    \
+    && (objPtr)->typePtr->version == 2				    \
+    && ((ObjInterface *)((ObjectType *)(objPtr)->typePtr)->interface)	    \
+	->iface.proc != NULL)
+
+/*
+ *----------------------------------------------------------------
+ * Object interface data structures and macros
+ *----------------------------------------------------------------
+ */
+
+#define tclObjTypeInterfaceArgsListAll \
+    Tcl_Interp *interp,	/* Used to report errors if not NULL. */ \
+    Tcl_Obj *listPtr,	/* List object for which an element array \
+			 *  is to be returned. */ \
+    Tcl_Size *objcPtr,	/* Where to store the count of objects \
+			 * referenced by objv. */ \
+    Tcl_Obj ***objvPtr	/* Where to store the pointer to an \
+			 * array of */
+
+#define tclObjTypeInterfaceArgsListAppend \
+    Tcl_Interp *interp,	/* Used to report errors if not NULL. */ \
+    Tcl_Obj *listPtr,	/* List object to append objPtr to. */ \
+    Tcl_Obj *objPtr	/* Object to append to listPtr's list. */
+
+#define tclObjTypeInterfaceArgsListAppendList \
+    Tcl_Interp *interp,	    /* Used to report errors if not NULL. */ \
+    Tcl_Obj *listPtr,	    /* List object to append elements to. */ \
+    Tcl_Obj *elemListPtr    /* List obj with elements to append. */
+
+#define tclObjTypeInterfaceArgsListIndex \
+    Tcl_Interp *interp,	/* Used to report errors if not NULL. */ \
+    Tcl_Obj *listPtr,	/* List object to index into. */ \
+    Tcl_Size index,	/* Index of element to return. */ \
+    Tcl_Obj **objPtrPtr	/* The resulting Tcl_Obj* is stored here. */
+
+#define tclObjTypeInterfaceArgsListIndexEnd \
+    Tcl_Interp *interp,	/* Used to report errors if not NULL. */ \
+    Tcl_Obj *listPtr,	/* List object to index into. */ \
+    Tcl_Size index,	/* Index of element to return. */ \
+    Tcl_Obj **objPtrPtr	/* The resulting Tcl_Obj* is stored here. */
+
+#define tclObjTypeInterfaceArgsListIsSorted \
+    Tcl_Interp * interp, /* Used to report errors */ \
+    Tcl_Obj *listPtr,	/* The list in question */ \
+    size_t flags	/* flags */
+
+#define tclObjTypeInterfaceArgsListLength \
+    Tcl_Interp *interp,	/* Used to report errors if not NULL. */ \
+    Tcl_Obj *listPtr,	/* List object whose #elements to return. */ \
+    Tcl_Size *lenPtr	/* The resulting length is stored here. */
+
+#define tclObjTypeInterfaceArgsListRange \
+    Tcl_Interp * interp,    /* Used to report errors */ \
+    Tcl_Obj *listObj,	    /* List object to take a range from. */ \
+    Tcl_Size rangeStart,    /* Index of first element to */ \
+			    /* include. */ \
+    Tcl_Size rangeEnd	/* Index of last element to include. */
+
+#define tclObjTypeInterfaceArgsListRangeEnd \
+    Tcl_Interp * interp, /* Used to report errors */ \
+    Tcl_Obj *listPtr,	/* List object to take a range from. */ \
+    Tcl_Size fromAnchor,/* 0 for start and 1 for end */ \
+    Tcl_Size fromIdx,	/* Index of first element to include. */ \
+    Tcl_Size toAnchor,	/* 0 for start and 1 for end */  \
+    Tcl_Size toIdx	/* Index of last element to include. */
+
+#define tclObjTypeInterfaceArgsListReplace \
+    Tcl_Interp *interp, /* Used for error reporting if not NULL. */ \
+    Tcl_Obj *listObj,   /* List object whose elements to replace. */ \
+    Tcl_Size first,     /* Index of first element to replace. */ \
+    Tcl_Size numToDelete,	/* Number of elements to replace. */ \
+    Tcl_Size numToInsert,	/* Number of objects to insert. */ \
+			/* An array of objc pointers to Tcl \
+			 * objects to insert. */ \
+    Tcl_Obj *const insertObjs[]
+
+#define tclObjTypeInterfaceArgsListReplaceList \
+    Tcl_Interp *interp, /* Used for error reporting if not NULL. */ \
+    Tcl_Obj *listPtr,   /* List object whose elements to replace. */ \
+    Tcl_Size first,     /* Index of first element to replace. */ \
+    Tcl_Size count,	/* Number of elements to replace. */ \
+    Tcl_Obj *newItemsPtr /* a list of new items to insert */
+
+#define tclObjTypeInterfaceArgsListReverse \
+    Tcl_Interp *interp, /* Used for error reporting if not NULL. */ \
+    Tcl_Obj *listPtr   /* List object whose elements to replace. */ \
+
+
+#define tclObjTypeInterfaceArgsListSet \
+    Tcl_Interp *interp,		/* Tcl interpreter; used for error reporting \
+				 * if not NULL. */ \
+    Tcl_Obj *listObj,		/* List object in which element should be \
+				 * stored. */ \
+    Tcl_Size index,		/* Index of element to store. */ \
+    Tcl_Obj *valueObj		/* Tcl object to store in the designated list \
+				 * element. */
+
+#define tclObjTypeInterfaceArgsListSetList \
+    Tcl_Interp *interp,	    /* Tcl interpreter. */ \
+    Tcl_Obj *listObj,	    /* Pointer to the list being modified. */ \
+    Tcl_Size indexCount,    /* Number of index args. */ \
+    Tcl_Obj *const indexArray[],    /* Index args. */ \
+    Tcl_Obj *valueObj	    /* Value arg to 'lset' or NULL to 'lpop'. */
+
+
+#define tclObjTypeInterfaceArgsStringIndex \
+    Tcl_Interp *interp,	    \
+    Tcl_Obj *objPtr,	    \
+    Tcl_Size index,	\
+    Tcl_Obj **objPtrPtr	/* The resulting Tcl_Obj* is stored here. */
+
+
+#define tclObjTypeInterfaceArgsStringIndexEnd \
+    Tcl_Interp *interp,	    \
+    Tcl_Obj *objPtr,	    \
+    Tcl_Size index,	\
+    Tcl_Obj **objPtrPtr	/* The resulting Tcl_Obj* is stored here. */
+
+
+#define tclObjTypeInterfaceArgsStringLength \
+    Tcl_Obj *objPtr
+
+
+#define tclObjTypeInterfaceArgsStringRange \
+    Tcl_Obj *objPtr,	/* The Tcl object to find the range of. */ \
+    Tcl_Size first,	/* First index of the range. */ \
+    Tcl_Size last	/* Last index of the range. */
+
+
+#define tclObjTypeInterfaceArgsStringRangeEnd \
+    Tcl_Obj *objPtr,	/* The Tcl object to find the range of. */ \
+    Tcl_Size first,	/* First index of the range. */ \
+    Tcl_Size last	/* Last index of the range. */
+
+
+typedef struct ObjInterface {
+    int version;
+    struct string {
+	int (*index)(tclObjTypeInterfaceArgsStringIndex);
+	int (*indexEnd)(tclObjTypeInterfaceArgsStringIndexEnd);
+	Tcl_Size (*length)(tclObjTypeInterfaceArgsStringLength);
+	Tcl_Obj* (*range)(tclObjTypeInterfaceArgsStringRange);
+	Tcl_Obj* (*rangeEnd)(tclObjTypeInterfaceArgsStringRangeEnd);
+    } string;
+    struct list {
+	int (*all)(tclObjTypeInterfaceArgsListAll);
+	int (*append)(tclObjTypeInterfaceArgsListAppend);
+	int (*appendlist)(tclObjTypeInterfaceArgsListAppendList);
+	int (*index)(tclObjTypeInterfaceArgsListIndex);
+	int (*indexEnd)(tclObjTypeInterfaceArgsListIndexEnd);
+	int (*isSorted)(tclObjTypeInterfaceArgsListIsSorted);
+	int (*length)(tclObjTypeInterfaceArgsListLength);
+	Tcl_Obj* (*range)(tclObjTypeInterfaceArgsListRange);
+	Tcl_Obj* (*rangeEnd)(tclObjTypeInterfaceArgsListRangeEnd);
+	int (*replace)(tclObjTypeInterfaceArgsListReplace);
+	int (*replaceList)(tclObjTypeInterfaceArgsListReplaceList);
+	Tcl_Obj* (*reverse)(tclObjTypeInterfaceArgsListReverse);
+	int (*set)(tclObjTypeInterfaceArgsListSet);
+	Tcl_Obj * (*setlist)(tclObjTypeInterfaceArgsListSetList);
+    } list;
+} ObjInterface;
+
+
 /*
  *----------------------------------------------------------------
  * Data structures related to namespaces.
@@ -225,9 +446,7 @@ typedef struct NamespacePathEntry NamespacePathEntry;
 typedef struct TclVarHashTable {
     Tcl_HashTable table;
     struct Namespace *nsPtr;
-#if TCL_MAJOR_VERSION > 8
     struct Var *arrayPtr;
-#endif /* TCL_MAJOR_VERSION > 8 */
 } TclVarHashTable;
 
 /*
@@ -277,11 +496,7 @@ typedef struct Namespace {
 				 * strings; values have type (Namespace *). If
 				 * NULL, there are no children. */
 #endif
-#if TCL_MAJOR_VERSION > 8
     size_t nsId;		/* Unique id for the namespace. */
-#else
-    unsigned long nsId;
-#endif
     Tcl_Interp *interp;	/* The interpreter containing this
 				 * namespace. */
     int flags;			/* OR-ed combination of the namespace status
@@ -962,9 +1177,6 @@ typedef struct CompiledLocal {
 				 * Among others used to speed up var lookups. */
     Tcl_Size frameIndex;		/* Index in the array of compiler-assigned
 				 * variables in the procedure call frame. */
-#if TCL_MAJOR_VERSION < 9
-    int flags;
-#endif
     Tcl_Obj *defValuePtr;	/* Pointer to the default value of an
 				 * argument, if any. NULL if not an argument
 				 * or, if an argument, no default value. */
@@ -975,12 +1187,10 @@ typedef struct CompiledLocal {
 				 * is marked by a unique tag during
 				 * compilation, and that same tag is used to
 				 * find the variable at runtime. */
-#if TCL_MAJOR_VERSION > 8
     int flags;			/* Flag bits for the local variable. Same as
 				 * the flags for the Var structure above,
 				 * although only VAR_ARGUMENT, VAR_TEMPORARY,
 				 * and VAR_RESOLVED make sense. */
-#endif
     char name[TCLFLEXARRAY];		/* Name of the local variable starts here. If
 				 * the name is NULL, this will just be '\0'.
 				 * The actual size of this field will be large
@@ -1038,11 +1248,7 @@ typedef void (ProcErrorProc)(Tcl_Interp *interp, Tcl_Obj *procNameObj);
 typedef struct Trace {
     Tcl_Size level;		/* Only trace commands at nesting level less
 				 * than or equal to this. */
-#if TCL_MAJOR_VERSION > 8
     Tcl_CmdObjTraceProc2 *proc;	/* Procedure to call to trace command. */
-#else
-    Tcl_CmdObjTraceProc *proc;	/* Procedure to call to trace command. */
-#endif
     void *clientData;	/* Arbitrary value to pass to proc. */
     struct Trace *nextPtr;	/* Next in list of traces for this interp. */
     int flags;			/* Flags governing the trace - see
@@ -1086,20 +1292,6 @@ typedef struct ActiveInterpTrace {
 #define TCL_TRACE_ENTER_EXEC	1
 #define TCL_TRACE_LEAVE_EXEC	2
 
-typedef struct {  /* For internal core use only */
-    Tcl_ObjType objType;
-    struct {
-	Tcl_Size (*lengthProc)(Tcl_Obj *obj);
-    } abstractList;
-} TclObjTypeWithAbstractList;
-#define TCL_OBJTYPE_V0_1(lengthProc) (sizeof(TclObjTypeWithAbstractList)) \
-	}, {lengthProc /* For internal core use only */
-#define ABSTRACTLIST_PROC(objPtr, proc) (((objPtr)->typePtr \
-	&& ((objPtr)->typePtr->version > offsetof(TclObjTypeWithAbstractList, abstractList.proc))) ? \
-	((const TclObjTypeWithAbstractList *)(objPtr)->typePtr)->abstractList.proc : NULL)
-
-MODULE_SCOPE Tcl_Size TclLengthOne(Tcl_Obj *);
-
 /*
  * The structure below defines an entry in the assocData hash table which is
  * associated with an interpreter. The entry contains a pointer to a function
@@ -1881,18 +2073,7 @@ typedef struct Interp {
     void *interpInfo;	/* Information used by tclInterp.c to keep
 				 * track of parent/child interps on a
 				 * per-interp basis. */
-#if TCL_MAJOR_VERSION > 8
     void (*optimizer)(void *envPtr);
-#else
-    union {
-	void (*optimizer)(void *envPtr);
-	Tcl_HashTable unused2;	/* No longer used (was mathFuncTable). The
-				 * unused space in interp was repurposed for
-				 * pluggable bytecode optimizers. The core
-				 * contains one optimizer, which can be
-				 * selectively overridden by extensions. */
-    } extra;
-#endif
     /*
      * Information related to procedures and variables. See tclProc.c and
      * tclVar.c for usage.
@@ -1921,12 +2102,6 @@ typedef struct Interp {
     Namespace *lookupNsPtr;	/* Namespace to use ONLY on the next
 				 * TCL_EVAL_INVOKE call to Tcl_EvalObjv. */
 
-#if TCL_MAJOR_VERSION < 9
-    char *appendResultDontUse;
-    int appendAvlDontUse;
-    int appendUsedDontUse;
-#endif
-
     /*
      * Information about packages. Used only in tclPkg.c.
      */
@@ -1949,9 +2124,6 @@ typedef struct Interp {
 				 * Normally zero, but may be set before
 				 * calling Tcl_Eval. See below for valid
 				 * values. */
-#if TCL_MAJOR_VERSION < 9
-    int unused1;		/* No longer used (was termOffset) */
-#endif
     LiteralTable literalTable;	/* Contains LiteralEntry's describing all Tcl
 				 * objects holding literals of scripts
 				 * compiled by the interpreter. Indexed by the
@@ -1989,9 +2161,6 @@ typedef struct Interp {
 				 * string. Returned by Tcl_ObjSetVar2 when
 				 * variable traces change a variable in a
 				 * gross way. */
-#if TCL_MAJOR_VERSION < 9
-    char resultSpaceDontUse[TCL_DSTRING_STATIC_SIZE+1];
-#endif
     Tcl_Obj *objResultPtr;	/* If the last command returned an object
 				 * result, this points to it. Should not be
 				 * accessed directly; see comment above. */
@@ -2445,6 +2614,7 @@ typedef enum TclEolTranslation {
 #define TCL_INVOKE_NO_UNKNOWN	(1<<1)
 #define TCL_INVOKE_NO_TRACEBACK	(1<<2)
 
+
 /*
  * ListStore --
  *
@@ -2613,10 +2783,10 @@ typedef struct ListRep {
  * converted to a list.
  */
 #define TclListObjGetElementsM(interp_, listObj_, objcPtr_, objvPtr_)    \
-    (((listObj_)->typePtr == &tclListType.objType)                              \
-	 ? ((ListObjGetElements((listObj_), *(objcPtr_), *(objvPtr_))), \
-	    TCL_OK)                                                     \
-	 : Tcl_ListObjGetElements(                                      \
+    (((listObj_)->typePtr == tclListType)                               \
+	 ? ((ListObjGetElements((listObj_), *(objcPtr_), *(objvPtr_))),  \
+	    TCL_OK)                                                      \
+	 : Tcl_ListObjGetElements(                                       \
 	     (interp_), (listObj_), (objcPtr_), (objvPtr_)))
 
 /*
@@ -2624,13 +2794,14 @@ typedef struct ListRep {
  * count in lenPtr_.  Returns TCL_OK on success or TCL_ERROR if the
  * Tcl_Obj cannot be converted to a list.
  */
-#define TclListObjLengthM(interp_, listObj_, lenPtr_)         \
-    (((listObj_)->typePtr == &tclListType.objType)                   \
-	 ? ((ListObjLength((listObj_), *(lenPtr_))), TCL_OK) \
+#define TclListObjLengthM(interp_, listObj_, lenPtr_)                \
+    (((listObj_)->typePtr == tclListType)                           \
+	 ? ((ListObjLength((listObj_), *(lenPtr_))), TCL_OK)         \
 	 : Tcl_ListObjLength((interp_), (listObj_), (lenPtr_)))
 
-#define TclListObjIsCanonical(listObj_) \
-    (((listObj_)->typePtr == &tclListType.objType) ? ListObjIsCanonical((listObj_)) : 0)
+#define TclListObjIsCanonical(listObj_)       \
+    (((listObj_)->typePtr == tclListType)    \
+	? ListObjIsCanonical((listObj_)) : 0)
 
 /*
  * Modes for collecting (or not) in the implementations of TclNRForeachCmd,
@@ -2648,29 +2819,20 @@ typedef struct ListRep {
  * WARNING: these macros eval their args more than once.
  */
 
-#if TCL_MAJOR_VERSION > 8
 #define TclGetBooleanFromObj(interp, objPtr, intPtr) \
-    (((objPtr)->typePtr == &tclIntType.objType \
-	    || (objPtr)->typePtr == &tclBooleanType.objType) \
+    (((objPtr)->typePtr == tclIntType \
+	    || (objPtr)->typePtr == tclBooleanType) \
 	? (*(intPtr) = ((objPtr)->internalRep.wideValue!=0), TCL_OK)	\
 	: Tcl_GetBooleanFromObj((interp), (objPtr), (intPtr)))
-#else
-#define TclGetBooleanFromObj(interp, objPtr, intPtr) \
-    (((objPtr)->typePtr == &tclIntType.objType)			\
-	? (*(intPtr) = ((objPtr)->internalRep.wideValue!=0), TCL_OK)	\
-	: ((objPtr)->typePtr == &tclBooleanType.objType)			\
-	? (*(intPtr) = ((objPtr)->internalRep.longValue!=0), TCL_OK)	\
-	: Tcl_GetBooleanFromObj((interp), (objPtr), (intPtr)))
-#endif
 
 #ifdef TCL_WIDE_INT_IS_LONG
 #define TclGetLongFromObj(interp, objPtr, longPtr) \
-    (((objPtr)->typePtr == &tclIntType.objType)	\
+    (((objPtr)->typePtr == tclIntType)	\
 	    ? ((*(longPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \
 	    : Tcl_GetLongFromObj((interp), (objPtr), (longPtr)))
 #else
 #define TclGetLongFromObj(interp, objPtr, longPtr) \
-    (((objPtr)->typePtr == &tclIntType.objType \
+    (((objPtr)->typePtr == tclIntType \
 	    && (objPtr)->internalRep.wideValue >= (Tcl_WideInt)(LONG_MIN) \
 	    && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(LONG_MAX)) \
 	    ? ((*(longPtr) = (long)(objPtr)->internalRep.wideValue), TCL_OK) \
@@ -2678,13 +2840,13 @@ typedef struct ListRep {
 #endif
 
 #define TclGetIntFromObj(interp, objPtr, intPtr) \
-    (((objPtr)->typePtr == &tclIntType.objType \
+    (((objPtr)->typePtr == tclIntType \
 	    && (objPtr)->internalRep.wideValue >= (Tcl_WideInt)(INT_MIN) \
 	    && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(INT_MAX)) \
 	    ? ((*(intPtr) = (int)(objPtr)->internalRep.wideValue), TCL_OK) \
 	    : Tcl_GetIntFromObj((interp), (objPtr), (intPtr)))
 #define TclGetIntForIndexM(interp, objPtr, endValue, idxPtr) \
-    ((((objPtr)->typePtr == &tclIntType.objType) && ((objPtr)->internalRep.wideValue >= 0) \
+    ((((objPtr)->typePtr == tclIntType) && ((objPtr)->internalRep.wideValue >= 0) \
 	    && ((objPtr)->internalRep.wideValue <= endValue)) \
 	    ? ((*(idxPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \
 	    : Tcl_GetIntForIndex((interp), (objPtr), (endValue), (idxPtr)))
@@ -2698,7 +2860,7 @@ typedef struct ListRep {
  */
 
 #define TclGetWideIntFromObj(interp, objPtr, wideIntPtr) \
-    (((objPtr)->typePtr == &tclIntType.objType)					\
+    (((objPtr)->typePtr == tclIntType)					\
 	? (*(wideIntPtr) =						\
 		((objPtr)->internalRep.wideValue), TCL_OK) :		\
 	Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr)))
@@ -2973,13 +3135,13 @@ MODULE_SCOPE void *tclTimeClientData;
  * Variables denoting the Tcl object types defined in the core.
  */
 
-MODULE_SCOPE const TclObjTypeWithAbstractList tclBignumType;
-MODULE_SCOPE const TclObjTypeWithAbstractList tclBooleanType;
+MODULE_SCOPE const Tcl_ObjType *tclBignumType;
+MODULE_SCOPE const Tcl_ObjType *tclBooleanType;
 MODULE_SCOPE const Tcl_ObjType tclByteCodeType;
-MODULE_SCOPE const TclObjTypeWithAbstractList tclDoubleType;
-MODULE_SCOPE const TclObjTypeWithAbstractList tclIntType;
-MODULE_SCOPE const TclObjTypeWithAbstractList tclListType;
-MODULE_SCOPE const TclObjTypeWithAbstractList tclArithSeriesType;
+MODULE_SCOPE const Tcl_ObjType *tclDoubleType;
+MODULE_SCOPE const Tcl_ObjType *tclIntType;
+MODULE_SCOPE const Tcl_ObjType *tclListType;
+MODULE_SCOPE const Tcl_ObjType *tclArithSeriesType;
 MODULE_SCOPE const Tcl_ObjType tclDictType;
 MODULE_SCOPE const Tcl_ObjType tclProcBodyType;
 MODULE_SCOPE const Tcl_ObjType tclStringType;
@@ -3122,7 +3284,6 @@ struct Tcl_LoadHandle_ {
  *----------------------------------------------------------------
  */
 
-#if TCL_MAJOR_VERSION > 8
 MODULE_SCOPE void	TclAppendBytesToByteArray(Tcl_Obj *objPtr,
 			    const unsigned char *bytes, Tcl_Size len);
 MODULE_SCOPE int	TclNREvalCmd(Tcl_Interp *interp, Tcl_Obj *objPtr,
@@ -3146,6 +3307,7 @@ MODULE_SCOPE int	TclAsyncNotifier(int sigNumber, Tcl_ThreadId threadId,
 			    void *clientData, int *flagPtr, int value);
 MODULE_SCOPE void	TclAsyncMarkFromNotifier(void);
 MODULE_SCOPE double	TclBignumToDouble(const void *bignum);
+MODULE_SCOPE void	TclBounceRefCount(Tcl_Obj *objPtr);
 MODULE_SCOPE int	TclByteArrayMatch(const unsigned char *string,
 			    Tcl_Size strLen, const unsigned char *pattern,
 			    Tcl_Size ptnLen, int flags);
@@ -3179,7 +3341,6 @@ MODULE_SCOPE Tcl_Command TclCreateEnsembleInNs(Tcl_Interp *interp,
 			    Tcl_Namespace *ensembleNamespacePtr, int flags);
 MODULE_SCOPE void	TclDeleteNamespaceVars(Namespace *nsPtr);
 MODULE_SCOPE void	TclDeleteNamespaceChildren(Namespace *nsPtr);
-MODULE_SCOPE Tcl_Size	TclDictGetSize(Tcl_Obj *dictPtr);
 MODULE_SCOPE Tcl_Obj*	TclDuplicatePureObj(Tcl_Interp *interp,
 			    Tcl_Obj * objPtr, const Tcl_ObjType *typPtr);
 MODULE_SCOPE int	TclFindDictElement(Tcl_Interp *interp,
@@ -3270,6 +3431,8 @@ MODULE_SCOPE int	TclGetLoadedLibraries(Tcl_Interp *interp,
 				const char *packageName);
 MODULE_SCOPE int	TclGetWideBitsFromObj(Tcl_Interp *, Tcl_Obj *,
 				Tcl_WideInt *);
+MODULE_SCOPE int	TclIndexIsFromEnd(Tcl_Size encoded);
+MODULE_SCOPE Tcl_Size	TclIndexLast (Tcl_Size N);
 MODULE_SCOPE int	TclIncrObj(Tcl_Interp *interp, Tcl_Obj *valuePtr,
 			    Tcl_Obj *incrPtr);
 MODULE_SCOPE Tcl_Obj *	TclIncrObjVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
@@ -3309,9 +3472,12 @@ MODULE_SCOPE Tcl_Obj *	TclLindexList(Tcl_Interp *interp,
 MODULE_SCOPE Tcl_Obj *	TclLindexFlat(Tcl_Interp *interp, Tcl_Obj *listPtr,
 			    Tcl_Size indexCount, Tcl_Obj *const indexArray[]);
 MODULE_SCOPE Tcl_Obj *	TclListObjGetElement(Tcl_Obj *listObj, Tcl_Size index);
+MODULE_SCOPE int	Tcl_LengthIsFinite(Tcl_Size length);
 /* TIP #280 */
 MODULE_SCOPE void	TclListLines(Tcl_Obj *listObj, Tcl_Size line, int n,
 			    int *lines, Tcl_Obj *const *elems);
+MODULE_SCOPE int	(*TclObjInterfaceGetListIndex (Tcl_Obj *objPtr))
+			    (tclObjTypeInterfaceArgsListIndex);
 MODULE_SCOPE int	TclListObjAppendElements(Tcl_Interp *interp,
 			    Tcl_Obj *toObj, Tcl_Size elemCount,
 			    Tcl_Obj *const elemObjv[]);
@@ -3319,9 +3485,9 @@ MODULE_SCOPE Tcl_Obj *	TclListObjRange(Tcl_Interp *interp, Tcl_Obj *listPtr,
 			    Tcl_Size fromIdx, Tcl_Size toIdx);
 MODULE_SCOPE Tcl_Obj *	TclLsetList(Tcl_Interp *interp, Tcl_Obj *listPtr,
 			    Tcl_Obj *indexPtr, Tcl_Obj *valuePtr);
-MODULE_SCOPE Tcl_Obj *	TclLsetFlat(Tcl_Interp *interp, Tcl_Obj *listPtr,
-			    Tcl_Size indexCount, Tcl_Obj *const indexArray[],
-			    Tcl_Obj *valuePtr);
+MODULE_SCOPE Tcl_Obj *	TclLsetFlat(tclObjTypeInterfaceArgsListSetList);
+MODULE_SCOPE Tcl_Obj *	TclLsetList(Tcl_Interp *interp, Tcl_Obj *listPtr,
+			    Tcl_Obj *indexPtr, Tcl_Obj *valuePtr);
 MODULE_SCOPE Tcl_Command TclMakeEnsemble(Tcl_Interp *interp, const char *name,
 			    const EnsembleImplMap map[]);
 MODULE_SCOPE int TclMakeSafe(Tcl_Interp *interp);
@@ -3334,6 +3500,9 @@ MODULE_SCOPE Tcl_Obj *  TclNoErrorStack(Tcl_Interp *interp, Tcl_Obj *options);
 MODULE_SCOPE int	TclNokia770Doubles(void);
 MODULE_SCOPE void	TclNsDecrRefCount(Namespace *nsPtr);
 MODULE_SCOPE int	TclNamespaceDeleted(Namespace *nsPtr);
+MODULE_SCOPE Tcl_Obj *	TclObjGetScalar(Tcl_Obj *objPtr);
+MODULE_SCOPE const char *   TclObjTypeName(const Tcl_ObjType *typePtr);
+MODULE_SCOPE int	 TclObjTypeVersion (const Tcl_ObjType *typePtr);
 MODULE_SCOPE void	TclObjVarErrMsg(Tcl_Interp *interp, Tcl_Obj *part1Ptr,
 			    Tcl_Obj *part2Ptr, const char *operation,
 			    const char *reason, int index);
@@ -3415,6 +3584,7 @@ MODULE_SCOPE Tcl_FSDupInternalRepProc TclNativeDupInternalRep;
 MODULE_SCOPE Tcl_Obj *	TclpObjLink(Tcl_Obj *pathPtr, Tcl_Obj *toPtr,
 			    int linkType);
 MODULE_SCOPE int	TclpObjChdir(Tcl_Obj *pathPtr);
+MODULE_SCOPE void Tcl_ObjTypeVersion(Tcl_Obj *objPtr, int *version);
 MODULE_SCOPE Tcl_Channel TclpOpenTemporaryFile(Tcl_Obj *dirObj,
 			    Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
 			    Tcl_Obj *resultingNameObj);
@@ -3462,6 +3632,8 @@ MODULE_SCOPE int	TclStringCmp(Tcl_Obj *value1Ptr, Tcl_Obj *value2Ptr,
 MODULE_SCOPE int	TclStringCmpOpts(Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[], int *nocase,
 			    Tcl_Size *reqlength);
+MODULE_SCOPE int	TclStringIndexInterface(Tcl_Interp *interp, Tcl_Obj *objPtr,
+			    Tcl_Obj *indexPtr, Tcl_Obj **charPtr);
 MODULE_SCOPE int	TclStringMatch(const char *str, Tcl_Size strLen,
 			    const char *pattern, int ptnLen, int flags);
 MODULE_SCOPE int	TclStringMatchObj(Tcl_Obj *stringObj,
@@ -3487,18 +3659,10 @@ MODULE_SCOPE const char*TclGetCommandTypeName(Tcl_Command command);
 MODULE_SCOPE void	TclRegisterCommandTypeName(
 			    Tcl_ObjCmdProc *implementationProc,
 			    const char *nameStr);
+MODULE_SCOPE void	TclUndoRefCount(Tcl_Obj *objPtr);
 MODULE_SCOPE int	TclUtfCmp(const char *cs, const char *ct);
 MODULE_SCOPE int	TclUtfCasecmp(const char *cs, const char *ct);
 MODULE_SCOPE int	TclUtfCount(int ch);
-#if TCL_UTF_MAX > 3
-#   define TclUtfToUCS4 Tcl_UtfToUniChar
-#   define TclUniCharToUCS4(src, ptr) (*ptr = *(src),1)
-#   define TclUCS4Prev(src, ptr) (((src) > (ptr)) ? ((src) - 1) : (src))
-#else
-    MODULE_SCOPE int	TclUtfToUCS4(const char *, int *);
-    MODULE_SCOPE int	TclUniCharToUCS4(const Tcl_UniChar *, int *);
-    MODULE_SCOPE const Tcl_UniChar *TclUCS4Prev(const Tcl_UniChar *, const Tcl_UniChar *);
-#endif
 MODULE_SCOPE Tcl_Obj *	TclpNativeToNormalized(void *clientData);
 MODULE_SCOPE Tcl_Obj *	TclpFilesystemPathType(Tcl_Obj *pathPtr);
 MODULE_SCOPE int	TclpDlopen(Tcl_Interp *interp, Tcl_Obj *pathPtr,
@@ -4254,7 +4418,6 @@ MODULE_SCOPE int	TclIndexInvalidError(Tcl_Interp *interp,
  */
 MODULE_SCOPE int TclCommandWordLimitError(Tcl_Interp *interp, Tcl_Size count);
 
-#endif /* TCL_MAJOR_VERSION > 8 */
 
 /* Constants used in index value encoding routines. */
 #define TCL_INDEX_END           ((Tcl_Size)-2)
@@ -4767,17 +4930,10 @@ MODULE_SCOPE const TclFileAttrProcs	tclpFileAttrProcs[];
  *----------------------------------------------------------------
  */
 
-#if TCL_UTF_MAX > 3
 #define TclUtfToUniChar(str, chPtr) \
 	(((UCHAR(*(str))) < 0x80) ?		\
 	    ((*(chPtr) = UCHAR(*(str))), 1)	\
 	    : Tcl_UtfToUniChar(str, chPtr))
-#else
-#define TclUtfToUniChar(str, chPtr) \
-	(((UCHAR(*(str))) < 0x80) ?		\
-	    ((*(chPtr) = UCHAR(*(str))), 1)	\
-	    : Tcl_UtfToChar16(str, chPtr))
-#endif
 
 /*
  *----------------------------------------------------------------
@@ -4840,7 +4996,7 @@ MODULE_SCOPE int	TclIsPureByteArray(Tcl_Obj *objPtr);
  *----------------------------------------------------------------
  */
 
-#if defined(WORDS_BIGENDIAN) && (TCL_UTF_MAX > 3)
+#if defined(WORDS_BIGENDIAN)
 #   define TclUniCharNcmp(cs,ct,n) memcmp((cs),(ct),(n)*sizeof(Tcl_UniChar))
 #endif /* WORDS_BIGENDIAN */
 
@@ -4886,8 +5042,8 @@ MODULE_SCOPE Tcl_LibraryInitProc TclObjTest_Init;
 MODULE_SCOPE Tcl_LibraryInitProc TclThread_Init;
 MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_Init;
 MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit;
-
-
+MODULE_SCOPE Tcl_LibraryInitProc TcltestObjectInterfaceInit;
+MODULE_SCOPE Tcl_LibraryInitProc TcltestObjectInterfaceListIntegerInit;
 
 /*
  *----------------------------------------------------------------
@@ -4918,7 +5074,7 @@ MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit;
 	Tcl_ObjInternalRep ir;				\
 	ir.wideValue = (Tcl_WideInt) i;			\
 	TclInvalidateStringRep(objPtr);			\
-	Tcl_StoreInternalRep(objPtr, &tclIntType.objType, &ir);	\
+	Tcl_StoreInternalRep(objPtr, tclIntType, &ir);	\
     } while (0)
 
 #define TclSetDoubleObj(objPtr, d) \
@@ -4926,7 +5082,7 @@ MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit;
 	Tcl_ObjInternalRep ir;				\
 	ir.doubleValue = (double) d;			\
 	TclInvalidateStringRep(objPtr);			\
-	Tcl_StoreInternalRep(objPtr, &tclDoubleType.objType, &ir);	\
+	Tcl_StoreInternalRep(objPtr, tclDoubleType, &ir);	\
     } while (0)
 
 /*
@@ -4951,7 +5107,7 @@ MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit;
 	(objPtr)->refCount = 0;				\
 	(objPtr)->bytes = NULL;				\
 	(objPtr)->internalRep.wideValue = (Tcl_WideInt)(w);	\
-	(objPtr)->typePtr = &tclIntType.objType;		\
+	(objPtr)->typePtr = tclIntType;		\
 	TCL_DTRACE_OBJ_CREATE(objPtr);			\
     } while (0)
 
@@ -4970,7 +5126,7 @@ MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit;
 	    TclSetBignumInternalRep((objPtr), &bignumValue_);	\
 	} else {	\
 	    (objPtr)->internalRep.wideValue = (Tcl_WideInt)(uw_);	\
-	    (objPtr)->typePtr = &tclIntType.objType;		\
+	    (objPtr)->typePtr = tclIntType;		\
 	}	\
 	TCL_DTRACE_OBJ_CREATE(objPtr);			\
     } while (0)
@@ -4985,7 +5141,7 @@ MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit;
 	(objPtr)->refCount = 0;					\
 	(objPtr)->bytes = NULL;					\
 	(objPtr)->internalRep.doubleValue = (double)(d);	\
-	(objPtr)->typePtr = &tclDoubleType.objType;			\
+	(objPtr)->typePtr = tclDoubleType;			\
 	TCL_DTRACE_OBJ_CREATE(objPtr);				\
     } while (0)
 

generic/tclIntDecls.h

@@ -1281,15 +1281,6 @@ extern const TclIntStubs *tclIntStubsPtr;
 	(tclIntStubsPtr->tclStaticLibrary)
 #endif /* defined(USE_TCL_STUBS) */
 
-#if (TCL_MAJOR_VERSION < 9) && defined(USE_TCL_STUBS)
-#undef TclpGetClicks
-#define TclpGetClicks() \
-		((unsigned long)tclIntStubsPtr->tclpGetClicks())
-#undef TclpGetSeconds
-#define TclpGetSeconds() \
-		((unsigned long)tclIntStubsPtr->tclpGetSeconds())
-#endif
-
 #undef TclObjInterpProc
 #define TclObjInterpProc TclGetObjInterpProc()
 #define TclObjInterpProc2 TclGetObjInterpProc2()

generic/tclIntPlatDecls.h

@@ -30,535 +30,6 @@
  * in the generic/tclInt.decls script.
  */
 
-#if TCL_MAJOR_VERSION < 9
-
-#ifdef __cplusplus
-extern "C" {
-#endif
-
-/*
- * Exported function declarations:
- */
-
-#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
-/* 0 */
-EXTERN void		TclGetAndDetachPids(Tcl_Interp *interp,
-				Tcl_Channel chan);
-/* 1 */
-EXTERN int		TclpCloseFile(TclFile file);
-/* 2 */
-EXTERN Tcl_Channel	TclpCreateCommandChannel(TclFile readFile,
-				TclFile writeFile, TclFile errorFile,
-				int numPids, Tcl_Pid *pidPtr);
-/* 3 */
-EXTERN int		TclpCreatePipe(TclFile *readPipe, TclFile *writePipe);
-/* 4 */
-EXTERN int		TclpCreateProcess(Tcl_Interp *interp, int argc,
-				const char **argv, TclFile inputFile,
-				TclFile outputFile, TclFile errorFile,
-				Tcl_Pid *pidPtr);
-/* 5 */
-EXTERN int		TclUnixWaitForFile_(int fd, int mask, int timeout);
-/* 6 */
-EXTERN TclFile		TclpMakeFile(Tcl_Channel channel, int direction);
-/* 7 */
-EXTERN TclFile		TclpOpenFile(const char *fname, int mode);
-/* 8 */
-EXTERN int		TclUnixWaitForFile(int fd, int mask, int timeout);
-/* 9 */
-EXTERN TclFile		TclpCreateTempFile(const char *contents);
-/* 10 */
-EXTERN Tcl_DirEntry *	TclpReaddir(TclDIR *dir);
-/* 11 */
-EXTERN struct tm *	TclpLocaltime_unix(const time_t *clock);
-/* 12 */
-EXTERN struct tm *	TclpGmtime_unix(const time_t *clock);
-/* 13 */
-EXTERN char *		TclpInetNtoa(struct in_addr addr);
-/* 14 */
-EXTERN int		TclUnixCopyFile(const char *src, const char *dst,
-				const Tcl_StatBuf *statBufPtr,
-				int dontCopyAtts);
-/* 15 */
-EXTERN int		TclMacOSXGetFileAttribute(Tcl_Interp *interp,
-				int objIndex, Tcl_Obj *fileName,
-				Tcl_Obj **attributePtrPtr);
-/* 16 */
-EXTERN int		TclMacOSXSetFileAttribute(Tcl_Interp *interp,
-				int objIndex, Tcl_Obj *fileName,
-				Tcl_Obj *attributePtr);
-/* 17 */
-EXTERN int		TclMacOSXCopyFileAttributes(const char *src,
-				const char *dst,
-				const Tcl_StatBuf *statBufPtr);
-/* 18 */
-EXTERN int		TclMacOSXMatchType(Tcl_Interp *interp,
-				const char *pathName, const char *fileName,
-				Tcl_StatBuf *statBufPtr,
-				Tcl_GlobTypeData *types);
-/* 19 */
-EXTERN void		TclMacOSXNotifierAddRunLoopMode(
-				const void *runLoopMode);
-/* Slot 20 is reserved */
-/* Slot 21 is reserved */
-/* 22 */
-EXTERN TclFile		TclpCreateTempFile_(const char *contents);
-/* Slot 23 is reserved */
-/* Slot 24 is reserved */
-/* Slot 25 is reserved */
-/* Slot 26 is reserved */
-/* Slot 27 is reserved */
-/* Slot 28 is reserved */
-/* 29 */
-EXTERN int		TclWinCPUID(int index, int *regs);
-/* 30 */
-EXTERN int		TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
-				Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
-				Tcl_Obj *resultingNameObj);
-#endif /* UNIX */
-#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
-/* 0 */
-EXTERN void		TclWinConvertError(DWORD errCode);
-/* 1 */
-EXTERN void		TclWinConvertWSAError(DWORD errCode);
-/* 2 */
-EXTERN struct servent *	 TclWinGetServByName(const char *nm,
-				const char *proto);
-/* 3 */
-EXTERN int		TclWinGetSockOpt(SOCKET s, int level, int optname,
-				char *optval, int *optlen);
-/* 4 */
-EXTERN HINSTANCE	TclWinGetTclInstance(void);
-/* 5 */
-EXTERN int		TclUnixWaitForFile(int fd, int mask, int timeout);
-/* 6 */
-EXTERN unsigned short	TclWinNToHS(unsigned short ns);
-/* 7 */
-EXTERN int		TclWinSetSockOpt(SOCKET s, int level, int optname,
-				const char *optval, int optlen);
-/* 8 */
-EXTERN int		TclpGetPid(Tcl_Pid pid);
-/* 9 */
-EXTERN int		TclWinGetPlatformId(void);
-/* 11 */
-EXTERN void		TclGetAndDetachPids(Tcl_Interp *interp,
-				Tcl_Channel chan);
-/* 12 */
-EXTERN int		TclpCloseFile(TclFile file);
-/* 13 */
-EXTERN Tcl_Channel	TclpCreateCommandChannel(TclFile readFile,
-				TclFile writeFile, TclFile errorFile,
-				int numPids, Tcl_Pid *pidPtr);
-/* 14 */
-EXTERN int		TclpCreatePipe(TclFile *readPipe, TclFile *writePipe);
-/* 15 */
-EXTERN int		TclpCreateProcess(Tcl_Interp *interp, int argc,
-				const char **argv, TclFile inputFile,
-				TclFile outputFile, TclFile errorFile,
-				Tcl_Pid *pidPtr);
-/* 16 */
-EXTERN int		TclpIsAtty(int fd);
-/* 17 */
-EXTERN int		TclUnixCopyFile(const char *src, const char *dst,
-				const Tcl_StatBuf *statBufPtr,
-				int dontCopyAtts);
-/* 18 */
-EXTERN TclFile		TclpMakeFile(Tcl_Channel channel, int direction);
-/* 19 */
-EXTERN TclFile		TclpOpenFile(const char *fname, int mode);
-/* 20 */
-EXTERN void		TclWinAddProcess(HANDLE hProcess, DWORD id);
-/* 21 */
-EXTERN char *		TclpInetNtoa(struct in_addr addr);
-/* 22 */
-EXTERN TclFile		TclpCreateTempFile(const char *contents);
-/* Slot 23 is reserved */
-/* 24 */
-EXTERN char *		TclWinNoBackslash(char *path);
-/* Slot 25 is reserved */
-/* 26 */
-EXTERN void		TclWinSetInterfaces(int wide);
-/* 27 */
-EXTERN void		TclWinFlushDirtyChannels(void);
-/* 28 */
-EXTERN void		TclWinResetInterfaces(void);
-/* 29 */
-EXTERN int		TclWinCPUID(int index, int *regs);
-/* 30 */
-EXTERN int		TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
-				Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
-				Tcl_Obj *resultingNameObj);
-#endif /* WIN */
-#ifdef MAC_OSX_TCL /* MACOSX */
-/* 0 */
-EXTERN void		TclGetAndDetachPids(Tcl_Interp *interp,
-				Tcl_Channel chan);
-/* 1 */
-EXTERN int		TclpCloseFile(TclFile file);
-/* 2 */
-EXTERN Tcl_Channel	TclpCreateCommandChannel(TclFile readFile,
-				TclFile writeFile, TclFile errorFile,
-				int numPids, Tcl_Pid *pidPtr);
-/* 3 */
-EXTERN int		TclpCreatePipe(TclFile *readPipe, TclFile *writePipe);
-/* 4 */
-EXTERN int		TclpCreateProcess(Tcl_Interp *interp, int argc,
-				const char **argv, TclFile inputFile,
-				TclFile outputFile, TclFile errorFile,
-				Tcl_Pid *pidPtr);
-/* 5 */
-EXTERN int		TclUnixWaitForFile_(int fd, int mask, int timeout);
-/* 6 */
-EXTERN TclFile		TclpMakeFile(Tcl_Channel channel, int direction);
-/* 7 */
-EXTERN TclFile		TclpOpenFile(const char *fname, int mode);
-/* 8 */
-EXTERN int		TclUnixWaitForFile(int fd, int mask, int timeout);
-/* 9 */
-EXTERN TclFile		TclpCreateTempFile(const char *contents);
-/* 10 */
-EXTERN Tcl_DirEntry *	TclpReaddir(TclDIR *dir);
-/* 11 */
-EXTERN struct tm *	TclpLocaltime_unix(const time_t *clock);
-/* 12 */
-EXTERN struct tm *	TclpGmtime_unix(const time_t *clock);
-/* 13 */
-EXTERN char *		TclpInetNtoa(struct in_addr addr);
-/* 14 */
-EXTERN int		TclUnixCopyFile(const char *src, const char *dst,
-				const Tcl_StatBuf *statBufPtr,
-				int dontCopyAtts);
-/* 15 */
-EXTERN int		TclMacOSXGetFileAttribute(Tcl_Interp *interp,
-				int objIndex, Tcl_Obj *fileName,
-				Tcl_Obj **attributePtrPtr);
-/* 16 */
-EXTERN int		TclMacOSXSetFileAttribute(Tcl_Interp *interp,
-				int objIndex, Tcl_Obj *fileName,
-				Tcl_Obj *attributePtr);
-/* 17 */
-EXTERN int		TclMacOSXCopyFileAttributes(const char *src,
-				const char *dst,
-				const Tcl_StatBuf *statBufPtr);
-/* 18 */
-EXTERN int		TclMacOSXMatchType(Tcl_Interp *interp,
-				const char *pathName, const char *fileName,
-				Tcl_StatBuf *statBufPtr,
-				Tcl_GlobTypeData *types);
-/* 19 */
-EXTERN void		TclMacOSXNotifierAddRunLoopMode(
-				const void *runLoopMode);
-/* Slot 20 is reserved */
-/* Slot 21 is reserved */
-/* 22 */
-EXTERN TclFile		TclpCreateTempFile_(const char *contents);
-/* Slot 23 is reserved */
-/* Slot 24 is reserved */
-/* Slot 25 is reserved */
-/* Slot 26 is reserved */
-/* Slot 27 is reserved */
-/* Slot 28 is reserved */
-/* 29 */
-EXTERN int		TclWinCPUID(int index, int *regs);
-/* 30 */
-EXTERN int		TclUnixOpenTemporaryFile(Tcl_Obj *dirObj,
-				Tcl_Obj *basenameObj, Tcl_Obj *extensionObj,
-				Tcl_Obj *resultingNameObj);
-#endif /* MACOSX */
-
-typedef struct TclIntPlatStubs {
-    int magic;
-    void *hooks;
-
-#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
-    void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 0 */
-    int (*tclpCloseFile) (TclFile file); /* 1 */
-    Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 2 */
-    int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 3 */
-    int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 4 */
-    int (*tclUnixWaitForFile_) (int fd, int mask, int timeout); /* 5 */
-    TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 6 */
-    TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */
-    int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */
-    TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */
-    Tcl_DirEntry * (*tclpReaddir) (TclDIR *dir); /* 10 */
-    struct tm * (*tclpLocaltime_unix) (const time_t *clock); /* 11 */
-    struct tm * (*tclpGmtime_unix) (const time_t *clock); /* 12 */
-    char * (*tclpInetNtoa) (struct in_addr addr); /* 13 */
-    int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */
-    int (*tclMacOSXGetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); /* 15 */
-    int (*tclMacOSXSetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr); /* 16 */
-    int (*tclMacOSXCopyFileAttributes) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr); /* 17 */
-    int (*tclMacOSXMatchType) (Tcl_Interp *interp, const char *pathName, const char *fileName, Tcl_StatBuf *statBufPtr, Tcl_GlobTypeData *types); /* 18 */
-    void (*tclMacOSXNotifierAddRunLoopMode) (const void *runLoopMode); /* 19 */
-    void (*reserved20)(void);
-    void (*reserved21)(void);
-    TclFile (*tclpCreateTempFile_) (const char *contents); /* 22 */
-    void (*reserved23)(void);
-    void (*reserved24)(void);
-    void (*reserved25)(void);
-    void (*reserved26)(void);
-    void (*reserved27)(void);
-    void (*reserved28)(void);
-    int (*tclWinCPUID) (int index, int *regs); /* 29 */
-    int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
-#endif /* UNIX */
-#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
-    void (*tclWinConvertError) (DWORD errCode); /* 0 */
-    void (*tclWinConvertWSAError) (DWORD errCode); /* 1 */
-    struct servent * (*tclWinGetServByName) (const char *nm, const char *proto); /* 2 */
-    int (*tclWinGetSockOpt) (SOCKET s, int level, int optname, char *optval, int *optlen); /* 3 */
-    HINSTANCE (*tclWinGetTclInstance) (void); /* 4 */
-    int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 5 */
-    unsigned short (*tclWinNToHS) (unsigned short ns); /* 6 */
-    int (*tclWinSetSockOpt) (SOCKET s, int level, int optname, const char *optval, int optlen); /* 7 */
-    int (*tclpGetPid) (Tcl_Pid pid); /* 8 */
-    int (*tclWinGetPlatformId) (void); /* 9 */
-    void *(*tclpReaddir) (void *dir); /* 10 */
-    void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 11 */
-    int (*tclpCloseFile) (TclFile file); /* 12 */
-    Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 13 */
-    int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 14 */
-    int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 15 */
-    int (*tclpIsAtty) (int fd); /* 16 */
-    int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 17 */
-    TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 18 */
-    TclFile (*tclpOpenFile) (const char *fname, int mode); /* 19 */
-    void (*tclWinAddProcess) (HANDLE hProcess, DWORD id); /* 20 */
-    char * (*tclpInetNtoa) (struct in_addr addr); /* 21 */
-    TclFile (*tclpCreateTempFile) (const char *contents); /* 22 */
-    void (*reserved23)(void);
-    char * (*tclWinNoBackslash) (char *path); /* 24 */
-    void (*reserved25)(void);
-    void (*tclWinSetInterfaces) (int wide); /* 26 */
-    void (*tclWinFlushDirtyChannels) (void); /* 27 */
-    void (*tclWinResetInterfaces) (void); /* 28 */
-    int (*tclWinCPUID) (int index, int *regs); /* 29 */
-    int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
-#endif /* WIN */
-#ifdef MAC_OSX_TCL /* MACOSX */
-    void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 0 */
-    int (*tclpCloseFile) (TclFile file); /* 1 */
-    Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 2 */
-    int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 3 */
-    int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 4 */
-    int (*tclUnixWaitForFile_) (int fd, int mask, int timeout); /* 5 */
-    TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 6 */
-    TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */
-    int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */
-    TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */
-    Tcl_DirEntry * (*tclpReaddir) (TclDIR *dir); /* 10 */
-    struct tm * (*tclpLocaltime_unix) (const time_t *clock); /* 11 */
-    struct tm * (*tclpGmtime_unix) (const time_t *clock); /* 12 */
-    char * (*tclpInetNtoa) (struct in_addr addr); /* 13 */
-    int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */
-    int (*tclMacOSXGetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); /* 15 */
-    int (*tclMacOSXSetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr); /* 16 */
-    int (*tclMacOSXCopyFileAttributes) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr); /* 17 */
-    int (*tclMacOSXMatchType) (Tcl_Interp *interp, const char *pathName, const char *fileName, Tcl_StatBuf *statBufPtr, Tcl_GlobTypeData *types); /* 18 */
-    void (*tclMacOSXNotifierAddRunLoopMode) (const void *runLoopMode); /* 19 */
-    void (*reserved20)(void);
-    void (*reserved21)(void);
-    TclFile (*tclpCreateTempFile_) (const char *contents); /* 22 */
-    void (*reserved23)(void);
-    void (*reserved24)(void);
-    void (*reserved25)(void);
-    void (*reserved26)(void);
-    void (*reserved27)(void);
-    void (*reserved28)(void);
-    int (*tclWinCPUID) (int index, int *regs); /* 29 */
-    int (*tclUnixOpenTemporaryFile) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj, Tcl_Obj *extensionObj, Tcl_Obj *resultingNameObj); /* 30 */
-#endif /* MACOSX */
-} TclIntPlatStubs;
-
-extern const TclIntPlatStubs *tclIntPlatStubsPtr;
-
-#ifdef __cplusplus
-}
-#endif
-
-#if defined(USE_TCL_STUBS)
-
-/*
- * Inline function declarations:
- */
-
-#if !defined(_WIN32) && !defined(__CYGWIN__) && !defined(MAC_OSX_TCL) /* UNIX */
-#define TclGetAndDetachPids \
-	(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 0 */
-#define TclpCloseFile \
-	(tclIntPlatStubsPtr->tclpCloseFile) /* 1 */
-#define TclpCreateCommandChannel \
-	(tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 2 */
-#define TclpCreatePipe \
-	(tclIntPlatStubsPtr->tclpCreatePipe) /* 3 */
-#define TclpCreateProcess \
-	(tclIntPlatStubsPtr->tclpCreateProcess) /* 4 */
-#define TclUnixWaitForFile_ \
-	(tclIntPlatStubsPtr->tclUnixWaitForFile_) /* 5 */
-#define TclpMakeFile \
-	(tclIntPlatStubsPtr->tclpMakeFile) /* 6 */
-#define TclpOpenFile \
-	(tclIntPlatStubsPtr->tclpOpenFile) /* 7 */
-#define TclUnixWaitForFile \
-	(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */
-#define TclpCreateTempFile \
-	(tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */
-#define TclpReaddir \
-	(tclIntPlatStubsPtr->tclpReaddir) /* 10 */
-#define TclpLocaltime_unix \
-	(tclIntPlatStubsPtr->tclpLocaltime_unix) /* 11 */
-#define TclpGmtime_unix \
-	(tclIntPlatStubsPtr->tclpGmtime_unix) /* 12 */
-#define TclpInetNtoa \
-	(tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */
-#define TclUnixCopyFile \
-	(tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */
-#define TclMacOSXGetFileAttribute \
-	(tclIntPlatStubsPtr->tclMacOSXGetFileAttribute) /* 15 */
-#define TclMacOSXSetFileAttribute \
-	(tclIntPlatStubsPtr->tclMacOSXSetFileAttribute) /* 16 */
-#define TclMacOSXCopyFileAttributes \
-	(tclIntPlatStubsPtr->tclMacOSXCopyFileAttributes) /* 17 */
-#define TclMacOSXMatchType \
-	(tclIntPlatStubsPtr->tclMacOSXMatchType) /* 18 */
-#define TclMacOSXNotifierAddRunLoopMode \
-	(tclIntPlatStubsPtr->tclMacOSXNotifierAddRunLoopMode) /* 19 */
-/* Slot 20 is reserved */
-/* Slot 21 is reserved */
-#define TclpCreateTempFile_ \
-	(tclIntPlatStubsPtr->tclpCreateTempFile_) /* 22 */
-/* Slot 23 is reserved */
-/* Slot 24 is reserved */
-/* Slot 25 is reserved */
-/* Slot 26 is reserved */
-/* Slot 27 is reserved */
-/* Slot 28 is reserved */
-#define TclWinCPUID \
-	(tclIntPlatStubsPtr->tclWinCPUID) /* 29 */
-#define TclUnixOpenTemporaryFile \
-	(tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */
-#endif /* UNIX */
-#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
-#define TclWinConvertError \
-	(tclIntPlatStubsPtr->tclWinConvertError) /* 0 */
-#define TclWinConvertWSAError \
-	(tclIntPlatStubsPtr->tclWinConvertWSAError) /* 1 */
-#define TclWinGetServByName \
-	(tclIntPlatStubsPtr->tclWinGetServByName) /* 2 */
-#define TclWinGetSockOpt \
-	(tclIntPlatStubsPtr->tclWinGetSockOpt) /* 3 */
-#define TclWinGetTclInstance \
-	(tclIntPlatStubsPtr->tclWinGetTclInstance) /* 4 */
-#define TclUnixWaitForFile \
-	(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 5 */
-#define TclWinNToHS \
-	(tclIntPlatStubsPtr->tclWinNToHS) /* 6 */
-#define TclWinSetSockOpt \
-	(tclIntPlatStubsPtr->tclWinSetSockOpt) /* 7 */
-#define TclpGetPid \
-	(tclIntPlatStubsPtr->tclpGetPid) /* 8 */
-#define TclWinGetPlatformId \
-	(tclIntPlatStubsPtr->tclWinGetPlatformId) /* 9 */
-#define TclGetAndDetachPids \
-	(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 11 */
-#define TclpCloseFile \
-	(tclIntPlatStubsPtr->tclpCloseFile) /* 12 */
-#define TclpCreateCommandChannel \
-	(tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 13 */
-#define TclpCreatePipe \
-	(tclIntPlatStubsPtr->tclpCreatePipe) /* 14 */
-#define TclpCreateProcess \
-	(tclIntPlatStubsPtr->tclpCreateProcess) /* 15 */
-#define TclpIsAtty \
-	(tclIntPlatStubsPtr->tclpIsAtty) /* 16 */
-#define TclUnixCopyFile \
-	(tclIntPlatStubsPtr->tclUnixCopyFile) /* 17 */
-#define TclpMakeFile \
-	(tclIntPlatStubsPtr->tclpMakeFile) /* 18 */
-#define TclpOpenFile \
-	(tclIntPlatStubsPtr->tclpOpenFile) /* 19 */
-#define TclWinAddProcess \
-	(tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */
-#define TclpInetNtoa \
-	(tclIntPlatStubsPtr->tclpInetNtoa) /* 21 */
-#define TclpCreateTempFile \
-	(tclIntPlatStubsPtr->tclpCreateTempFile) /* 22 */
-/* Slot 23 is reserved */
-#define TclWinNoBackslash \
-	(tclIntPlatStubsPtr->tclWinNoBackslash) /* 24 */
-/* Slot 25 is reserved */
-#define TclWinSetInterfaces \
-	(tclIntPlatStubsPtr->tclWinSetInterfaces) /* 26 */
-#define TclWinFlushDirtyChannels \
-	(tclIntPlatStubsPtr->tclWinFlushDirtyChannels) /* 27 */
-#define TclWinResetInterfaces \
-	(tclIntPlatStubsPtr->tclWinResetInterfaces) /* 28 */
-#define TclWinCPUID \
-	(tclIntPlatStubsPtr->tclWinCPUID) /* 29 */
-#define TclUnixOpenTemporaryFile \
-	(tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */
-#endif /* WIN */
-#ifdef MAC_OSX_TCL /* MACOSX */
-#define TclGetAndDetachPids \
-	(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 0 */
-#define TclpCloseFile \
-	(tclIntPlatStubsPtr->tclpCloseFile) /* 1 */
-#define TclpCreateCommandChannel \
-	(tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 2 */
-#define TclpCreatePipe \
-	(tclIntPlatStubsPtr->tclpCreatePipe) /* 3 */
-#define TclpCreateProcess \
-	(tclIntPlatStubsPtr->tclpCreateProcess) /* 4 */
-#define TclUnixWaitForFile_ \
-	(tclIntPlatStubsPtr->tclUnixWaitForFile_) /* 5 */
-#define TclpMakeFile \
-	(tclIntPlatStubsPtr->tclpMakeFile) /* 6 */
-#define TclpOpenFile \
-	(tclIntPlatStubsPtr->tclpOpenFile) /* 7 */
-#define TclUnixWaitForFile \
-	(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */
-#define TclpCreateTempFile \
-	(tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */
-#define TclpReaddir \
-	(tclIntPlatStubsPtr->tclpReaddir) /* 10 */
-#define TclpLocaltime_unix \
-	(tclIntPlatStubsPtr->tclpLocaltime_unix) /* 11 */
-#define TclpGmtime_unix \
-	(tclIntPlatStubsPtr->tclpGmtime_unix) /* 12 */
-#define TclpInetNtoa \
-	(tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */
-#define TclUnixCopyFile \
-	(tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */
-#define TclMacOSXGetFileAttribute \
-	(tclIntPlatStubsPtr->tclMacOSXGetFileAttribute) /* 15 */
-#define TclMacOSXSetFileAttribute \
-	(tclIntPlatStubsPtr->tclMacOSXSetFileAttribute) /* 16 */
-#define TclMacOSXCopyFileAttributes \
-	(tclIntPlatStubsPtr->tclMacOSXCopyFileAttributes) /* 17 */
-#define TclMacOSXMatchType \
-	(tclIntPlatStubsPtr->tclMacOSXMatchType) /* 18 */
-#define TclMacOSXNotifierAddRunLoopMode \
-	(tclIntPlatStubsPtr->tclMacOSXNotifierAddRunLoopMode) /* 19 */
-/* Slot 20 is reserved */
-/* Slot 21 is reserved */
-#define TclpCreateTempFile_ \
-	(tclIntPlatStubsPtr->tclpCreateTempFile_) /* 22 */
-/* Slot 23 is reserved */
-/* Slot 24 is reserved */
-/* Slot 25 is reserved */
-/* Slot 26 is reserved */
-/* Slot 27 is reserved */
-/* Slot 28 is reserved */
-#define TclWinCPUID \
-	(tclIntPlatStubsPtr->tclWinCPUID) /* 29 */
-#define TclUnixOpenTemporaryFile \
-	(tclIntPlatStubsPtr->tclUnixOpenTemporaryFile) /* 30 */
-#endif /* MACOSX */
-
-#endif /* defined(USE_TCL_STUBS) */
-
-#else /* TCL_MAJOR_VERSION > 8 */
 /* !BEGIN!: Do not edit below this line. */
 
 #ifdef __cplusplus
@@ -731,7 +202,6 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
 #endif /* defined(USE_TCL_STUBS) */
 
 /* !END!: Do not edit above this line. */
-#endif /* TCL_MAJOR_VERSION */
 
 #undef TCL_STORAGE_CLASS
 #define TCL_STORAGE_CLASS DLLIMPORT
@@ -739,10 +209,6 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
 #undef TclpGmtime_unix
 #undef TclWinConvertWSAError
 #define TclWinConvertWSAError TclWinConvertError
-#if !defined(TCL_USE_STUBS) && !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
-#   undef TclWinConvertError
-#   define TclWinConvertError Tcl_WinConvertError
-#endif
 
 #undef TclpInetNtoa
 #define TclpInetNtoa inet_ntoa
@@ -782,15 +248,6 @@ MODULE_SCOPE int TclMacOSXMatchType(Tcl_Interp *interp,
 #   undef TclWinGetPlatformId
 #   undef TclWinResetInterfaces
 #   undef TclWinSetInterfaces
-#   if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
-#	define TclWinNToHS ntohs
-#	define TclWinGetServByName getservbyname
-#	define TclWinGetSockOpt getsockopt
-#	define TclWinSetSockOpt setsockopt
-#	define TclWinGetPlatformId() (2) /* VER_PLATFORM_WIN32_NT */
-#	define TclWinResetInterfaces() /* nop */
-#	define TclWinSetInterfaces(dummy) /* nop */
-#   endif /* TCL_NO_DEPRECATED */
 #else
 #   undef TclpGetPid
 #   define TclpGetPid(pid) ((size_t)(pid))

generic/tclInterp.c

@@ -624,9 +624,7 @@ NRInterpCmd(
 	"hidden",	"issafe",	"invokehidden",
 	"limit",	"marktrusted",	"recursionlimit",
 	"share",
-#ifndef TCL_NO_DEPRECATED
 	"slaves",
-#endif
 	"target",	"transfer",	NULL
     };
     static const char *const optionsNoSlaves[] = {
@@ -644,9 +642,7 @@ NRInterpCmd(
 	OPT_EVAL,	OPT_EXISTS,	OPT_EXPOSE,	OPT_HIDE,
 	OPT_HIDDEN,	OPT_ISSAFE,	OPT_INVOKEHID,
 	OPT_LIMIT,	OPT_MARKTRUSTED, OPT_RECLIMIT, OPT_SHARE,
-#ifndef TCL_NO_DEPRECATED
 	OPT_SLAVES,
-#endif
 	OPT_TARGET,	OPT_TRANSFER
     } index;
 
@@ -1033,9 +1029,7 @@ NRInterpCmd(
 	    return TCL_ERROR;
 	}
 	return ChildRecursionLimit(interp, childInterp, objc - 3, objv + 3);
-#ifndef TCL_NO_DEPRECATED
     case OPT_SLAVES:
-#endif
     case OPT_CHILDREN: {
 	InterpInfo *iiPtr;
 	Tcl_Obj *resultPtr;

generic/tclLink.c

@@ -179,14 +179,6 @@ Tcl_LinkVar(
     Tcl_IncrRefCount(linkPtr->varName);
     linkPtr->addr = addr;
     linkPtr->type = type & ~TCL_LINK_READ_ONLY;
-#if !defined(TCL_NO_DEPRECATED) && (defined(TCL_WIDE_INT_IS_LONG) \
-	|| defined(_WIN32) || defined(__CYGWIN__))
-    if (linkPtr->type == 11 /* legacy TCL_LINK_LONG */) {
-	linkPtr->type = TCL_LINK_LONG;
-    } else if (linkPtr->type == 12 /* legacy TCL_LINK_ULONG */) {
-	linkPtr->type = TCL_LINK_ULONG;
-    }
-#endif
     if (type & TCL_LINK_READ_ONLY) {
 	linkPtr->flags = LINK_READ_ONLY;
     } else {
@@ -262,14 +254,6 @@ Tcl_LinkArray(
 
     linkPtr = (Link *)Tcl_Alloc(sizeof(Link));
     linkPtr->type = type & ~TCL_LINK_READ_ONLY;
-#if !defined(TCL_NO_DEPRECATED) && (defined(TCL_WIDE_INT_IS_LONG) \
-	|| defined(_WIN32) || defined(__CYGWIN__))
-    if (linkPtr->type == 11 /* legacy TCL_LINK_LONG */) {
-	linkPtr->type = TCL_LINK_LONG;
-    } else if (linkPtr->type == 12 /* legacy TCL_LINK_ULONG */) {
-	linkPtr->type = TCL_LINK_ULONG;
-    }
-#endif
     linkPtr->numElems = size;
     if (type & TCL_LINK_READ_ONLY) {
 	linkPtr->flags = LINK_READ_ONLY;
@@ -547,7 +531,7 @@ GetDouble(
 	return 0;
     } else {
 #ifdef ACCEPT_NAN
-	Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objPtr, &tclDoubleType.objType);
+	Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objPtr, tclDoubleType);
 
 	if (irPtr != NULL) {
 	    *dblPtr = irPtr->doubleValue;

generic/tclListObj.c

@@ -4,6 +4,7 @@
  *	This file contains functions that implement the Tcl list object type.
  *
  * Copyright © 2022 Ashok P. Nadkarni.  All rights reserved.
+ * Copyright © 2021 Nathan Coulter.  All rights reserved.
  *
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -12,7 +13,6 @@
 #include <assert.h>
 #include "tclInt.h"
 #include "tclTomMath.h"
-#include "tclArithSeries.h"
 
 /*
  * TODO - memmove is fast. Measure at what size we should prefer memmove
@@ -69,7 +69,7 @@
 
 /* Checks for when caller should have already converted to internal list type */
 #define LIST_ASSERT_TYPE(listObj_) \
-    LIST_ASSERT(TclHasInternalRep((listObj_), &tclListType.objType))
+    LIST_ASSERT(TclHasInternalRep((listObj_), tclListType))
 
 /*
  * If ENABLE_LIST_INVARIANTS is enabled (-DENABLE_LIST_INVARIANTS from the
@@ -142,7 +142,17 @@ static void	DupListInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
 static void	FreeListInternalRep(Tcl_Obj *listPtr);
 static int	SetListFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
 static void	UpdateStringOfList(Tcl_Obj *listPtr);
-static Tcl_Size ListLength(Tcl_Obj *listPtr);
+static int		ListObjAppendElement(Tcl_Interp *interp,
+			    Tcl_Obj *listPtr, Tcl_Obj *objPtr);
+static int		ListObjAppendList(Tcl_Interp *interp,
+			    Tcl_Obj *listPtr, Tcl_Obj *elemListPtr);
+static int		ListObjIndex(tclObjTypeInterfaceArgsListIndex);
+static int		ListObjInterfaceGetElements(tclObjTypeInterfaceArgsListAll);
+static int		ListObjInterfaceLength(tclObjTypeInterfaceArgsListLength);
+static int		ListObjSetElement(tclObjTypeInterfaceArgsListSet);
+static Tcl_Obj *	LsetFlat(tclObjTypeInterfaceArgsListSetList);
+static Tcl_Obj *	ListObjRange(tclObjTypeInterfaceArgsListRange);
+static int		ListObjReplace(tclObjTypeInterfaceArgsListReplace);
 
 /*
  * The structure below defines the list Tcl object type by means of functions
@@ -151,18 +161,65 @@ static Tcl_Size ListLength(Tcl_Obj *listPtr);
  * The internal representation of a list object is ListRep defined in tcl.h.
  */
 
-const TclObjTypeWithAbstractList tclListType = {
-    {"list",			/* name */
+ObjInterface tclListInterface = {
+    1,
+    {},
+    {
+	&ListObjInterfaceGetElements,
+	&ListObjAppendElement,
+	&ListObjAppendList,
+	&ListObjIndex,
+	NULL,
+	NULL,
+	&ListObjInterfaceLength,
+	&ListObjRange,
+	NULL,
+	&ListObjReplace,
+	NULL, /* replaceList */
+	NULL, /* reverse */
+	&ListObjSetElement,
+	&LsetFlat
+    },
+};
+
+
+const ObjectType tclListObjType = {
+    "list",
     FreeListInternalRep,	/* freeIntRepProc */
     DupListInternalRep,		/* dupIntRepProc */
     UpdateStringOfList,		/* updateStringProc */
-    SetListFromAny,		/* setFromAnyProc */
-    TCL_OBJTYPE_V0_1(
-    ListLength
-    )}
+    SetListFromAny,	/* setFromAnyProc */
+    2,
+    (Tcl_ObjInterface *)&tclListInterface
 };
 
+MODULE_SCOPE const Tcl_ObjType *tclListType = (Tcl_ObjType *)&tclListObjType;
+
 /* Macros to manipulate the List internal rep */
+
+#define ListSetIntRep(objPtr, listRepPtr)				\
+    do {								\
+	Tcl_ObjInternalRep ir;						\
+	ir.twoPtrValue.ptr1 = (listRepPtr);				\
+	ir.twoPtrValue.ptr2 = NULL;					\
+	(listRepPtr)->refCount++;					\
+	Tcl_StoreInternalRep((objPtr), tclListType, &ir);			\
+    } while (0)
+
+#define ListGetIntRep(objPtr, listRepPtr)				\
+    do {								\
+	const Tcl_ObjInternalRep *irPtr;					\
+	irPtr = TclFetchInternalRep((objPtr), tclListType);		\
+	(listRepPtr) = irPtr ? (List *)irPtr->twoPtrValue.ptr1 : NULL;		\
+    } while (0)
+
+#define ListResetIntRep(objPtr, listRepPtr) \
+    TclFetchInternalRep((objPtr), tclListType)->twoPtrValue.ptr1 = (listRepPtr)
+
+#ifndef TCL_MIN_ELEMENT_GROWTH
+#define TCL_MIN_ELEMENT_GROWTH TCL_MIN_GROWTH/sizeof(Tcl_Obj *)
+#endif
+
 #define ListRepIncrRefs(repPtr_)            \
     do {                                    \
 	(repPtr_)->storePtr->refCount++;    \
@@ -205,7 +262,7 @@ const TclObjTypeWithAbstractList tclListType = {
     do {                                                               \
 	(objPtr_)->internalRep.twoPtrValue.ptr1 = (repPtr_)->storePtr; \
 	(objPtr_)->internalRep.twoPtrValue.ptr2 = (repPtr_)->spanPtr;  \
-	(objPtr_)->typePtr = &tclListType.objType;                             \
+	(objPtr_)->typePtr = tclListType;                             \
     } while (0)
 
 #define ListObjOverwriteRep(objPtr_, repPtr_) \
@@ -1251,7 +1308,7 @@ TclListObjGetRep(
 			 * to be returned. */
     ListRep *repPtr) /* Location to store descriptor */
 {
-    if (!TclHasInternalRep(listObj, &tclListType.objType)) {
+    if (!TclHasInternalRep(listObj, tclListType)) {
 	int result;
 	result = SetListFromAny(interp, listObj);
 	if (result != TCL_OK) {
@@ -1529,13 +1586,39 @@ ListRepRange(
  *
  *----------------------------------------------------------------------
  */
-
 Tcl_Obj *
 TclListObjRange(
-    Tcl_Interp *interp,		/* May be NULL. Used for error messages */
-    Tcl_Obj *listObj,		/* List object to take a range from. */
-    Tcl_Size rangeStart,	/* Index of first element to include. */
-    Tcl_Size rangeEnd)		/* Index of last element to include. */
+    Tcl_Interp *interp,
+    Tcl_Obj *listPtr,		/* List object to take a range from. */
+    Tcl_Size fromIdx,		/* Index of first element to include. */
+    Tcl_Size toIdx)			/* Index of last element to include. */
+{
+    int status;
+    Tcl_Size length;
+    status = TclListObjLengthM(interp, listPtr, &length);
+    if (status != TCL_OK) {
+	return NULL;
+    }
+    if (fromIdx == TCL_INDEX_NONE) {
+	fromIdx = 0;
+    }
+    if (Tcl_LengthIsFinite(length) && toIdx + 1 >= length + 1) {
+	toIdx = length-1;
+    }
+
+    if (fromIdx + 1 > toIdx + 1) {
+	Tcl_Obj *obj;
+	TclNewObj(obj);
+	return obj;
+    }
+    return TclObjectDispatch(listPtr, ListObjRange, list
+	, range, interp, listPtr, fromIdx, toIdx);
+}
+
+
+Tcl_Obj *
+ListObjRange(
+    tclObjTypeInterfaceArgsListRange)
 {
     ListRep listRep;
     ListRep resultRep;
@@ -1608,25 +1691,49 @@ TclListObjGetElement(
  *
  *----------------------------------------------------------------------
  */
-
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ListObjGetElements --
+ *
+ *	Returns an (objc,objv) array of the elements in a list
+ *	object.
+ *
+ * Results:
+ *	The return value is normally TCL_OK; in this case *objcPtr is set to
+ *	the count of list elements and *objvPtr is set to a pointer to an
+ *	array of (*objcPtr) pointers to each list element. If listPtr does not
+ *	refer to a list object and the object can not be converted to one,
+ *	TCL_ERROR is returned and an error message will be left in the
+ *	interpreter's result if interp is not NULL.
+ *
+ *	The objects referenced by the returned array should be treated as
+ *	readonly and their ref counts are _not_ incremented; the caller must
+ *	do that if it holds on to a reference. Furthermore, the pointer and
+ *	length returned by this function may change as soon as any function is
+ *	called on the list object; be careful about retaining the pointer in a
+ *	local data structure.
+ *
+ * Side effects:
+ *	The possible conversion of the object referenced by listPtr
+ *	to a list object.
+ *
+ *----------------------------------------------------------------------
+ */
 #undef Tcl_ListObjGetElements
 int
-Tcl_ListObjGetElements(
-    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
-    Tcl_Obj *objPtr,		/* List object for which an element array is
-				 * to be returned. */
-    Tcl_Size *objcPtr,		/* Where to store the count of objects
-				 * referenced by objv. */
-    Tcl_Obj ***objvPtr)		/* Where to store the pointer to an array of
-				 * pointers to the list's objects. */
+Tcl_ListObjGetElements(tclObjTypeInterfaceArgsListAll)
+{
+    return TclObjectDispatch(listPtr, ListObjInterfaceGetElements,
+	list, all, interp, listPtr, objcPtr, objvPtr);
+}
+
+int
+ListObjInterfaceGetElements(tclObjTypeInterfaceArgsListAll)
 {
     ListRep listRep;
 
-    if (TclHasInternalRep(objPtr,&tclArithSeriesType.objType)) {
-	return TclArithSeriesGetElements(interp, objPtr, objcPtr, objvPtr);
-    }
-
-    if (TclListObjGetRep(interp, objPtr, &listRep) != TCL_OK)
+    if (TclListObjGetRep(interp, listPtr, &listRep) != TCL_OK)
 	return TCL_ERROR;
     ListRepElements(&listRep, *objcPtr, *objvPtr);
     return TCL_OK;
@@ -1655,28 +1762,47 @@ Tcl_ListObjGetElements(
  *----------------------------------------------------------------------
  */
 int
-Tcl_ListObjAppendList(
-    Tcl_Interp *interp,		/* Used to report errors if not NULL. */
-    Tcl_Obj *toObj,		/* List object to append elements to. */
-    Tcl_Obj *fromObj)		/* List obj with elements to append. */
+Tcl_ListObjAppendList(tclObjTypeInterfaceArgsListAppendList)
 {
-    Tcl_Size objc;
-    Tcl_Obj **objv;
+    return TclObjectDispatch(listPtr, ListObjAppendList,
+	list, appendlist, interp, listPtr, elemListPtr);
+}
 
-    if (Tcl_IsShared(toObj)) {
+int
+ListObjAppendList(tclObjTypeInterfaceArgsListAppendList)
+{
+    int status;
+    if (Tcl_IsShared(listPtr)) {
 	Tcl_Panic("%s called with shared object", "Tcl_ListObjAppendList");
     }
 
-    if (TclListObjGetElementsM(interp, fromObj, &objc, &objv) != TCL_OK) {
-	return TCL_ERROR;
+    if (TclObjectHasInterface(listPtr, list, replaceList)) {
+	TclObjectDispatchNoDefault(interp, status, listPtr, list,
+	    replaceList, interp, listPtr, LIST_MAX, 0, elemListPtr);
+	return status;
+    } else {
+	Tcl_Size objc;
+	Tcl_ListObjLength(interp, elemListPtr, &objc);
+	if (objc == 1) {
+	    Tcl_Obj *itemObj;
+	    status = Tcl_ListObjIndex(interp, elemListPtr, 0, &itemObj);
+	    if (status != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    status = Tcl_ListObjAppendElement(interp, listPtr, itemObj);
+	    return status;
+	} else {
+	    Tcl_Obj **objv;
+	    /*
+	     * Pull the elements to append from elemListPtr.
+	     */
+
+	    if (TCL_OK != TclListObjGetElementsM(interp, elemListPtr, &objc, &objv)) {
+		return TCL_ERROR;
+	    }
+	    return TclListObjAppendElements(interp, listPtr, objc, objv);
+	}
     }
-
-    /*
-     * Insert the new elements starting after the lists's last element.
-     * Delete zero existing elements.
-     */
-
-    return TclListObjAppendElements(interp, toObj, objc, objv);
 }
 
 /*
@@ -1858,6 +1984,20 @@ Tcl_ListObjAppendList(
  */
 int
 Tcl_ListObjAppendElement(
+    Tcl_Interp *interp,
+    Tcl_Obj *listPtr,
+    Tcl_Obj *objPtr)
+{
+    if (Tcl_IsShared(listPtr)) {
+	Tcl_Panic("%s called with shared object", "Tcl_ListObjAppendElement");
+    }
+
+    return TclObjectDispatch(listPtr, ListObjAppendElement,
+	list, append, interp, listPtr, objPtr);
+}
+
+int
+ListObjAppendElement(
     Tcl_Interp *interp,		/* Used to report errors if not NULL. */
     Tcl_Obj *toObj,		/* List object to append elemObj to. */
     Tcl_Obj *elemObj)		/* Object to append to toObj's list. */
@@ -1900,21 +2040,25 @@ Tcl_ListObjAppendElement(
  */
 int
 Tcl_ListObjIndex(
-    Tcl_Interp *interp,  /* Used to report errors if not NULL. */
-    Tcl_Obj *listObj,    /* List object to index into. */
-    Tcl_Size index,      /* Index of element to return. */
-    Tcl_Obj **objPtrPtr) /* The resulting Tcl_Obj* is stored here. */
+    tclObjTypeInterfaceArgsListIndex
+)
 {
+    return TclObjectDispatch(listPtr, ListObjIndex,
+	list, index, interp, listPtr, index, objPtrPtr);
+}
+
+int
+ListObjIndex(tclObjTypeInterfaceArgsListIndex) {
     Tcl_Obj **elemObjs;
     Tcl_Size numElems;
 
     /* Empty string => empty list. Avoid unnecessary shimmering */
-    if (listObj->bytes == &tclEmptyString) {
+    if (listPtr->bytes == &tclEmptyString) {
 	*objPtrPtr = NULL;
 	return TCL_OK;
     }
 
-    if (TclListObjGetElementsM(interp, listObj, &numElems, &elemObjs)
+    if (TclListObjGetElementsM(interp, listPtr, &numElems, &elemObjs)
 	!= TCL_OK) {
 	return TCL_ERROR;
     }
@@ -1948,44 +2092,24 @@ Tcl_ListObjIndex(
  *
  *----------------------------------------------------------------------
  */
-
 #undef Tcl_ListObjLength
 int
-Tcl_ListObjLength(
-    Tcl_Interp *interp,	/* Used to report errors if not NULL. */
-    Tcl_Obj *listObj,	/* List object whose #elements to return. */
-    Tcl_Size *lenPtr)	/* The resulting length is stored here. */
+Tcl_ListObjLength(tclObjTypeInterfaceArgsListLength)
 {
+    return TclObjectDispatch(listPtr, ListObjInterfaceLength,
+	list, length, interp, listPtr, lenPtr);
+}
+
+int
+ListObjInterfaceLength(tclObjTypeInterfaceArgsListLength) {
     ListRep listRep;
 
-    /* Empty string => empty list. Avoid unnecessary shimmering */
-    if (listObj->bytes == &tclEmptyString) {
-	*lenPtr = 0;
-	return TCL_OK;
-    }
-
-    Tcl_Size (*lengthProc)(Tcl_Obj *obj) =  ABSTRACTLIST_PROC(listObj, lengthProc);
-    if (lengthProc) {
-	*lenPtr = lengthProc(listObj);
-	return TCL_OK;
-    }
-
-
-    if (TclListObjGetRep(interp, listObj, &listRep) != TCL_OK) {
+    if (TclListObjGetRep(interp, listPtr, &listRep) != TCL_OK) {
 	return TCL_ERROR;
     }
     *lenPtr = ListRepLength(&listRep);
     return TCL_OK;
 }
-
-Tcl_Size
-ListLength(Tcl_Obj *listPtr)
-{
-    ListRep listRep;
-    ListObjGetRep(listPtr, &listRep);
-
-    return ListRepLength(&listRep);
-}
 
 /*
  *----------------------------------------------------------------------
@@ -2025,13 +2149,57 @@ ListLength(Tcl_Obj *listPtr)
  *----------------------------------------------------------------------
  */
 int
-Tcl_ListObjReplace(
-    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
-    Tcl_Obj *listObj,		/* List object whose elements to replace. */
-    Tcl_Size first,		/* Index of first element to replace. */
-    Tcl_Size numToDelete,	/* Number of elements to replace. */
-    Tcl_Size numToInsert,	/* Number of objects to insert. */
-    Tcl_Obj *const insertObjs[])/* Tcl objects to insert */
+Tcl_ListObjReplace(tclObjTypeInterfaceArgsListReplace)
+{
+    Tcl_Size length, status;
+    if (Tcl_IsShared(listObj)) {
+	Tcl_Panic("%s called with shared object", "Tcl_ListObjReplace");
+    }
+
+    if (first < 0) {
+	first = 0;
+    }
+
+    status = Tcl_ListObjLength(interp, listObj, &length);
+    if (status != TCL_OK) {
+	return status;
+    }
+
+    /* go through the process even in this case to ensure that the result is a
+     * cononical list 
+    *if (length == 0 && numToInsert == 0) {
+    *    return TCL_OK;
+    *}
+    */
+
+    if (first >= length) {
+	first = length;	/* So we'll insert after last element. */
+    }
+
+    if (numToDelete < 0) {
+	numToDelete = 0;
+    } else if (first > INT_MAX - numToDelete /* Handle integer overflow */
+	    || length < first+numToDelete) {
+	numToDelete = length - first;
+    }
+
+    if (numToDelete > LIST_MAX - (length - numToDelete)) {
+	if (interp != NULL) {
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "max length of a Tcl list (%" TCL_Z_MODIFIER
+			"u elements) exceeded", LIST_MAX));
+	}
+	return TCL_ERROR;
+    }
+
+
+    return TclObjectDispatch(listObj, ListObjReplace,
+	list, replace, interp, listObj, first, numToDelete, numToInsert, insertObjs);
+}
+
+
+int
+ListObjReplace(tclObjTypeInterfaceArgsListReplace)
 {
     ListRep listRep;
     Tcl_Size origListLen;
@@ -2490,7 +2658,7 @@ Tcl_ListObjReplace(
  *
  * TclLindexList --
  *
- *	This procedure handles the 'lindex' command when objc==3.
+ *	Handles the 'lindex' command when objc==3.
  *
  * Results:
  *	Returns a pointer to the object extracted, or NULL if an error
@@ -2527,7 +2695,7 @@ TclLindexList(
      * shimmering; if internal rep is already a list do not shimmer it.
      * see TIP#22 and TIP#33 for the details.
      */
-    if (!TclHasInternalRep(argObj, &tclListType.objType)
+    if (!TclHasInternalRep(argObj, tclListType)
 	&& TclGetIntForIndexM(NULL, argObj, TCL_SIZE_MAX - 1, &index)
 	       == TCL_OK) {
 	/*
@@ -2548,7 +2716,7 @@ TclLindexList(
      * does not.
      */
 
-    indexListCopy = TclDuplicatePureObj(interp, argObj, &tclListType.objType);
+    indexListCopy = TclDuplicatePureObj(interp, argObj, tclListType);
     if (!indexListCopy) {
 	/*
 	 * The argument is neither an index nor a well-formed list.
@@ -2609,28 +2777,6 @@ TclLindexFlat(
     int status;
     Tcl_Size i;
 
-    /* Handle ArithSeries as special case */
-    if (TclHasInternalRep(listObj,&tclArithSeriesType.objType)) {
-	Tcl_Size listLen = ABSTRACTLIST_PROC(listObj, lengthProc)(listObj);
-	Tcl_Size index;
-	Tcl_Obj *elemObj = NULL;
-	for (i=0 ; i<indexCount && listObj ; i++) {
-	    if (TclGetIntForIndexM(interp, indexArray[i], /*endValue*/ listLen-1,
-				   &index) == TCL_OK) {
-	    }
-	    if (i==0) {
-		elemObj = TclArithSeriesObjIndex(NULL, listObj, index);
-	    } else if (index > 0) {
-		/* ArithSeries cannot be a list of lists */
-		Tcl_DecrRefCount(elemObj);
-		TclNewObj(elemObj);
-		break;
-	    }
-	}
-	Tcl_IncrRefCount(elemObj);
-	return elemObj;
-    }
-
     Tcl_IncrRefCount(listObj);
 
     for (i=0 ; i<indexCount && listObj ; i++) {
@@ -2663,29 +2809,56 @@ TclLindexFlat(
 		TclNewObj(listObj);
 		Tcl_IncrRefCount(listObj);
 	    } else {
-		Tcl_Obj *itemObj;
-		/*
-		 * Must set the internal rep again because it may have been
-		 * changed by TclGetIntForIndexM. See test lindex-8.4.
-		 */
-		if (!TclHasInternalRep(listObj, &tclListType.objType)) {
-		    status = SetListFromAny(interp, listObj);
-		    if (status != TCL_OK) {
-			/* The list is not a list at all => error.  */
+		Tcl_Obj* listItem;
+		if (TclIndexIsFromEnd(index)
+		    && TclObjectHasInterface(listObj, list, indexEnd)
+		    && Tcl_LengthIsFinite(listLen)
+		    ) {
+
+		    TclObjectDispatchNoDefault(interp, status, listObj,
+			list, indexEnd, interp, listObj, index, &listItem);
+		    if (status == TCL_OK) {
+			Tcl_IncrRefCount(listItem);
+			Tcl_DecrRefCount(listObj);
+			listObj = listItem;
+		    } else {
 			Tcl_DecrRefCount(listObj);
 			return NULL;
 		    }
-		}
+		} else if (TclObjectHasInterface(listObj, list, index)) {
+		    TclObjectDispatchNoDefault(interp, status, listObj,
+			list, index, interp, listObj, index, &listItem);
+		    if (status == TCL_OK) {
+			Tcl_IncrRefCount(listItem);
+			Tcl_DecrRefCount(listObj);
+			listObj = listItem;
+		    } else {
+			Tcl_DecrRefCount(listObj);
+			return NULL;
+		    }
+		} else {
+		    /*
+		     * Must set the internal rep again because it may have been
+		     * changed by TclGetIntForIndexM. See test lindex-8.4.
+		     */
+		    if (!TclHasInternalRep(listObj, tclListType)) {
+			status = SetListFromAny(interp, listObj);
+			if (status != TCL_OK) {
+			    /* The list is not a list at all => error.  */
+			    Tcl_DecrRefCount(listObj);
+			    return NULL;
+			}
+		    }
 
-		ListObjGetElements(listObj, listLen, elemPtrs);
-		/* increment this reference count first before decrementing
-		 * just in case they are the same Tcl_Obj
-		 */
-		itemObj = elemPtrs[index];
-		Tcl_IncrRefCount(itemObj);
-		Tcl_DecrRefCount(listObj);
-		/* Extract the pointer to the appropriate element. */
-		listObj = itemObj;
+		    ListObjGetElements(listObj, listLen, elemPtrs);
+		    /* increment this reference count first before decrementing
+		     * just in case they are the same Tcl_Obj
+		     */
+		    Tcl_IncrRefCount(elemPtrs[index]);
+		    Tcl_DecrRefCount(listObj);
+		    /* Extract the pointer to the appropriate element. */
+		    listObj = elemPtrs[index];
+		}
 	    }
 	} else {
 	    Tcl_DecrRefCount(listObj);
@@ -2740,7 +2913,7 @@ TclLsetList(
      * shimmering; see TIP #22 and #23 for details.
      */
 
-    if (!TclHasInternalRep(indexArgObj, &tclListType.objType)
+    if (!TclHasInternalRep(indexArgObj, tclListType)
 	&& TclGetIntForIndexM(NULL, indexArgObj, TCL_SIZE_MAX - 1, &index)
 	       == TCL_OK) {
 	/* indexArgPtr designates a single index. */
@@ -2749,7 +2922,7 @@ TclLsetList(
     }
 
     indexListCopy = TclDuplicatePureObj(
-	    interp, indexArgObj, &tclListType.objType);
+	    interp, indexArgObj, tclListType);
     if (!indexListCopy) {
 	/*
 	 * indexArgPtr designates something that is neither an index nor a
@@ -2813,13 +2986,15 @@ TclLsetList(
  *----------------------------------------------------------------------
  */
 Tcl_Obj *
-TclLsetFlat(
-    Tcl_Interp *interp,		/* Tcl interpreter. */
-    Tcl_Obj *listObj,		/* Pointer to the list being modified. */
-    Tcl_Size indexCount,		/* Number of index args. */
-    Tcl_Obj *const indexArray[],
-				/* Index args. */
-    Tcl_Obj *valueObj)		/* Value arg to 'lset' or NULL to 'lpop'. */
+TclLsetFlat(tclObjTypeInterfaceArgsListSetList)
+{
+    return TclObjectDispatch(listObj, LsetFlat,
+	list, setlist, interp, listObj, indexCount, indexArray, valueObj);
+}
+
+
+Tcl_Obj *
+LsetFlat(tclObjTypeInterfaceArgsListSetList)
 {
     Tcl_Size index, len;
     int copied = 0, result;
@@ -2847,7 +3022,7 @@ TclLsetFlat(
      */
 
     subListObj = Tcl_IsShared(listObj)
-	? TclDuplicatePureObj(interp, listObj, &tclListType.objType) : listObj;
+	? TclDuplicatePureObj(interp, listObj, tclListType) : listObj;
     if (!subListObj) {
 	return NULL;
     }
@@ -2934,7 +3109,7 @@ TclLsetFlat(
 	    }
 	    if (Tcl_IsShared(subListObj)) {
 		subListObj = TclDuplicatePureObj(
-		    interp, subListObj, &tclListType.objType);
+		    interp, subListObj, tclListType);
 		if (!subListObj) {
 		    return NULL;
 		}
@@ -2958,7 +3133,7 @@ TclLsetFlat(
 	    if (Tcl_IsShared(subListObj)) {
 		Tcl_Obj * newSubListObj;
 		newSubListObj = TclDuplicatePureObj(
-		    interp, subListObj, &tclListType.objType);
+		    interp, subListObj, tclListType);
 		if (copied) {
 		    Tcl_DecrRefCount(subListObj);
 		}
@@ -3086,14 +3261,14 @@ TclLsetFlat(
  *----------------------------------------------------------------------
  */
 int
-TclListObjSetElement(
-    Tcl_Interp *interp,		/* Tcl interpreter; used for error reporting
-				 * if not NULL. */
-    Tcl_Obj *listObj,		/* List object in which element should be
-				 * stored. */
-    Tcl_Size index,		/* Index of element to store. */
-    Tcl_Obj *valueObj)		/* Tcl object to store in the designated list
-				 * element. */
+TclListObjSetElement(tclObjTypeInterfaceArgsListSet)
+{
+    return TclObjectDispatch(listObj, ListObjSetElement,
+	list, set, interp, listObj, index, valueObj);
+}
+
+int
+ListObjSetElement(tclObjTypeInterfaceArgsListSet)
 {
     ListRep listRep;
     Tcl_Obj **elemPtrs;         /* Pointers to elements of the list. */
@@ -3249,7 +3424,61 @@ SetListFromAny(
      * describe duplicate keys).
      */
 
-    if (!TclHasStringRep(objPtr) && TclHasInternalRep(objPtr, &tclDictType)) {
+    if (TclObjectHasInterface(objPtr, list, index)) {
+	int status;
+	Tcl_Size index, length, storeSize, offset;
+	Tcl_Obj *itemPtr, **lastElemPtr;
+	status = Tcl_ListObjLength(interp, objPtr, &length);
+	if (status != TCL_OK) {
+	    return status;
+	}
+	storeSize = length;
+	if (ListRepInitAttempt(
+		interp, length > 8 ? storeSize : 8, NULL, &listRep)
+	    != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	elemPtrs = listRep.storePtr->slots;
+	lastElemPtr = elemPtrs + listRep.storePtr->numAllocated - 1;
+	index = 0;
+	Tcl_IncrRefCount(objPtr);
+	while (index < length || length < 0) {
+	    TclObjectDispatchNoDefault(interp, status, objPtr, list,
+		index, interp, objPtr, index, &itemPtr);
+	    if (status != TCL_OK) {
+		status = Tcl_ListObjLength(interp, objPtr, &length);
+		if (status != TCL_OK) {
+		    TclUndoRefCount(objPtr);
+		    return status;
+		}
+		continue;
+	    }
+	    if (elemPtrs == lastElemPtr) {
+		ListStore *newStorePtr;
+		storeSize += storeSize / 2;
+		offset = elemPtrs - listRep.storePtr->slots;
+		newStorePtr = ListStoreReallocate(listRep.storePtr, storeSize);
+		if (newStorePtr == NULL) {
+		    TclUndoRefCount(objPtr);
+		    return MemoryAllocationError(interp, LIST_SIZE(storeSize));
+		}
+		elemPtrs = newStorePtr->slots + offset;
+		listRep.storePtr = newStorePtr;
+		lastElemPtr = elemPtrs + listRep.storePtr->numAllocated - 1;
+	    }
+	    listRep.storePtr->numUsed++;
+	    if (itemPtr == objPtr) {
+		*elemPtrs = Tcl_DuplicateObj(itemPtr);
+		TclBounceRefCount(itemPtr);
+	    } else {
+		*elemPtrs = itemPtr;
+	    }
+	    Tcl_IncrRefCount(*elemPtrs);
+	    elemPtrs++;
+	    index++;
+	}
+	TclUndoRefCount(objPtr);
+    } else if (!TclHasStringRep(objPtr) && TclHasInternalRep(objPtr, &tclDictType)) {
 	Tcl_Obj *keyPtr, *valuePtr;
 	Tcl_DictSearch search;
 	int done;
@@ -3289,35 +3518,6 @@ SetListFromAny(
 	    Tcl_IncrRefCount(valuePtr);
 	    Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done);
 	}
-    } else if (TclHasInternalRep(objPtr,&tclArithSeriesType.objType)) {
-	/*
-	 * Convertion from Arithmetic Series is a special case
-	 * because it can be done an order of magnitude faster
-	 * and may occur frequently.
-	 */
-	Tcl_Size j, size = ABSTRACTLIST_PROC(objPtr, lengthProc)(objPtr);
-
-	/* TODO - leave space in front and/or back? */
-	if (ListRepInitAttempt(
-		interp, size > 0 ? size : 1, NULL, &listRep)
-	    != TCL_OK) {
-	    return TCL_ERROR;
-	}
-
-	LIST_ASSERT(listRep.spanPtr == NULL); /* Guard against future changes */
-	LIST_ASSERT(listRep.storePtr->firstUsed == 0);
-	LIST_ASSERT((listRep.storePtr->flags & LISTSTORE_CANONICAL) == 0);
-
-	listRep.storePtr->numUsed = size;
-	elemPtrs = listRep.storePtr->slots;
-	for (j = 0; j < size; j++) {
-	    elemPtrs[j] = TclArithSeriesObjIndex(interp, objPtr, j);
-	    if (elemPtrs[j] == NULL) {
-		return TCL_ERROR;
-	    }
-	    Tcl_IncrRefCount(elemPtrs[j]);
-	}
-
     } else {
 	Tcl_Size estCount, length;
 	const char *limit, *nextElem = Tcl_GetStringFromObj(objPtr, &length);
@@ -3399,7 +3599,7 @@ fail:
     TclFreeInternalRep(objPtr);
     objPtr->internalRep.twoPtrValue.ptr1 = listRep.storePtr;
     objPtr->internalRep.twoPtrValue.ptr2 = listRep.spanPtr;
-    objPtr->typePtr = &tclListType.objType;
+    objPtr->typePtr = tclListType;
 
     return TCL_OK;
 }

generic/tclOO.c

@@ -138,9 +138,6 @@ static const Tcl_MethodType classConstructor = {
  */
 
 static const char initScript[] =
-#ifndef TCL_NO_DEPRECATED
-"package ifneeded TclOO " TCLOO_PATCHLEVEL " {# Already present, OK?};"
-#endif
 "package ifneeded tcl::oo " TCLOO_PATCHLEVEL " {# Already present, OK?};"
 "namespace eval ::oo { variable version " TCLOO_VERSION " };"
 "namespace eval ::oo { variable patchlevel " TCLOO_PATCHLEVEL " };";
@@ -260,10 +257,6 @@ TclOOInit(
 	return TCL_ERROR;
     }
 
-#ifndef TCL_NO_DEPRECATED
-    Tcl_PkgProvideEx(interp, "TclOO", TCLOO_PATCHLEVEL,
-	    &tclOOStubs);
-#endif
     return Tcl_PkgProvideEx(interp, "tcl::oo", TCLOO_PATCHLEVEL,
 	    &tclOOStubs);
 }

generic/tclObj.c

@@ -9,6 +9,7 @@
  * Copyright © 2001 ActiveState Corporation.
  * Copyright © 2005 Kevin B. Kenny.  All rights reserved.
  * Copyright © 2007 Daniel A. Steffen <das@users.sourceforge.net>
+ * Copyright © 2021 Nathan Coulter.  All rights reserved.
  *
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -19,6 +20,7 @@
 #include <math.h>
 #include <assert.h>
 
+
 /*
  * Table of all object types.
  */
@@ -27,6 +29,10 @@ static Tcl_HashTable typeTable;
 static int typeTableInitialized = 0;	/* 0 means not yet initialized. */
 TCL_DECLARE_MUTEX(tableMutex)
 
+TclObjectTypeType TclObjectTypeType0 = {
+	(int *)1
+};
+
 /*
  * Head of the list of free Tcl_Obj structs we maintain.
  */
@@ -221,6 +227,32 @@ static void		DupCmdNameInternalRep(Tcl_Obj *objPtr,
 static void		FreeCmdNameInternalRep(Tcl_Obj *objPtr);
 static int		SetCmdNameFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
 
+static int		ScalarObjIndex(tclObjTypeInterfaceArgsListIndex);
+static int		ScalarObjInterfaceListLength(tclObjTypeInterfaceArgsListLength);
+static Tcl_Obj*		ScalarObjRange(tclObjTypeInterfaceArgsListRange);
+
+ObjInterface tclScalarInterface = {
+    1,
+    {},
+    {
+	NULL,
+	NULL,				/* append */
+	NULL,				/* appendList */
+	&ScalarObjIndex,		/* index */
+	NULL,				/* indexEnd */  
+	NULL,				/* isSorted */
+	&ScalarObjInterfaceListLength,	/* length */
+	&ScalarObjRange,		/* range */
+	NULL,				/* rangeEnd */
+	NULL,				/* replace */
+	NULL,				/* replaceList */
+	NULL,				/* reverse */
+	NULL,				/* set */
+	NULL,				/* setList */
+    },
+};
+
+
 /*
  * The structures below defines the Tcl object types defined in this file by
  * means of functions that can be invoked by generic object code. See also
@@ -228,47 +260,55 @@ static int		SetCmdNameFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
  * implementations.
  */
 
-const TclObjTypeWithAbstractList tclBooleanType= {
-    {"boolean",			/* name */
+const ObjectType tclBooleanObjType= {
+    "boolean",			/* name */
     NULL,			/* freeIntRepProc */
     NULL,			/* dupIntRepProc */
     NULL,			/* updateStringProc */
     TclSetBooleanFromAny,		/* setFromAnyProc */
-    TCL_OBJTYPE_V0_1(
-    TclLengthOne
-    )}
+    2,
+    (Tcl_ObjInterface *)&tclScalarInterface
 };
-const TclObjTypeWithAbstractList tclDoubleType= {
-    {"double",			/* name */
+
+
+MODULE_SCOPE const Tcl_ObjType *tclBooleanType = (Tcl_ObjType *)&tclBooleanObjType;
+
+const ObjectType tclDoubleObjType= {
+    "double",			/* name */
     NULL,			/* freeIntRepProc */
     NULL,			/* dupIntRepProc */
     UpdateStringOfDouble,	/* updateStringProc */
     SetDoubleFromAny,		/* setFromAnyProc */
-    TCL_OBJTYPE_V0_1(
-    TclLengthOne
-    )}
+    2,
+    (Tcl_ObjInterface *)&tclScalarInterface
 };
-const TclObjTypeWithAbstractList tclIntType = {
-    {"int",			/* name */
+
+MODULE_SCOPE const Tcl_ObjType *tclDoubleType = (Tcl_ObjType *)&tclDoubleObjType;
+
+const ObjectType tclIntObjType = {
+    "int",			/* name */
     NULL,			/* freeIntRepProc */
     NULL,			/* dupIntRepProc */
     UpdateStringOfInt,		/* updateStringProc */
     SetIntFromAny,		/* setFromAnyProc */
-    TCL_OBJTYPE_V0_1(
-    TclLengthOne
-    )}
+    2,
+    (Tcl_ObjInterface *)&tclScalarInterface
 };
-const TclObjTypeWithAbstractList tclBignumType = {
-    {"bignum",			/* name */
+
+MODULE_SCOPE const Tcl_ObjType *tclIntType = (Tcl_ObjType *)&tclIntObjType;
+
+const ObjectType tclBignumObjType = {
+    "bignum",			/* name */
     FreeBignum,			/* freeIntRepProc */
     DupBignum,			/* dupIntRepProc */
     UpdateStringOfBignum,	/* updateStringProc */
     NULL,			/* setFromAnyProc */
-    TCL_OBJTYPE_V0_1(
-    TclLengthOne
-    )}
+    2,
+    (Tcl_ObjInterface *)&tclScalarInterface
 };
 
+MODULE_SCOPE const Tcl_ObjType *tclBignumType = (Tcl_ObjType *)&tclBignumObjType;
+
 /*
  * The structure below defines the Tcl obj hash key type.
  */
@@ -311,7 +351,7 @@ Tcl_ObjType tclCmdNameType = {
     DupCmdNameInternalRep,	/* dupIntRepProc */
     NULL,			/* updateStringProc */
     SetCmdNameFromAny,		/* setFromAnyProc */
-    TCL_OBJTYPE_V0
+    0
 };
 
 /*
@@ -388,9 +428,9 @@ TclInitObjSubsystem(void)
     Tcl_InitHashTable(&typeTable, TCL_STRING_KEYS);
     Tcl_MutexUnlock(&tableMutex);
 
-    Tcl_RegisterObjType(&tclDoubleType.objType);
+    Tcl_RegisterObjType(tclDoubleType);
     Tcl_RegisterObjType(&tclStringType);
-    Tcl_RegisterObjType(&tclListType.objType);
+    Tcl_RegisterObjType(tclListType);
     Tcl_RegisterObjType(&tclDictType);
     Tcl_RegisterObjType(&tclByteCodeType);
     Tcl_RegisterObjType(&tclCmdNameType);
@@ -816,6 +856,25 @@ TclThreadFinalizeContLines(
  *--------------------------------------------------------------
  */
 
+int TclObjTypeVersion (
+	const Tcl_ObjType *typePtr)
+{
+    ObjectType *otPtr = (ObjectType *)typePtr;
+    if ((void *)otPtr->name == (void *)&TclObjectTypeType0) {
+	return otPtr->version;
+    }
+    return 1;
+}
+
+
+const char *TclObjTypeName(
+	const Tcl_ObjType *typePtr)
+{
+    ObjectType *otPtr = (ObjectType *)typePtr;
+    return otPtr->name;
+}
+
+
 void
 Tcl_RegisterObjType(
     const Tcl_ObjType *typePtr)	/* Information about object type; storage must
@@ -825,8 +884,9 @@ Tcl_RegisterObjType(
     int isNew;
 
     Tcl_MutexLock(&tableMutex);
+    const char *name = TclObjTypeName(typePtr);
     Tcl_SetHashValue(
-	    Tcl_CreateHashEntry(&typeTable, typePtr->name, &isNew), typePtr);
+	    Tcl_CreateHashEntry(&typeTable, name, &isNew), typePtr);
     Tcl_MutexUnlock(&tableMutex);
 }
 
@@ -952,7 +1012,7 @@ Tcl_ConvertToType(
     }
 
     /*
-     * Use the target type's Tcl_SetFromAnyProc to set "objPtr"s internal form
+     * Use the target type's setFromAnyProc to set "objPtr"s internal form
      * as appropriate for the target type. This frees the old internal
      * representation.
      */
@@ -1783,52 +1843,7 @@ Tcl_GetString(
  *----------------------------------------------------------------------
  */
 
-#if !defined(TCL_NO_DEPRECATED)
-char *
-TclGetStringFromObj(
-    Tcl_Obj *objPtr,	/* Object whose string rep byte pointer should
-				 * be returned. */
-    void *lengthPtr)	/* If non-NULL, the location where the string
-				 * rep's byte array length should * be stored.
-				 * If NULL, no length is stored. */
-{
-    if (objPtr->bytes == NULL) {
-	/*
-	 * Note we do not check for objPtr->typePtr == NULL.  An invariant
-	 * of a properly maintained Tcl_Obj is that at least  one of
-	 * objPtr->bytes and objPtr->typePtr must not be NULL.  If broken
-	 * extensions fail to maintain that invariant, we can crash here.
-	 */
 
-	if (objPtr->typePtr->updateStringProc == NULL) {
-	    /*
-	     * Those Tcl_ObjTypes which choose not to define an
-	     * updateStringProc must be written in such a way that
-	     * (objPtr->bytes) never becomes NULL.
-	     */
-	    Tcl_Panic("UpdateStringProc should not be invoked for type %s",
-		    objPtr->typePtr->name);
-	}
-	objPtr->typePtr->updateStringProc(objPtr);
-	if (objPtr->bytes == NULL || objPtr->length == TCL_INDEX_NONE
-		|| objPtr->bytes[objPtr->length] != '\0') {
-	    Tcl_Panic("UpdateStringProc for type '%s' "
-		    "failed to create a valid string rep",
-		    objPtr->typePtr->name);
-	}
-    }
-    if (lengthPtr != NULL) {
-	if (objPtr->length > INT_MAX) {
-	    Tcl_Panic("Tcl_GetStringFromObj with 'int' lengthPtr"
-		    " cannot handle such long strings. Please use 'Tcl_Size'");
-	}
-	*(int *)lengthPtr = (int)objPtr->length;
-    }
-    return objPtr->bytes;
-}
-#endif /* !defined(TCL_NO_DEPRECATED) */
-
-#undef Tcl_GetStringFromObj
 char *
 Tcl_GetStringFromObj(
     Tcl_Obj *objPtr,	/* Object whose string rep byte pointer should
@@ -2122,7 +2137,6 @@ Tcl_FreeInternalRep(
  *----------------------------------------------------------------------
  */
 
-#undef Tcl_GetBoolFromObj
 int
 Tcl_GetBoolFromObj(
     Tcl_Interp *interp,         /* Used for error reporting if not NULL. */
@@ -2145,11 +2159,11 @@ Tcl_GetBoolFromObj(
 	return TCL_ERROR;
     }
     do {
-	if (objPtr->typePtr == &tclIntType.objType || objPtr->typePtr == &tclBooleanType.objType) {
+	if (objPtr->typePtr == tclIntType || objPtr->typePtr == tclBooleanType) {
 	    result = (objPtr->internalRep.wideValue != 0);
 	    goto boolEnd;
 	}
-	if (objPtr->typePtr == &tclDoubleType.objType) {
+	if (objPtr->typePtr == tclDoubleType) {
 	    /*
 	     * Caution: Don't be tempted to check directly for the "double"
 	     * Tcl_ObjType and then compare the internalrep to 0.0. This isn't
@@ -2166,7 +2180,7 @@ Tcl_GetBoolFromObj(
 	    result = (d != 0.0);
 	    goto boolEnd;
 	}
-	if (objPtr->typePtr == &tclBignumType.objType) {
+	if (objPtr->typePtr == tclBignumType) {
 	    result = 1;
 	boolEnd:
 	    if (charPtr != NULL) {
@@ -2192,7 +2206,6 @@ Tcl_GetBoolFromObj(
     return TCL_ERROR;
 }
 
-#undef Tcl_GetBooleanFromObj
 int
 Tcl_GetBooleanFromObj(
     Tcl_Interp *interp,         /* Used for error reporting if not NULL. */
@@ -2234,18 +2247,18 @@ TclSetBooleanFromAny(
      */
 
     if (objPtr->bytes == NULL) {
-	if (objPtr->typePtr == &tclIntType.objType) {
+	if (objPtr->typePtr == tclIntType) {
 	    if ((Tcl_WideUInt)objPtr->internalRep.wideValue < 2) {
 		return TCL_OK;
 	    }
 	    goto badBoolean;
 	}
 
-	if (objPtr->typePtr == &tclBignumType.objType) {
+	if (objPtr->typePtr == tclBignumType) {
 	    goto badBoolean;
 	}
 
-	if (objPtr->typePtr == &tclDoubleType.objType) {
+	if (objPtr->typePtr == tclDoubleType) {
 	    goto badBoolean;
 	}
     }
@@ -2376,13 +2389,13 @@ ParseBoolean(
   goodBoolean:
     TclFreeInternalRep(objPtr);
     objPtr->internalRep.wideValue = newBool;
-    objPtr->typePtr = &tclBooleanType.objType;
+    objPtr->typePtr = tclBooleanType;
     return TCL_OK;
 
   numericBoolean:
     TclFreeInternalRep(objPtr);
     objPtr->internalRep.wideValue = newBool;
-    objPtr->typePtr = &tclIntType.objType;
+    objPtr->typePtr = tclIntType;
     return TCL_OK;
 }
 
@@ -2474,7 +2487,7 @@ Tcl_DbNewDoubleObj(
     objPtr->bytes = NULL;
 
     objPtr->internalRep.doubleValue = dblValue;
-    objPtr->typePtr = &tclDoubleType.objType;
+    objPtr->typePtr = tclDoubleType;
     return objPtr;
 }
 
@@ -2547,7 +2560,7 @@ Tcl_GetDoubleFromObj(
     double *dblPtr)	/* Place to store resulting double. */
 {
     do {
-	if (objPtr->typePtr == &tclDoubleType.objType) {
+	if (objPtr->typePtr == tclDoubleType) {
 	    if (isnan(objPtr->internalRep.doubleValue)) {
 		if (interp != NULL) {
 		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
@@ -2560,11 +2573,11 @@ Tcl_GetDoubleFromObj(
 	    *dblPtr = (double) objPtr->internalRep.doubleValue;
 	    return TCL_OK;
 	}
-	if (objPtr->typePtr == &tclIntType.objType) {
+	if (objPtr->typePtr == tclIntType) {
 	    *dblPtr = (double) objPtr->internalRep.wideValue;
 	    return TCL_OK;
 	}
-	if (objPtr->typePtr == &tclBignumType.objType) {
+	if (objPtr->typePtr == tclBignumType) {
 	    mp_int big;
 
 	    TclUnpackBignum(objPtr, big);
@@ -2692,6 +2705,17 @@ Tcl_GetIntFromObj(
     return TCL_OK;
 #endif
 }
+
+int
+ScalarObjInterfaceListLength(
+    TCL_UNUSED(Tcl_Interp *),	/* Used to report errors if not NULL. */ \
+    TCL_UNUSED(Tcl_Obj *),	/* List object whose #elements to return. */ \
+    Tcl_Size *lenPtr	/* The resulting length is stored here. */
+)
+{
+    *lenPtr = 1;
+    return TCL_OK;
+}
 
 
 /*
@@ -2778,12 +2802,12 @@ Tcl_GetLongFromObj(
 {
     do {
 #ifdef TCL_WIDE_INT_IS_LONG
-	if (objPtr->typePtr == &tclIntType.objType) {
+	if (objPtr->typePtr == tclIntType) {
 	    *longPtr = objPtr->internalRep.wideValue;
 	    return TCL_OK;
 	}
 #else
-	if (objPtr->typePtr == &tclIntType.objType) {
+	if (objPtr->typePtr == tclIntType) {
 	    /*
 	     * We return any integer in the range LONG_MIN to ULONG_MAX
 	     * converted to a long, ignoring overflow. The rule preserves
@@ -2802,7 +2826,7 @@ Tcl_GetLongFromObj(
 	    goto tooLarge;
 	}
 #endif
-	if (objPtr->typePtr == &tclDoubleType.objType) {
+	if (objPtr->typePtr == tclDoubleType) {
 	    if (interp != NULL) {
                 Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                         "expected integer but got \"%s\"",
@@ -2811,7 +2835,7 @@ Tcl_GetLongFromObj(
 	    }
 	    return TCL_ERROR;
 	}
-	if (objPtr->typePtr == &tclBignumType.objType) {
+	if (objPtr->typePtr == tclBignumType) {
 	    /*
 	     * Must check for those bignum values that can fit in a long, even
 	     * when auto-narrowing is enabled. Only those values in the signed
@@ -3039,11 +3063,11 @@ Tcl_GetWideIntFromObj(
 				/* Place to store resulting long. */
 {
     do {
-	if (objPtr->typePtr == &tclIntType.objType) {
+	if (objPtr->typePtr == tclIntType) {
 	    *wideIntPtr = objPtr->internalRep.wideValue;
 	    return TCL_OK;
 	}
-	if (objPtr->typePtr == &tclDoubleType.objType) {
+	if (objPtr->typePtr == tclDoubleType) {
 	    if (interp != NULL) {
                 Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                         "expected integer but got \"%s\"",
@@ -3052,7 +3076,7 @@ Tcl_GetWideIntFromObj(
 	    }
 	    return TCL_ERROR;
 	}
-	if (objPtr->typePtr == &tclBignumType.objType) {
+	if (objPtr->typePtr == tclBignumType) {
 	    /*
 	     * Must check for those bignum values that can fit in a
 	     * Tcl_WideInt, even when auto-narrowing is enabled.
@@ -3124,7 +3148,7 @@ Tcl_GetWideUIntFromObj(
 				/* Place to store resulting long. */
 {
     do {
-	if (objPtr->typePtr == &tclIntType.objType) {
+	if (objPtr->typePtr == tclIntType) {
 	    if (objPtr->internalRep.wideValue < 0) {
 	wideUIntOutOfRange:
 		if (interp != NULL) {
@@ -3138,10 +3162,10 @@ Tcl_GetWideUIntFromObj(
 	    *wideUIntPtr = (Tcl_WideUInt)objPtr->internalRep.wideValue;
 	    return TCL_OK;
 	}
-	if (objPtr->typePtr == &tclDoubleType.objType) {
+	if (objPtr->typePtr == tclDoubleType) {
 	    goto wideUIntOutOfRange;
 	}
-	if (objPtr->typePtr == &tclBignumType.objType) {
+	if (objPtr->typePtr == tclBignumType) {
 	    /*
 	     * Must check for those bignum values that can fit in a
 	     * Tcl_WideUInt, even when auto-narrowing is enabled.
@@ -3208,11 +3232,11 @@ TclGetWideBitsFromObj(
     Tcl_WideInt *wideIntPtr)    /* Place to store resulting wide integer. */
 {
     do {
-	if (objPtr->typePtr == &tclIntType.objType) {
+	if (objPtr->typePtr == tclIntType) {
 	    *wideIntPtr = objPtr->internalRep.wideValue;
 	    return TCL_OK;
 	}
-	if (objPtr->typePtr == &tclDoubleType.objType) {
+	if (objPtr->typePtr == tclDoubleType) {
 	    if (interp != NULL) {
                 Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                         "expected integer but got \"%s\"",
@@ -3221,7 +3245,7 @@ TclGetWideBitsFromObj(
 	    }
 	    return TCL_ERROR;
 	}
-	if (objPtr->typePtr == &tclBignumType.objType) {
+	if (objPtr->typePtr == tclBignumType) {
 	    mp_int big;
 	    mp_err err;
 
@@ -3325,7 +3349,7 @@ DupBignum(
     mp_int bignumVal;
     mp_int bignumCopy;
 
-    copyPtr->typePtr = &tclBignumType.objType;
+    copyPtr->typePtr = tclBignumType;
     TclUnpackBignum(srcPtr, bignumVal);
     if (mp_init_copy(&bignumCopy, &bignumVal) != MP_OKAY) {
 	Tcl_Panic("initialization failure in DupBignum");
@@ -3495,7 +3519,7 @@ GetBignumFromObj(
     mp_int *bignumValue)	/* Returned bignum value. */
 {
     do {
-	if (objPtr->typePtr == &tclBignumType.objType) {
+	if (objPtr->typePtr == tclBignumType) {
 	    if (copy || Tcl_IsShared(objPtr)) {
 		mp_int temp;
 
@@ -3520,14 +3544,14 @@ GetBignumFromObj(
 	    }
 	    return TCL_OK;
 	}
-	if (objPtr->typePtr == &tclIntType.objType) {
+	if (objPtr->typePtr == tclIntType) {
 	    if (mp_init_i64(bignumValue,
 		    objPtr->internalRep.wideValue) != MP_OKAY) {
 		return TCL_ERROR;
 	    }
 	    return TCL_OK;
 	}
-	if (objPtr->typePtr == &tclDoubleType.objType) {
+	if (objPtr->typePtr == tclDoubleType) {
 	    if (interp != NULL) {
                 Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                         "expected integer but got \"%s\"",
@@ -3687,7 +3711,7 @@ TclSetBignumInternalRep(
     void *big)
 {
     mp_int *bignumValue = (mp_int *)big;
-    objPtr->typePtr = &tclBignumType.objType;
+    objPtr->typePtr = tclBignumType;
     PACK_BIGNUM(*bignumValue, objPtr);
 
     /*
@@ -3710,14 +3734,13 @@ TclSetBignumInternalRep(
  *      Extracts a number (of any possible numeric type) from an object.
  *
  * Results:
- *      Whether the extraction worked. The type is stored in the variable
- *      referred to by the typePtr argument, and a pointer to the
- *      representation is stored in the variable referred to by the
- *      clientDataPtr.
+ *      A standard Tcl completion code.  On success, the type is stored at the
+ *      address given by typePtr, and a pointer to the representation is stored
+ *      at the address given by clientDataPtr.
  *
  * Side effects:
- *      Can allocate thread-specific data for handling the copy-out space for
- *      bignums; this space is shared within a thread.
+ *      May allocate thread-specific data shared within a thread for handling
+ *      the copy-out space for bignums.
  *
  *----------------------------------------------------------------------
  */
@@ -3730,7 +3753,7 @@ Tcl_GetNumberFromObj(
     int *typePtr)
 {
     do {
-	if (objPtr->typePtr == &tclDoubleType.objType) {
+	if (objPtr->typePtr == tclDoubleType) {
 	    if (isnan(objPtr->internalRep.doubleValue)) {
 		*typePtr = TCL_NUMBER_NAN;
 	    } else {
@@ -3739,12 +3762,12 @@ Tcl_GetNumberFromObj(
 	    *clientDataPtr = &objPtr->internalRep.doubleValue;
 	    return TCL_OK;
 	}
-	if (objPtr->typePtr == &tclIntType.objType) {
+	if (objPtr->typePtr == tclIntType) {
 	    *typePtr = TCL_NUMBER_INT;
 	    *clientDataPtr = &objPtr->internalRep.wideValue;
 	    return TCL_OK;
 	}
-	if (objPtr->typePtr == &tclBignumType.objType) {
+	if (objPtr->typePtr == tclBignumType) {
 	    static Tcl_ThreadDataKey bignumKey;
 	    mp_int *bigPtr = (mp_int *)Tcl_GetThreadData(&bignumKey,
 		    sizeof(mp_int));
@@ -3795,6 +3818,29 @@ Tcl_GetNumber(
     return Tcl_GetNumberFromObj(interp, objPtr, clientDataPtr, typePtr);
 }
 
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclBounceRefCount --
+ *
+ *	Performs the equivante of incrementing and then decrementing the
+ *	reference count.
+ *
+ * Results:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclBounceRefCount(
+    Tcl_Obj *objPtr)	/* The object we are registering a reference to. */
+{
+    if (objPtr->refCount < 1) {
+	TclFreeObj(objPtr);
+    }
+}
+
 /*
  *----------------------------------------------------------------------
  *
@@ -4587,6 +4633,37 @@ DupCmdNameInternalRep(
 	resPtr->refCount++;
     copyPtr->typePtr = &tclCmdNameType;
 }
+
+
+static int
+ScalarObjIndex(
+    TCL_UNUSED(Tcl_Interp *),/* Used to report errors if not NULL. */ \
+    Tcl_Obj *listPtr,	/* List object to index into. */ \
+    Tcl_Size index,	/* Index of element to return. */ \
+    Tcl_Obj **objPtrPtr	/* The resulting Tcl_Obj* is stored here. */
+) {
+    if (index == 0) {
+	*objPtrPtr = listPtr;
+    } else {
+	*objPtrPtr = NULL;
+    }
+    return TCL_OK;
+}
+
+static Tcl_Obj* ScalarObjRange(
+    TCL_UNUSED(Tcl_Interp *),/* Used to report errors */ \
+    Tcl_Obj *listObj,	    /* List object to take a range from. */ \
+    Tcl_Size rangeStart,    /* Index of first element to */ \
+			    /* include. */ \
+    Tcl_Size rangeEnd	/* Index of last element to include. */
+)
+{
+    if (rangeEnd >= 0 && rangeEnd >= rangeStart) {
+	return listObj;
+    } else {
+	return NULL;
+    }
+}
 
 /*
  *----------------------------------------------------------------------
@@ -4699,13 +4776,14 @@ Tcl_RepresentationCmd(
      * "1872361827361287"
      */
 
+    const char *name = objv[1]->typePtr ?  TclObjTypeName(objv[1]->typePtr) : "pure string";
     descObj = Tcl_ObjPrintf("value is a %s with a refcount of %" TCL_Z_MODIFIER "u,"
 	    " object pointer at %p",
-	    objv[1]->typePtr ? objv[1]->typePtr->name : "pure string",
+	    name,
 	    objv[1]->refCount, objv[1]);
 
     if (objv[1]->typePtr) {
-	if (objv[1]->typePtr == &tclDoubleType.objType) {
+	if (objv[1]->typePtr == tclDoubleType) {
 	    Tcl_AppendPrintfToObj(descObj, ", internal representation %g",
 		    objv[1]->internalRep.doubleValue);
 	} else {
@@ -4727,6 +4805,32 @@ Tcl_RepresentationCmd(
     Tcl_SetObjResult(interp, descObj);
     return TCL_OK;
 }
+
+
+void Tcl_ObjTypeVersion(Tcl_Obj *objPtr, int *version) {
+    if ((void *)objPtr->typePtr->name == (void *)&TclObjectTypeType0) {
+	*version = ((ObjectType *)objPtr->typePtr)->version;
+    } else {
+	*version = 1;
+    }
+    return;
+}
+
+
+TclObjectTypeType * TclGetObjectTypeType () {
+	return &TclObjectTypeType0;
+}
+
+
+int (*TclObjInterfaceGetListIndex (Tcl_Obj *objPtr))
+(tclObjTypeInterfaceArgsListIndex)
+{
+	ObjInterface *interface = (ObjInterface *)((ObjectType *)objPtr->typePtr)->interface;
+	if (interface->version >= 1) {
+		return interface->list.index;
+	}
+	return NULL;
+}
 
 /*
  * Local Variables:

generic/tclParse.c

@@ -871,18 +871,6 @@ TclParseBackslash(
 	     * No hexdigits -> This is just "u".
 	     */
 	    result = 'u';
-#if TCL_UTF_MAX < 4
-	} else if (((result & 0xFC00) == 0xD800) && (count == 6)
-		    && (p[5] == '\\') && (p[6] == 'u') && (numBytes >= 10)) {
-	    /* If high surrogate is immediately followed by a low surrogate
-	     * escape, combine them into one character. */
-	    int low;
-	    int count2 = ParseHex(p+7, 4, &low);
-	    if ((count2 == 4) && ((low & 0xFC00) == 0xDC00)) {
-		result = ((result & 0x3FF)<<10 | (low & 0x3FF)) + 0x10000;
-		count += count2 + 2;
-	    }
-#endif
 	}
 	break;
     case 'U':
@@ -938,13 +926,13 @@ TclParseBackslash(
 	 */
 
 	if (Tcl_UtfCharComplete(p, numBytes - 1)) {
-	    count = TclUtfToUCS4(p, &unichar) + 1;	/* +1 for '\' */
+	    count = Tcl_UtfToUniChar(p, &unichar) + 1;	/* +1 for '\' */
 	} else {
 	    char utfBytes[8];
 
 	    memcpy(utfBytes, p, numBytes - 1);
 	    utfBytes[numBytes - 1] = '\0';
-	    count = TclUtfToUCS4(utfBytes, &unichar) + 1;
+	    count = Tcl_UtfToUniChar(utfBytes, &unichar) + 1;
 	}
 	result = unichar;
 	break;
@@ -955,12 +943,6 @@ TclParseBackslash(
 	*readPtr = count;
     }
     count = Tcl_UniCharToUtf(result, dst);
-#if TCL_UTF_MAX < 4
-    if ((result >= 0xD800) && (count < 3)) {
-	/* Special case for handling high surrogates. */
-	count += Tcl_UniCharToUtf(-1, dst + count);
-    }
-#endif
     return count;
 }
 

generic/tclPlatDecls.h

@@ -48,93 +48,6 @@
 #   endif
 #endif
 
-#if TCL_MAJOR_VERSION < 9
-
-#ifdef __cplusplus
-extern "C" {
-#endif
-
-/*
- * Exported function declarations:
- */
-
-#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
-/* 0 */
-EXTERN TCHAR *		Tcl_WinUtfToTChar(const char *str, int len,
-				Tcl_DString *dsPtr);
-/* 1 */
-EXTERN char *		Tcl_WinTCharToUtf(const TCHAR *str, int len,
-				Tcl_DString *dsPtr);
-/* Slot 2 is reserved */
-/* 3 */
-EXTERN void		Tcl_WinConvertError(unsigned errCode);
-#endif /* WIN */
-#ifdef MAC_OSX_TCL /* MACOSX */
-/* 0 */
-EXTERN int		Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp,
-				const char *bundleName, int hasResourceFile,
-				int maxPathLen, char *libraryPath);
-/* 1 */
-EXTERN int		Tcl_MacOSXOpenVersionedBundleResources(
-				Tcl_Interp *interp, const char *bundleName,
-				const char *bundleVersion,
-				int hasResourceFile, int maxPathLen,
-				char *libraryPath);
-/* 2 */
-EXTERN void		Tcl_MacOSXNotifierAddRunLoopMode(
-				const void *runLoopMode);
-#endif /* MACOSX */
-
-typedef struct TclPlatStubs {
-    int magic;
-    void *hooks;
-
-#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
-    TCHAR * (*tcl_WinUtfToTChar) (const char *str, int len, Tcl_DString *dsPtr); /* 0 */
-    char * (*tcl_WinTCharToUtf) (const TCHAR *str, int len, Tcl_DString *dsPtr); /* 1 */
-    void (*reserved2)(void);
-    void (*tcl_WinConvertError) (unsigned errCode); /* 3 */
-#endif /* WIN */
-#ifdef MAC_OSX_TCL /* MACOSX */
-    int (*tcl_MacOSXOpenBundleResources) (Tcl_Interp *interp, const char *bundleName, int hasResourceFile, int maxPathLen, char *libraryPath); /* 0 */
-    int (*tcl_MacOSXOpenVersionedBundleResources) (Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, int hasResourceFile, int maxPathLen, char *libraryPath); /* 1 */
-    void (*tcl_MacOSXNotifierAddRunLoopMode) (const void *runLoopMode); /* 2 */
-#endif /* MACOSX */
-} TclPlatStubs;
-
-extern const TclPlatStubs *tclPlatStubsPtr;
-
-#ifdef __cplusplus
-}
-#endif
-
-#if defined(USE_TCL_STUBS)
-
-/*
- * Inline function declarations:
- */
-
-#if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
-#define Tcl_WinUtfToTChar \
-	(tclPlatStubsPtr->tcl_WinUtfToTChar) /* 0 */
-#define Tcl_WinTCharToUtf \
-	(tclPlatStubsPtr->tcl_WinTCharToUtf) /* 1 */
-/* Slot 2 is reserved */
-#define Tcl_WinConvertError \
-	(tclPlatStubsPtr->tcl_WinConvertError) /* 3 */
-#endif /* WIN */
-#ifdef MAC_OSX_TCL /* MACOSX */
-#define Tcl_MacOSXOpenBundleResources \
-	(tclPlatStubsPtr->tcl_MacOSXOpenBundleResources) /* 0 */
-#define Tcl_MacOSXOpenVersionedBundleResources \
-	(tclPlatStubsPtr->tcl_MacOSXOpenVersionedBundleResources) /* 1 */
-#define Tcl_MacOSXNotifierAddRunLoopMode \
-	(tclPlatStubsPtr->tcl_MacOSXNotifierAddRunLoopMode) /* 2 */
-#endif /* MACOSX */
-
-#endif /* defined(USE_TCL_STUBS) */
-
-#else /* TCL_MAJOR_VERSION > 8 */
 
 /* !BEGIN!: Do not edit below this line. */
 
@@ -193,7 +106,6 @@ extern const TclPlatStubs *tclPlatStubsPtr;
 
 /* !END!: Do not edit above this line. */
 
-#endif /* TCL_MAJOR_VERSION */
 
 #ifdef MAC_OSX_TCL /* MACOSX */
 #undef Tcl_MacOSXOpenBundleResources
@@ -213,8 +125,7 @@ extern const TclPlatStubs *tclPlatStubsPtr;
 #   undef Tcl_MacOSXNotifierAddRunLoopMode
 #endif
 
-#if defined(USE_TCL_STUBS) && (defined(_WIN32) || defined(__CYGWIN__))\
-	&& (defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8)
+#if defined(USE_TCL_STUBS) && (defined(_WIN32) || defined(__CYGWIN__))
 #undef Tcl_WinUtfToTChar
 #undef Tcl_WinTCharToUtf
 #ifdef _WIN32

generic/tclScan.c

@@ -903,7 +903,7 @@ Tcl_ScanObjCmd(
 	     * Scan a single Unicode character.
 	     */
 
-	    offset = TclUtfToUCS4(string, &i);
+	    offset = Tcl_UtfToUniChar(string, &i);
 	    string += offset;
 	    if (!(flags & SCAN_SUPPRESS)) {
 		TclNewIntObj(objPtr, i);
@@ -1046,7 +1046,7 @@ Tcl_ScanObjCmd(
 		if (Tcl_GetDoubleFromObj(NULL, objPtr, &dvalue) != TCL_OK) {
 #ifdef ACCEPT_NAN
 		    const Tcl_ObjInternalRep *irPtr
-			    = TclFetchInternalRep(objPtr, &tclDoubleType.objType);
+			    = TclFetchInternalRep(objPtr, tclDoubleType);
 		    if (irPtr) {
 			dvalue = irPtr->doubleValue;
 		    } else

generic/tclStrToD.c

@@ -555,7 +555,7 @@ TclParseNumber(
 		/* A dict can never be a (single) number */
 		return TCL_ERROR;
 	    }
-	    if (TclHasInternalRep(objPtr, &tclListType.objType)) {
+	    if (TclHasInternalRep(objPtr, tclListType)) {
 		Tcl_Size length;
 		/* A list can only be a (single) number if its length == 1 */
 		TclListObjLengthM(NULL, objPtr, &length);
@@ -1378,7 +1378,7 @@ TclParseNumber(
 			    octalSignificandWide);
 		    octalSignificandOverflow = 1;
 		} else {
-		    objPtr->typePtr = &tclIntType.objType;
+		    objPtr->typePtr = tclIntType;
 		    if (signum) {
 			objPtr->internalRep.wideValue =
 				(Tcl_WideInt)(-octalSignificandWide);
@@ -1414,7 +1414,7 @@ TclParseNumber(
 			    significandWide);
 		    significandOverflow = 1;
 		} else {
-		    objPtr->typePtr = &tclIntType.objType;
+		    objPtr->typePtr = tclIntType;
 		    if (signum) {
 			objPtr->internalRep.wideValue =
 				(Tcl_WideInt)(-significandWide);
@@ -1446,7 +1446,7 @@ TclParseNumber(
 	     * k = numTrailZeros+exponent-numDigitsAfterDp.
 	     */
 
-	    objPtr->typePtr = &tclDoubleType.objType;
+	    objPtr->typePtr = tclDoubleType;
 	    if (exponentSignum) {
 		/*
 		 * At this point exponent>=0, so the following calculation
@@ -1497,14 +1497,14 @@ TclParseNumber(
 	    } else {
 		objPtr->internalRep.doubleValue = HUGE_VAL;
 	    }
-	    objPtr->typePtr = &tclDoubleType.objType;
+	    objPtr->typePtr = tclDoubleType;
 	    break;
 
 #ifdef IEEE_FLOATING_POINT
 	case sNAN:
 	case sNANFINISH:
 	    objPtr->internalRep.doubleValue = MakeNaN(signum, significandWide);
-	    objPtr->typePtr = &tclDoubleType.objType;
+	    objPtr->typePtr = tclDoubleType;
 	    break;
 #endif
 	case INITIAL:

generic/tclStringObj.c

@@ -59,6 +59,8 @@ static void		ExtendUnicodeRepWithString(Tcl_Obj *objPtr,
 			    Tcl_Size numAppendChars);
 static void		FillUnicodeRep(Tcl_Obj *objPtr);
 static void		FreeStringInternalRep(Tcl_Obj *objPtr);
+static Tcl_Size		GetCharLength(Tcl_Obj *objPtr);
+static Tcl_Obj*		GetRange(tclObjTypeInterfaceArgsStringRange);
 static void		GrowStringBuffer(Tcl_Obj *objPtr, Tcl_Size needed, int flag);
 static void		GrowUnicodeBuffer(Tcl_Obj *objPtr, Tcl_Size needed);
 static int		SetStringFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
@@ -67,16 +69,6 @@ static void		SetUnicodeObj(Tcl_Obj *objPtr,
 static Tcl_Size		UnicodeLength(const Tcl_UniChar *unicode);
 static void		UpdateStringOfString(Tcl_Obj *objPtr);
 
-#if TCL_UTF_MAX > 3
-#define ISCONTINUATION(bytes) (\
-	((bytes)[0] & 0xC0) == 0x80)
-#else
-#define ISCONTINUATION(bytes) (\
-	((((bytes)[0] & 0xC0) == 0x80) || (((bytes)[0] == '\xED') \
-	&& (((bytes)[1] & 0xF0) == 0xB0) && (((bytes)[2] & 0xC0) == 0x80))))
-#endif
-
-
 /*
  * The structure below defines the string Tcl object type by means of
  * functions that can be invoked by generic object code.
@@ -379,11 +371,18 @@ Tcl_NewUnicodeObj(
  *
  *----------------------------------------------------------------------
  */
-
 Tcl_Size
 Tcl_GetCharLength(
     Tcl_Obj *objPtr)		/* The String object to get the num chars
 				 * of. */
+{
+    return TclObjectDispatch(objPtr, GetCharLength,
+	string, length, objPtr);
+}
+
+Tcl_Size
+GetCharLength(
+    Tcl_Obj *objPtr)
 {
     String *stringPtr;
     Tcl_Size numChars = 0;
@@ -589,22 +588,6 @@ Tcl_GetUniChar(
 	return -1;
     }
     ch = stringPtr->unicode[index];
-#if TCL_UTF_MAX < 4
-    /* See: bug [11ae2be95dac9417] */
-    if ((ch & 0xF800) == 0xD800) {
-	if (ch & 0x400) {
-	    if ((index > 0)
-		    && ((stringPtr->unicode[index-1] & 0xFC00) == 0xD800)) {
-		ch = -1; /* low surrogate preceded by high surrogate */
-	    }
-	} else if ((++index < stringPtr->numChars)
-		&& ((stringPtr->unicode[index] & 0xFC00) == 0xDC00)) {
-	    /* high surrogate followed by low surrogate */
-	    ch = (((ch & 0x3FF) << 10) |
-			(stringPtr->unicode[index] & 0x3FF)) + 0x10000;
-	}
-    }
-#endif
     return ch;
 }
 
@@ -666,36 +649,6 @@ TclGetUniChar(
  */
 
 #undef Tcl_GetUnicodeFromObj
-#if !defined(TCL_NO_DEPRECATED)
-Tcl_UniChar *
-TclGetUnicodeFromObj(
-    Tcl_Obj *objPtr,		/* The object to find the Unicode string
-				 * for. */
-    void *lengthPtr)		/* If non-NULL, the location where the string
-				 * rep's Tcl_UniChar length should be stored. If
-				 * NULL, no length is stored. */
-{
-    String *stringPtr;
-
-    SetStringFromAny(NULL, objPtr);
-    stringPtr = GET_STRING(objPtr);
-
-    if (stringPtr->hasUnicode == 0) {
-	FillUnicodeRep(objPtr);
-	stringPtr = GET_STRING(objPtr);
-    }
-
-    if (lengthPtr != NULL) {
-	if (stringPtr->numChars > INT_MAX) {
-	    Tcl_Panic("Tcl_GetUnicodeFromObj with 'int' lengthPtr"
-		    " cannot handle such long strings. Please use 'Tcl_Size'");
-	}
-	*(int *)lengthPtr = (int)stringPtr->numChars;
-    }
-    return stringPtr->unicode;
-}
-#endif /* !defined(TCL_NO_DEPRECATED) */
-
 Tcl_UniChar *
 Tcl_GetUnicodeFromObj(
     Tcl_Obj *objPtr,		/* The object to find the unicode string
@@ -741,11 +694,15 @@ Tcl_GetUnicodeFromObj(
  */
 
 Tcl_Obj *
-Tcl_GetRange(
-    Tcl_Obj *objPtr,		/* The Tcl object to find the range of. */
-    Tcl_Size first,			/* First index of the range. */
-    Tcl_Size last)			/* Last index of the range. */
+Tcl_GetRange(tclObjTypeInterfaceArgsStringRange)
 {
+    return TclObjectDispatch(objPtr, GetRange,
+	string, range, objPtr, first, last);
+}
+
+
+Tcl_Obj *
+GetRange(tclObjTypeInterfaceArgsStringRange) {
     Tcl_Obj *newObjPtr;		/* The Tcl object to find the range of. */
     String *stringPtr;
     Tcl_Size length = 0;
@@ -816,18 +773,6 @@ Tcl_GetRange(
 	TclNewObj(newObjPtr);
 	return newObjPtr;
     }
-#if TCL_UTF_MAX < 4
-    /* See: bug [11ae2be95dac9417] */
-    if ((first > 0) && ((stringPtr->unicode[first] & 0xFC00) == 0xDC00)
-	    && ((stringPtr->unicode[first-1] & 0xFC00) == 0xD800)) {
-	++first;
-    }
-    if ((last + 1 < stringPtr->numChars)
-	    && ((stringPtr->unicode[last+1] & 0xFC00) == 0xDC00)
-	    && ((stringPtr->unicode[last] & 0xFC00) == 0xD800)) {
-	++last;
-    }
-#endif
     return Tcl_NewUnicodeObj(stringPtr->unicode + first, last - first + 1);
 }
 
@@ -1283,12 +1228,6 @@ Tcl_AppendLimitedToObj(
     SetStringFromAny(NULL, objPtr);
     stringPtr = GET_STRING(objPtr);
 
-    /* If appended string starts with a continuation byte or a lower surrogate,
-     * force objPtr to unicode representation. See [7f1162a867] */
-    if (bytes && ISCONTINUATION(bytes)) {
-	Tcl_GetUnicode(objPtr);
-	stringPtr = GET_STRING(objPtr);
-    }
     if (stringPtr->hasUnicode && (stringPtr->numChars) > 0) {
 	AppendUtfToUnicodeRep(objPtr, bytes, toCopy);
     } else {
@@ -1488,13 +1427,6 @@ Tcl_AppendObjToObj(
     SetStringFromAny(NULL, objPtr);
     stringPtr = GET_STRING(objPtr);
 
-    /* If appended string starts with a continuation byte or a lower surrogate,
-     * force objPtr to unicode representation. See [7f1162a867]
-     * This fixes append-3.4, append-3.7 and utf-1.18 testcases. */
-    if (ISCONTINUATION(TclGetString(appendObjPtr))) {
-	Tcl_GetUnicode(objPtr);
-	stringPtr = GET_STRING(objPtr);
-    }
     /*
      * If objPtr has a valid Unicode rep, then get a Unicode string from
      * appendObjPtr and append it.
@@ -2157,12 +2089,6 @@ Tcl_AppendFormatToObj(
 	    	code = 0xFFFD;
 	    }
 	    length = Tcl_UniCharToUtf(code, buf);
-#if TCL_UTF_MAX < 4
-	    if ((code >= 0xD800) && (length < 3)) {
-		/* Special case for handling high surrogates. */
-		length += Tcl_UniCharToUtf(-1, buf + length);
-	    }
-#endif
 	    segment = Tcl_NewStringObj(buf, length);
 	    Tcl_IncrRefCount(segment);
 	    allocSegment = 1;
@@ -3124,7 +3050,7 @@ TclStringCat(
     Tcl_Obj *objResultPtr, * const *ov;
     int binary = 1;
     Tcl_Size oc, length = 0;
-    int allowUniChar = 1, requestUniChar = 0, forceUniChar = 0;
+    int allowUniChar = 1, requestUniChar = 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) && !Tcl_IsShared(*objv);
@@ -3166,9 +3092,7 @@ TclStringCat(
 		 */
 
 	 	binary = 0;
-	 	if (ov > objv+1 && ISCONTINUATION(TclGetString(objPtr))) {
-	 	    forceUniChar = 1;
-	 	} else if ((objPtr->typePtr) && (objPtr->typePtr != &tclStringType)) {
+	 	if ((objPtr->typePtr) && (objPtr->typePtr != &tclStringType)) {
 		    /* Prevent shimmer of non-string types. */
 		    allowUniChar = 0;
 		}
@@ -3218,7 +3142,7 @@ TclStringCat(
 		}
 	    }
 	} while (--oc);
-    } else if ((allowUniChar && requestUniChar) || forceUniChar) {
+    } else if ((allowUniChar && requestUniChar)) {
 	/*
 	 * Result will be pure Tcl_UniChar array. Pre-size it.
 	 */
@@ -3375,7 +3299,7 @@ TclStringCat(
 		dst += more;
 	    }
 	}
-    } else if ((allowUniChar && requestUniChar) || forceUniChar) {
+    } else if ((allowUniChar && requestUniChar)) {
 	/* Efficiently produce a pure Tcl_UniChar array result */
 	Tcl_UniChar *dst;
 
@@ -3567,7 +3491,7 @@ TclStringCmp(
 		    s1 = (char *) Tcl_GetUnicode(value1Ptr);
 		    s2 = (char *) Tcl_GetUnicode(value2Ptr);
 		    if (
-#if defined(WORDS_BIGENDIAN) && (TCL_UTF_MAX > 3)
+#if defined(WORDS_BIGENDIAN)
 			    1
 #else
 			    checkEq
@@ -3790,6 +3714,32 @@ TclStringFirst(
     return obj;
 }
 
+int
+TclStringIndexInterface(
+    Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj *indexPtr, Tcl_Obj **charPtrPtr)
+{
+    Tcl_Size index, status;
+
+    status = TclGetIntForIndexM(interp, indexPtr, /*endValue*/ TCL_SIZE_MAX - 1,
+	&index);
+    if (status != TCL_OK) {
+	return status;
+    }
+
+    if (TclIndexIsFromEnd(index)) {
+	if (TclObjectInterfaceCall(objPtr, string, indexEnd,
+	    interp, objPtr, index, charPtrPtr) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+    } else {
+	if (TclObjectInterfaceCall(objPtr, string, index, interp, objPtr,
+	    index, charPtrPtr) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+    }
+    return TCL_OK;
+}
+
 /*
  *---------------------------------------------------------------------------
  *
@@ -3927,9 +3877,6 @@ TclStringReverse(
     String *stringPtr;
     Tcl_UniChar ch = 0;
     int inPlace = flags & TCL_STRING_IN_PLACE;
-#if TCL_UTF_MAX < 4
-    int needFlip = 0;
-#endif
 
     if (TclIsPureByteArray(objPtr)) {
 	Tcl_Size numBytes = 0;
@@ -3962,54 +3909,19 @@ TclStringReverse(
 	    to = Tcl_GetUnicode(objPtr);
 	    stringPtr = GET_STRING(objPtr);
 	    while (--src >= from) {
-#if TCL_UTF_MAX < 4
-		ch = *src;
-		if ((ch & 0xF800) == 0xD800) {
-		    needFlip = 1;
-		}
-		*to++ = ch;
-#else
 		*to++ = *src;
-#endif
 	    }
 	} else {
 	    /*
 	     * Reversing in place.
 	     */
 
-#if TCL_UTF_MAX < 4
-	    to = src;
-#endif
 	    while (--src > from) {
 		ch = *src;
-#if TCL_UTF_MAX < 4
-		if ((ch & 0xF800) == 0xD800) {
-		    needFlip = 1;
-		}
-#endif
 		*src = *from;
 		*from++ = ch;
 	    }
 	}
-#if TCL_UTF_MAX < 4
-	if (needFlip) {
-	    /*
-	     * Flip back surrogate pairs.
-	     */
-
-	    from = to - stringPtr->numChars;
-	    while (--to >= from) {
-		ch = *to;
-		if ((ch & 0xFC00) == 0xD800) {
-		    if ((to-1 >= from) && ((to[-1] & 0xFC00) == 0xDC00)) {
-			to[0] = to[-1];
-			to[-1] = ch;
-			--to;
-		    }
-		}
-	    }
-	}
-#endif
     }
 
     if (objPtr->bytes) {
@@ -4043,7 +3955,7 @@ TclStringReverse(
 		 * skip calling Tcl_UtfCharComplete() here.
 		 */
 
-		int bytesInChar = TclUtfToUCS4(from, &chw);
+		int bytesInChar = Tcl_UtfToUniChar(from, &chw);
 
 		ReverseBytes((unsigned char *)to, (unsigned char *)from,
 			bytesInChar);
@@ -4492,14 +4404,6 @@ 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/tclStubInit.c

@@ -79,16 +79,12 @@
 # undef Tcl_WinConvertError
 # define Tcl_WinConvertError 0
 #endif
-#if defined(TCL_NO_DEPRECATED)
 # undef TclGetStringFromObj
 # undef TclGetBytesFromObj
 # undef TclGetUnicodeFromObj
 # define TclGetStringFromObj 0
 # define TclGetBytesFromObj 0
-# if TCL_UTF_MAX > 3
-#   define TclGetUnicodeFromObj 0
-# endif
-#endif
+# define TclGetUnicodeFromObj 0
 #undef Tcl_Close
 #define Tcl_Close 0
 #undef TclGetByteArrayFromObj
@@ -97,23 +93,10 @@
 #define Tcl_GetByteArrayFromObj 0
 #define TclUnusedStubEntry 0
 
-
-#if TCL_UTF_MAX < 4
-static void uniCodePanic() {
-    Tcl_Panic("This extension uses a deprecated function, not available now: Tcl is compiled with -DTCL_UTF_MAX==%d", TCL_UTF_MAX);
-}
-#   define Tcl_GetUnicodeFromObj (Tcl_UniChar *(*)(Tcl_Obj *, Tcl_Size *))(void *)uniCodePanic
-#   define TclGetUnicodeFromObj (Tcl_UniChar *(*)(Tcl_Obj *, int *))(void *)uniCodePanic
-#   define Tcl_NewUnicodeObj (Tcl_Obj *(*)(const Tcl_UniChar *, Tcl_Size))(void *)uniCodePanic
-#   define Tcl_SetUnicodeObj (void(*)(Tcl_Obj *, const Tcl_UniChar *, Tcl_Size))(void *)uniCodePanic
-#   define Tcl_AppendUnicodeToObj (void(*)(Tcl_Obj *, const Tcl_UniChar *, Tcl_Size))(void *)uniCodePanic
-#endif
-
 #define TclUtfCharComplete Tcl_UtfCharComplete
 #define TclUtfNext Tcl_UtfNext
 #define TclUtfPrev Tcl_UtfPrev
 
-#if defined(TCL_NO_DEPRECATED)
 # define TclListObjGetElements 0
 # define TclListObjLength 0
 # define TclDictObjSize 0
@@ -121,101 +104,6 @@ static void uniCodePanic() {
 # define TclSplitPath 0
 # define TclFSSplitPath 0
 # define TclParseArgsObjv 0
-#else /* !defined(TCL_NO_DEPRECATED) */
-int TclListObjGetElements(Tcl_Interp *interp, Tcl_Obj *listPtr,
-    void *objcPtr, Tcl_Obj ***objvPtr) {
-    Tcl_Size n = TCL_INDEX_NONE;
-    int result = Tcl_ListObjGetElements(interp, listPtr, &n, objvPtr);
-    if (objcPtr) {
-	if ((sizeof(int) != sizeof(size_t)) && (result == TCL_OK) && (n > INT_MAX)) {
-	    if (interp) {
-		Tcl_AppendResult(interp, "List too large to be processed", NULL);
-	    }
-	    return TCL_ERROR;
-	}
-	*(int *)objcPtr = (int)n;
-    }
-    return result;
-}
-int TclListObjLength(Tcl_Interp *interp, Tcl_Obj *listPtr,
-    void *lengthPtr) {
-    Tcl_Size n = TCL_INDEX_NONE;
-    int result = Tcl_ListObjLength(interp, listPtr, &n);
-    if (lengthPtr) {
-	if ((sizeof(int) != sizeof(size_t)) && (result == TCL_OK) && (n > INT_MAX)) {
-	    if (interp) {
-		Tcl_AppendResult(interp, "List too large to be processed", NULL);
-	    }
-	    return TCL_ERROR;
-	}
-	*(int *)lengthPtr = (int)n;
-    }
-    return result;
-}
-int TclDictObjSize(Tcl_Interp *interp, Tcl_Obj *dictPtr,
-    void *sizePtr) {
-    Tcl_Size n = TCL_INDEX_NONE;
-    int result = Tcl_DictObjSize(interp, dictPtr, &n);
-    if (sizePtr) {
-	if ((sizeof(int) != sizeof(size_t)) && (result == TCL_OK) && (n > INT_MAX)) {
-	    if (interp) {
-		Tcl_AppendResult(interp, "Dict too large to be processed", NULL);
-	    }
-	    return TCL_ERROR;
-	}
-	*(int *)sizePtr = (int)n;
-    }
-    return result;
-}
-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);
-    if (argcPtr) {
-	if ((sizeof(int) != sizeof(size_t)) && (result == TCL_OK) && (n > INT_MAX)) {
-	    if (interp) {
-		Tcl_AppendResult(interp, "List too large to be processed", NULL);
-	    }
-	    Tcl_Free((void *)*argvPtr);
-	    return TCL_ERROR;
-	}
-	*(int *)argcPtr = (int)n;
-    }
-    return result;
-}
-void TclSplitPath(const char *path, void *argcPtr, const char ***argvPtr) {
-    Tcl_Size n = TCL_INDEX_NONE;
-    Tcl_SplitPath(path, &n, argvPtr);
-    if (argcPtr) {
-	if ((sizeof(int) != sizeof(size_t)) && (n > INT_MAX)) {
-	    n = TCL_INDEX_NONE; /* No other way to return an error-situation */
-	    Tcl_Free((void *)*argvPtr);
-	    *argvPtr = NULL;
-	}
-	*(int *)argcPtr = (int)n;
-    }
-}
-Tcl_Obj *TclFSSplitPath(Tcl_Obj *pathPtr, void *lenPtr) {
-    Tcl_Size n = TCL_INDEX_NONE;
-    Tcl_Obj *result = Tcl_FSSplitPath(pathPtr, &n);
-    if (lenPtr) {
-	if ((sizeof(int) != sizeof(size_t)) && result && (n > INT_MAX)) {
-	    Tcl_DecrRefCount(result);
-	    return NULL;
-	}
-	*(int *)lenPtr = (int)n;
-    }
-    return result;
-}
-int TclParseArgsObjv(Tcl_Interp *interp,
-	const Tcl_ArgvInfo *argTable, void *objcPtr, Tcl_Obj *const *objv,
-	Tcl_Obj ***remObjv) {
-    Tcl_Size n = (*(int *)objcPtr < 0) ? TCL_INDEX_NONE: (Tcl_Size)*(int *)objcPtr ;
-    int result = Tcl_ParseArgsObjv(interp, argTable, &n, objv, remObjv);
-    *(int *)objcPtr = (int)n;
-    return result;
-}
-#endif /* !defined(TCL_NO_DEPRECATED) */
 
 #define TclBN_mp_add mp_add
 #define TclBN_mp_add_d mp_add_d

generic/tclTest.c

@@ -515,9 +515,6 @@ static const char version[] = TCL_PATCH_LEVEL "+" STRINGIFY(TCL_VERSION_UUID)
 #ifdef STATIC_BUILD
 	    ".static"
 #endif
-#if TCL_UTF_MAX < 4
-	    ".utf-16"
-#endif
 ;
 
 int
@@ -546,12 +543,10 @@ Tcltest_Init(
     }
 
     if (Tcl_GetCommandInfo(interp, "::tcl::build-info", &info)) {
-#if TCL_MAJOR_VERSION > 8
 	if (info.isNativeObjectProc == 2) {
 	    Tcl_CreateObjCommand2(interp, "::tcl::test::build-info",
 		    info.objProc2, (void *)version, NULL);
     } else
-#endif
 	Tcl_CreateObjCommand(interp, "::tcl::test::build-info",
 		info.objProc, (void *)version, NULL);
     }
@@ -732,6 +727,12 @@ Tcltest_Init(
     if (TclObjTest_Init(interp) != TCL_OK) {
 	return TCL_ERROR;
     }
+    if (TcltestObjectInterfaceInit(interp) != TCL_OK) {
+	return TCL_ERROR;
+    }
+    if (TcltestObjectInterfaceListIntegerInit(interp) != TCL_OK) {
+	return TCL_ERROR;
+    }
     if (Procbodytest_Init(interp) != TCL_OK) {
 	return TCL_ERROR;
     }
@@ -810,12 +811,10 @@ Tcltest_SafeInit(
 	return TCL_ERROR;
     }
     if (Tcl_GetCommandInfo(interp, "::tcl::build-info", &info)) {
-#if TCL_MAJOR_VERSION > 8
 	if (info.isNativeObjectProc == 2) {
 	    Tcl_CreateObjCommand2(interp, "::tcl::test::build-info",
 		    info.objProc2, (void *)version, NULL);
     } else
-#endif
 	Tcl_CreateObjCommand(interp, "::tcl::test::build-info",
 		info.objProc, (void *)version, NULL);
     }
@@ -5758,17 +5757,7 @@ TestbytestringObjCmd(
     Tcl_Obj *const objv[])	/* The argument objects. */
 {
     struct {
-#if !defined(TCL_NO_DEPRECATED)
-#   if defined(_MSC_VER) && !defined(NDEBUG)
-#	pragma warning(disable:4133)
-#   elif defined(__clang__)
-#	pragma clang diagnostic push
-#	pragma clang diagnostic ignored "-Wincompatible-pointer-types"
-#   endif
-	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;

generic/tclTestObj.c

@@ -974,12 +974,16 @@ TestlistobjCmd(
 		!= TCL_OK) {
 		return TCL_ERROR;
 	    }
-	    if (objP->refCount <= 0) {
-		Tcl_SetObjResult(interp, Tcl_NewStringObj(
-			"Tcl_ListObjIndex returned object with ref count <= 0",
-			TCL_INDEX_NONE));
-		/* Keep looping since we are also looping for leaks */
-	    }
+	    Tcl_IncrRefCount(objP);
+	    Tcl_DecrRefCount(objP);
+	    TCL_COMMENT(
+		if (objP->refCount <= 0) {
+		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			    "Tcl_ListObjIndex returned object with ref count <= 0",
+			    TCL_INDEX_NONE));
+		    /* Keep looping since we are also looping for leaks */
+		}
+	    )
 	}
 	break;
 

generic/tclTestObjInterface.c

@@ -0,0 +1,530 @@
+/*
+ * tclTestObjInterface.c --
+ *
+ *	This file contains C command functions for the additional Tcl commands
+ *	that are used for testing implementations of the Tcl object types.
+ *	These commands are not normally included in Tcl applications; they're
+ *	only used for testing.
+ *
+ * Copyright © 2021 Nathan Coulter
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tcl.h"
+#include "tclInt.h"
+
+/*
+ * Prototypes for functions defined later in this file:
+ */
+typedef struct indexHex {
+    int refCount;
+    Tcl_Size offset;
+} indexHex;
+
+
+int TcltestObjectInterfaceInit(Tcl_Interp *interp);
+
+int NewTestIndexHex (
+    ClientData, Tcl_Interp *interp, Tcl_Size argc, Tcl_Obj *const objv[]);
+static void		DupTestIndexHexInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
+static void		FreeTestIndexHexInternalRep(Tcl_Obj *objPtr);
+static int		SetTestIndexHexFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
+static void		UpdateStringOfTestIndexHex(Tcl_Obj *listPtr);
+
+static int indexHexListStringIndex (tclObjTypeInterfaceArgsStringIndex);
+static int indexHexListStringIndexEnd(tclObjTypeInterfaceArgsStringIndexEnd);
+static Tcl_Size indexHexListStringLength(tclObjTypeInterfaceArgsStringLength);
+static int indexHexStringListIndexFromStringIndex(
+    Tcl_Size *index, Tcl_Size *itemchars, Tcl_Size *totalitems);
+static Tcl_Obj* indexHexListStringRange(tclObjTypeInterfaceArgsStringRange);
+static Tcl_Obj* indexHexListStringRangeEnd(tclObjTypeInterfaceArgsStringRangeEnd);
+ 
+static int indexHexListObjGetElements (tclObjTypeInterfaceArgsListAll);
+static int indexHexListObjAppendElement (tclObjTypeInterfaceArgsListAppend);
+static int indexHexListObjAppendList (tclObjTypeInterfaceArgsListAppendList);
+static int indexHexListObjIndex (tclObjTypeInterfaceArgsListIndex);
+static int indexHexListObjIndexEnd (tclObjTypeInterfaceArgsListIndexEnd);
+static int indexHexListObjIsSorted(tclObjTypeInterfaceArgsListIsSorted);
+static int indexHexListObjLength (tclObjTypeInterfaceArgsListLength);
+static Tcl_Obj* indexHexListObjRange (tclObjTypeInterfaceArgsListRange);
+static Tcl_Obj* indexHexListObjRangeEnd (tclObjTypeInterfaceArgsListRangeEnd);
+static int indexHexListObjReplace (tclObjTypeInterfaceArgsListReplace);
+static int indexHexListObjSetElement (tclObjTypeInterfaceArgsListSet);
+static Tcl_Obj * indexHexLsetFlat (tclObjTypeInterfaceArgsListSetList);
+
+static int indexHexListErrorIndeterminate (Tcl_Interp *interp);
+static int indexHexListErrorReadOnly (Tcl_Interp *interp);
+
+
+
+ObjInterface IndexHexInterface = {
+    1,
+    {
+	&indexHexListStringIndex,
+	&indexHexListStringIndexEnd,
+	&indexHexListStringLength,
+	&indexHexListStringRange,
+	&indexHexListStringRangeEnd
+    },
+    {
+	&indexHexListObjGetElements,
+	&indexHexListObjAppendElement,
+	&indexHexListObjAppendList,
+	&indexHexListObjIndex,
+	&indexHexListObjIndexEnd,
+	&indexHexListObjIsSorted,
+	&indexHexListObjLength,
+	&indexHexListObjRange,
+	&indexHexListObjRangeEnd,
+	&indexHexListObjReplace,
+	NULL,
+	NULL,
+	&indexHexListObjSetElement,
+	&indexHexLsetFlat
+    }
+};
+
+
+const ObjectType testIndexHexType = {
+    "testindexHex",
+    FreeTestIndexHexInternalRep,	/* freeIntRepProc */
+    DupTestIndexHexInternalRep,		/* dupIntRepProc */
+    UpdateStringOfTestIndexHex,		/* updateStringProc */
+    SetTestIndexHexFromAny,		/* setFromAnyProc */
+    2,
+    (Tcl_ObjInterface *)&IndexHexInterface
+};
+
+const Tcl_ObjType *testIndexHexTypePtr = (Tcl_ObjType *)&testIndexHexType;
+
+
+int TcltestObjectInterfaceInit(Tcl_Interp *interp) {
+    Tcl_CreateObjCommand2(interp, "testindexhex", NewTestIndexHex, NULL, NULL);
+    return TCL_OK;
+}
+
+
+
+int NewTestIndexHex (
+    TCL_UNUSED(void *),
+    Tcl_Interp *interp,
+    Tcl_Size argc,
+    Tcl_Obj *const objv[])
+{
+    Tcl_WideInt offset;
+    Tcl_ObjInternalRep intrep;
+    if (argc > 2) {
+	if (interp != NULL) {
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj("too many arguments", -1));
+	    return TCL_ERROR;
+	}
+    }
+    if (argc == 2) {
+	if (Tcl_GetWideIntFromObj(interp, objv[1], &offset) != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	if (offset < 0) {
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj("bad offset", -1));
+	    return TCL_ERROR;
+	}
+    }  else {
+	offset = 0;
+    }
+    Tcl_Obj *objPtr = Tcl_NewObj();
+    Tcl_InvalidateStringRep(objPtr);
+
+    indexHex *indexHexPtr = (indexHex *)Tcl_Alloc(sizeof(indexHex));
+    indexHexPtr->refCount = 1;
+    indexHexPtr->offset = offset;
+    intrep.twoPtrValue.ptr1 = indexHexPtr;
+    Tcl_StoreInternalRep(objPtr, testIndexHexTypePtr, &intrep);
+    Tcl_SetObjResult(interp, objPtr);
+    return TCL_OK;
+}
+
+
+static void
+DupTestIndexHexInternalRep(
+    TCL_UNUSED(Tcl_Obj *),
+    TCL_UNUSED(Tcl_Obj *))
+{
+    return;
+}
+
+
+static void
+FreeTestIndexHexInternalRep(Tcl_Obj *objPtr)
+{
+    indexHex *indexHexPtr = (indexHex *)objPtr->internalRep.twoPtrValue.ptr1;
+    if (--indexHexPtr->refCount == 0) {
+	Tcl_Free(indexHexPtr);
+    }
+    return;
+}
+
+
+static int
+SetTestIndexHexFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr)
+{
+    if (TclHasInternalRep(objPtr, testIndexHexTypePtr)) {
+	return TCL_OK;
+    } else {
+	if (interp != NULL) {
+	    Tcl_SetObjResult(interp,
+		Tcl_NewStringObj("can not set an existing value to this type", -1));
+	}
+	return TCL_ERROR;
+    }
+}
+
+
+static void
+UpdateStringOfTestIndexHex(
+    TCL_UNUSED(Tcl_Obj *))
+{
+    return;
+}
+
+
+static int indexHexListStringIndex(tclObjTypeInterfaceArgsStringIndex) {
+    Tcl_Obj *hexPtr;
+    int status;
+    Tcl_Size itemchars, totalitems;
+
+    status = indexHexStringListIndexFromStringIndex(
+	&index, &itemchars, &totalitems);
+    if (status != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    status = indexHexListObjIndex(interp, objPtr, totalitems, &hexPtr);
+    if (status != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    if (index == itemchars - 1) {
+	/* index refers to the space delimiter after the item. */
+	*objPtrPtr = Tcl_NewStringObj(" ", -1);
+    } else {
+	*objPtrPtr = Tcl_GetRange(hexPtr, index, index);
+    }
+    Tcl_DecrRefCount(hexPtr);
+    return status;
+}
+
+
+static int indexHexListErrorIndeterminate (Tcl_Interp *interp) {
+    Tcl_SetObjResult(interp,
+	Tcl_NewStringObj("list length indeterminate", -1));
+    Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", "INDETERMINATE", NULL);
+    return TCL_ERROR;
+}
+
+
+static int indexHexListErrorReadOnly (Tcl_Interp *interp) {
+    if (interp != NULL) {
+	Tcl_SetObjResult(interp,
+	    Tcl_NewStringObj("list length indeterminate", -1));
+	Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", "INTERFACE",
+	    "READONLY", NULL);
+    }
+    return TCL_ERROR;
+}
+
+
+static int indexHexStringListIndexFromStringIndex(
+    Tcl_Size *indexPtr, Tcl_Size *itemcharsPtr, Tcl_Size *totalitemsPtr)
+{
+    Tcl_Size itemoffset, last = 0, power = 1, lasttotalchars = 0, newitems,
+       top, totalchars = 0;
+
+    /* add 1 for the space after the item */
+    *itemcharsPtr = power + 1;
+    *totalitemsPtr = 0;
+
+    /* Count the number of characters in the items that contain fewer
+     * characters than the item containing the requested index. */
+    while (1) {
+	top = 1u << (4 * power);
+	if (top < 1u << (4 * (power - 1))) {
+	    /* operation wrapped around */
+	    power -= 1;
+	    break;
+	}
+	newitems = top - last;
+	lasttotalchars = totalchars;
+	totalchars += newitems * *itemcharsPtr;
+	last = top;
+	if (*indexPtr < totalchars) {
+	    break;
+	}
+	power += 1;
+	*itemcharsPtr += 1;
+	*totalitemsPtr += newitems;
+    }
+
+    *indexPtr -= lasttotalchars;
+    /* Determine how many items containing the same number of characters
+     * precede the requested item. */
+    itemoffset = *indexPtr / *itemcharsPtr ;
+    *indexPtr = *indexPtr % *itemcharsPtr;
+    /* Add the number of new characters. */
+    *totalitemsPtr += itemoffset;
+    return TCL_OK;
+}
+
+
+static int indexHexListStringIndexEnd(
+    Tcl_Interp *interp,	
+    TCL_UNUSED(Tcl_Obj *),
+    TCL_UNUSED(Tcl_Size),
+    TCL_UNUSED(Tcl_Obj **)
+) {
+    return indexHexListErrorIndeterminate(interp);
+}
+
+static Tcl_Size indexHexListStringLength(
+    TCL_UNUSED(Tcl_Obj *);
+) {
+    return TCL_INDEX_NONE;
+}
+
+static Tcl_Obj* indexHexListStringRange(tclObjTypeInterfaceArgsStringRange) {
+    Tcl_Obj *itemPtr, *item2Ptr, *resPtr;
+    Tcl_Size index = first, status;
+    Tcl_Size itemchars, needed, rangeLength, newStringLength,
+       stringLength, totalitems;
+
+    if (last < first) {
+	return Tcl_NewStringObj("", -1);
+    }
+
+    status = indexHexStringListIndexFromStringIndex(
+	&index, &itemchars, &totalitems);
+    if (status != TCL_OK) {
+	return NULL;
+    }
+
+    status = indexHexListObjIndex(NULL, objPtr, totalitems, &itemPtr);
+    if (status != TCL_OK) {
+	return NULL;
+    }
+
+    rangeLength = last - first + 1;
+
+    resPtr = Tcl_GetRange(itemPtr, index, index + rangeLength - 1);
+    Tcl_DecrRefCount(itemPtr);
+
+    stringLength = Tcl_GetCharLength(resPtr);
+    if (stringLength < rangeLength) {
+	needed = rangeLength - stringLength;
+	while (needed > 0) {
+	    totalitems++;
+	    status = indexHexListObjIndex(NULL, objPtr, totalitems, &itemPtr);
+	    if (status != TCL_OK) {
+		return NULL;
+	    }
+	    Tcl_AppendToObj(resPtr, " ", 1);
+	    stringLength += newStringLength;
+	    needed -= 1;
+	    if (needed > 0) {
+		newStringLength = Tcl_GetCharLength(itemPtr);
+		if (newStringLength >= needed) {
+		    item2Ptr = Tcl_GetRange(itemPtr, 0, needed-1);
+		    newStringLength = Tcl_GetCharLength(item2Ptr);
+		    Tcl_AppendObjToObj(resPtr, item2Ptr);
+		    Tcl_DecrRefCount(item2Ptr);
+		} else {
+		    Tcl_AppendObjToObj(resPtr, itemPtr);
+		}
+		stringLength += newStringLength;
+		needed -= newStringLength;
+	    }
+	    Tcl_DecrRefCount(itemPtr);
+	}
+    }
+    return resPtr;
+}
+
+static Tcl_Obj* indexHexListStringRangeEnd(
+    TCL_UNUSED(Tcl_Obj *),/* The Tcl object to find the range of. */
+    TCL_UNUSED(Tcl_Size),/* First index of the range. */
+    TCL_UNUSED(Tcl_Size) /* Last index of the range. */
+) {
+    return NULL;
+}
+
+
+
+static int
+indexHexListObjGetElements(
+    Tcl_Interp *interp,	/* Used to report errors if not NULL. */
+    TCL_UNUSED(Tcl_Obj *),/* List object for which an element array
+			   * is to be returned. */
+    TCL_UNUSED(Tcl_Size *),/* Where to store the count of objects
+			    * referenced by objv. */
+    TCL_UNUSED(Tcl_Obj ***)/* Where to store the pointer to an
+			    * array of */
+)
+{
+    if (interp != NULL) {
+	Tcl_SetObjResult(interp,Tcl_NewStringObj("infinite list", -1));
+    }
+    return TCL_ERROR;
+}
+
+
+static int
+indexHexListObjAppendElement(
+    Tcl_Interp *interp,	/* Used to report errors if not NULL. */
+    TCL_UNUSED(Tcl_Obj *),/* List object to append objPtr to. */
+    TCL_UNUSED(Tcl_Obj *)/* Object to append to listPtr's list. */
+)
+{
+    indexHexListErrorReadOnly(interp);
+    return TCL_ERROR;
+}
+
+
+static int
+indexHexListObjAppendList(
+    Tcl_Interp *interp,	    /* Used to report errors if not NULL. */
+    TCL_UNUSED(Tcl_Obj *),  /* List object to append elements to. */
+    TCL_UNUSED(Tcl_Obj *)   /* List obj with elements to append. */
+)
+{
+    indexHexListErrorReadOnly(interp);
+    return TCL_ERROR;
+}
+
+
+static int
+indexHexListObjIndex(
+    TCL_UNUSED(Tcl_Interp *),/* Used to report errors if not NULL. */ \
+    TCL_UNUSED(Tcl_Obj *),	/* List object to index into. */ \
+    Tcl_Size index,	/* Index of element to return. */ \
+    Tcl_Obj **objPtrPtr	/* The resulting Tcl_Obj* is stored here. */
+)
+{
+    Tcl_Obj *resPtr;
+    resPtr = Tcl_ObjPrintf("%" TCL_T_MODIFIER "x", index);
+    *objPtrPtr = resPtr;
+    return TCL_OK;
+}
+
+
+static int
+indexHexListObjIndexEnd(
+    Tcl_Interp * interp,/* Used to report errors if not NULL. */ \
+    TCL_UNUSED(Tcl_Obj *),/* List object to index into. */ \
+    TCL_UNUSED(Tcl_Size),/* Index of element to return. */ \
+    TCL_UNUSED(Tcl_Obj **)/* The resulting Tcl_Obj* is stored here. */
+)
+{
+    return indexHexListErrorIndeterminate(interp);
+}
+
+
+static int indexHexListObjIsSorted(
+    TCL_UNUSED(Tcl_Interp *), /* Used to report errors */
+    TCL_UNUSED(Tcl_Obj *),	/* The list in question */
+    TCL_UNUSED(size_t) /* flags */
+)
+{
+    return 1;
+}
+
+
+static int
+indexHexListObjLength(
+    TCL_UNUSED(Tcl_Interp *),	/* Used to report errors if not NULL. */
+    TCL_UNUSED(Tcl_Obj *),	/* List object whose #elements to return. */
+    Tcl_Size *lenPtr		/* The resulting length is stored here. */
+)
+{
+    *lenPtr = -1;
+    return TCL_OK;
+}
+
+
+static Tcl_Obj*
+indexHexListObjRange(tclObjTypeInterfaceArgsListRange)
+{
+    Tcl_Obj *itemPtr, *resPtr;
+    Tcl_Size length;
+    int status;
+    resPtr = Tcl_NewListObj(0, NULL);
+    status = Tcl_ListObjLength(interp, listObj, &length);
+    if (!status) {
+	return NULL;
+    }
+    while (rangeStart <= length && rangeStart <= rangeEnd) {
+	indexHexListObjIndex(interp, listObj, rangeStart, &itemPtr);
+	if (
+	    Tcl_ListObjAppendElement(interp, resPtr, itemPtr) != TCL_OK
+	) {
+	    Tcl_DecrRefCount(resPtr);
+	    return NULL;
+	}
+	rangeStart++;
+    }
+    return resPtr;
+}
+
+
+static Tcl_Obj*
+indexHexListObjRangeEnd(tclObjTypeInterfaceArgsListRangeEnd) {
+    if (fromAnchor == 1 || toAnchor == 1) {
+	indexHexListErrorIndeterminate(interp);
+	return NULL;
+    }
+    return indexHexListObjRange(interp, listPtr, fromIdx, toIdx);
+}
+
+
+static int
+indexHexListObjReplace(
+    Tcl_Interp *interp, /* Used for error reporting if not NULL. */ \
+    TCL_UNUSED(Tcl_Obj *),   /* List object whose elements to replace. */ \
+    TCL_UNUSED(Tcl_Size),     /* Index of first element to replace. */ \
+    TCL_UNUSED(Tcl_Size),	/* Number of elements to replace. */ \
+    TCL_UNUSED(Tcl_Size),	/* Number of objects to insert. */ \
+        		/* An array of objc pointers to Tcl \
+        		 * objects to insert. */ \
+    TCL_UNUSEDVAR(Tcl_Obj *const insertObjs[])
+)
+{
+    indexHexListErrorReadOnly(interp);
+    return TCL_ERROR;
+}
+
+
+static int
+indexHexListObjSetElement(
+    Tcl_Interp *interp,		/* Tcl interpreter; used for error reporting
+				 * if not NULL. */
+    TCL_UNUSED(Tcl_Obj *),	/* List object in which element should be
+				 * stored. */
+    TCL_UNUSED(Tcl_Size),	/* Index of element to store. */
+    TCL_UNUSED(Tcl_Obj *)/* Tcl object to store in the designated list 
+				 * element. */
+)
+{
+    indexHexListErrorReadOnly(interp);
+    return TCL_ERROR;
+}
+
+
+static Tcl_Obj * indexHexLsetFlat (
+    Tcl_Interp *interp,		/* Tcl interpreter. */ \
+    TCL_UNUSED(Tcl_Obj *),	/* Pointer to the list being modified. */ \
+    TCL_UNUSED(Tcl_Size),	/* Number of index args. */ \
+    TCL_UNUSEDVAR(Tcl_Obj *const indexArray[]),	/* Index args. */ \
+    TCL_UNUSED(Tcl_Obj *)   /* Value arg to 'lset' or NULL to 'lpop'. */
+)
+{
+    indexHexListErrorReadOnly(interp);
+    return NULL;
+}

generic/tclTestObjInterfaceInteger.c

@@ -0,0 +1,683 @@
+/*
+ * tclTestObjInterfce.c --
+ *
+ *	This file contains C command functions for the additional Tcl commands
+ *	that are used for testing implementations of the Tcl object types.
+ *	These commands are not normally included in Tcl applications; they're
+ *	only used for testing.
+ *
+ * Copyright © 2021 Nathan Coulter
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include "tcl.h"
+#include "tclInt.h"
+
+/*
+ * Prototypes for functions defined later in this file:
+ */
+int TestListInteger (
+    ClientData, Tcl_Interp *interp, Tcl_Size argc, Tcl_Obj *const objv[]);
+static Tcl_Obj* NewTestListInteger();
+static void	DupTestListIntegerInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
+
+static void	FreeTestListIntegerInternalRep(Tcl_Obj *objPtr);
+static int	SetTestListIntegerFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
+static void	UpdateStringOfTestListInteger(Tcl_Obj *listPtr);
+
+static int ListIntegerListStringIndex (tclObjTypeInterfaceArgsStringIndex);
+static int ListIntegerListStringIndexEnd(tclObjTypeInterfaceArgsStringIndexEnd);
+static Tcl_Size ListIntegerListStringLength(tclObjTypeInterfaceArgsStringLength);
+/*
+static int ListIntegerStringListIndexFromStringIndex(
+    Tcl_Size *index, Tcl_Size *itemchars, Tcl_Size *totalitems);
+*/
+static Tcl_Obj* ListIntegerListStringRange(tclObjTypeInterfaceArgsStringRange);
+static Tcl_Obj* ListIntegerListStringRangeEnd(tclObjTypeInterfaceArgsStringRangeEnd);
+
+static int ListIntegerListObjGetElements(tclObjTypeInterfaceArgsListAll);
+static int ListIntegerListObjAppendElement(tclObjTypeInterfaceArgsListAppend);
+static int ListIntegerListObjAppendList(tclObjTypeInterfaceArgsListAppendList);
+static int ListIntegerListObjIndex(tclObjTypeInterfaceArgsListIndex);
+static int ListIntegerListObjIndexEnd (tclObjTypeInterfaceArgsListIndexEnd);
+static int ListIntegerListObjIsSorted(tclObjTypeInterfaceArgsListIsSorted);
+static int ListIntegerListObjLength(tclObjTypeInterfaceArgsListLength);
+static Tcl_Obj* ListIntegerListObjRange(tclObjTypeInterfaceArgsListRange);
+static Tcl_Obj* ListIntegerListObjRangeEnd(tclObjTypeInterfaceArgsListRangeEnd);
+static int ListIntegerListObjReplace(tclObjTypeInterfaceArgsListReplace);
+static int ListIntegerListObjReplaceList(tclObjTypeInterfaceArgsListReplaceList);
+static int ListIntegerListObjSetElement(tclObjTypeInterfaceArgsListSet);
+static Tcl_Obj * ListIntegerLsetFlat(tclObjTypeInterfaceArgsListSetList);
+
+static int ErrorMaxElementsExceeded(Tcl_Interp *interp);
+
+
+ObjInterface ListIntegerInterface = {
+    1,
+    {
+	&ListIntegerListStringIndex,
+	&ListIntegerListStringIndexEnd,
+	&ListIntegerListStringLength,
+	&ListIntegerListStringRange,
+	&ListIntegerListStringRangeEnd
+    },
+    {
+	&ListIntegerListObjGetElements,
+	&ListIntegerListObjAppendElement,
+	&ListIntegerListObjAppendList,
+	&ListIntegerListObjIndex,
+	&ListIntegerListObjIndexEnd,
+	&ListIntegerListObjIsSorted,
+	&ListIntegerListObjLength,
+	&ListIntegerListObjRange,
+	&ListIntegerListObjRangeEnd,
+	&ListIntegerListObjReplace,
+	&ListIntegerListObjReplaceList,
+	NULL,
+	&ListIntegerListObjSetElement,
+	&ListIntegerLsetFlat
+    }
+};
+
+
+typedef struct ListInteger {
+    int refCount;
+    int ownstring;
+    int size;
+    int used;
+    int values[1];
+} ListInteger;
+
+
+static ListInteger* NewTestListIntegerIntrep();
+static ListInteger* ListGetInternalRep(Tcl_Obj *listPtr);
+static void ListIntegerDecrRefCount(ListInteger *listIntegerPtr);
+
+const ObjectType testListIntegerType = {
+    "testListInteger",
+    FreeTestListIntegerInternalRep,	/* freeIntRepProc */
+    DupTestListIntegerInternalRep,		/* dupIntRepProc */
+    UpdateStringOfTestListInteger,		/* updateStringProc */
+    SetTestListIntegerFromAny,		/* setFromAnyProc */
+    2,
+    (Tcl_ObjInterface *)&ListIntegerInterface
+};
+
+const Tcl_ObjType *testListIntegerTypePtr = (Tcl_ObjType *)&testListIntegerType;
+
+
+
+int TcltestObjectInterfaceListIntegerInit(Tcl_Interp *interp) {
+    Tcl_CreateObjCommand2(interp, "testlistinteger", TestListInteger, NULL, NULL);
+    return TCL_OK;
+}
+
+int TestListInteger(
+    TCL_UNUSED(void *),
+    Tcl_Interp *interp,
+    Tcl_Size argc,
+    Tcl_Obj *const objv[])
+{
+    int status;
+    if (argc != 2) {
+	if (interp != NULL) {
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj("wrong # arguments", -1));
+	}
+	return TCL_ERROR;
+    }
+    status = Tcl_ConvertToType(interp, objv[1], testListIntegerTypePtr);
+    Tcl_SetObjResult(interp, objv[1]);
+    return status;
+}
+
+
+Tcl_Obj*
+NewTestListInteger() {
+    Tcl_ObjInternalRep intrep;
+    Tcl_Obj *listPtr = Tcl_NewObj();
+    Tcl_InvalidateStringRep(listPtr);
+    ListInteger *listIntegerPtr = NewTestListIntegerIntrep();
+    intrep.twoPtrValue.ptr1 = listIntegerPtr;
+    Tcl_StoreInternalRep(listPtr, testListIntegerTypePtr, &intrep);
+    return listPtr;
+}
+
+
+ListInteger*
+NewTestListIntegerIntrep() {
+    ListInteger *listIntegerPtr = (ListInteger *)Tcl_Alloc(sizeof(ListInteger));
+    listIntegerPtr->refCount = 1;
+    listIntegerPtr->ownstring = 0;
+    listIntegerPtr->size = 1;
+    listIntegerPtr->used = 0;
+    return listIntegerPtr;
+}
+
+static ListInteger* ListGetInternalRep(Tcl_Obj *listPtr) {
+    return (ListInteger *)listPtr->internalRep.twoPtrValue.ptr1;
+}
+
+
+
+
+static void DupTestListIntegerInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr) {
+    Tcl_ObjInternalRep intrep;
+    ListInteger *listRepPtr = ListGetInternalRep(srcPtr);
+    listRepPtr->refCount++;
+    intrep.twoPtrValue.ptr1 = listRepPtr;
+    Tcl_StoreInternalRep(copyPtr, testListIntegerTypePtr, &intrep);
+    return;
+}
+
+static void FreeTestListIntegerInternalRep(Tcl_Obj *listPtr) {
+    ListInteger *listRepPtr = ListGetInternalRep(listPtr);
+    ListIntegerDecrRefCount(listRepPtr);
+    return;
+}
+
+static int SetTestListIntegerFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr) {
+    int status;
+    Tcl_Size i, length;
+    Tcl_Obj *itemPtr, *listPtr;
+    Tcl_ObjInternalRep intrep;
+    ListInteger *listRepPtr;
+    if (TclHasInternalRep(objPtr, testListIntegerTypePtr)) {
+	return TCL_OK;
+    } else {
+	status = Tcl_ListObjLength(interp, objPtr, &length);
+	if (status != TCL_OK) {
+	    return TCL_ERROR;
+	}
+	listPtr = NewTestListInteger();
+	for (i = 0; i < length; i++) {
+	    status = Tcl_ListObjIndex(interp, objPtr, i, &itemPtr);
+	    if (status != TCL_OK) {
+		Tcl_DecrRefCount(listPtr);
+		return status;
+	    }
+	    status = ListIntegerListObjReplace(interp, listPtr, i, 0, 1, &itemPtr);
+	    if (status != TCL_OK) {
+		Tcl_DecrRefCount(listPtr);
+		return status;
+	    }
+	}
+	listRepPtr = ListGetInternalRep(listPtr);
+	intrep.twoPtrValue.ptr1 = listRepPtr;
+	listRepPtr->refCount++;
+	Tcl_StoreInternalRep(objPtr, testListIntegerTypePtr, &intrep);
+	Tcl_DecrRefCount(listPtr);
+	return TCL_OK;
+    }
+}
+
+static void UpdateStringOfTestListInteger(Tcl_Obj *listPtr) {
+    ListInteger *listRepPtr = ListGetInternalRep(listPtr);
+    int i, num, used = listRepPtr->used;
+    Tcl_Obj *strPtr, *numObjPtr;
+    if (used > 0) {
+	strPtr = Tcl_NewObj();
+	Tcl_IncrRefCount(strPtr);
+	num = listRepPtr->values[0];
+	numObjPtr = Tcl_NewIntObj(num);
+	Tcl_IncrRefCount(numObjPtr);
+	Tcl_AppendFormatToObj(NULL, strPtr, "%d", 1, &numObjPtr);
+	Tcl_DecrRefCount(numObjPtr);
+	for (i = 1; i < used; i++) {
+	    num = listRepPtr->values[i];
+	    numObjPtr = Tcl_NewIntObj(num);
+	    Tcl_IncrRefCount(numObjPtr);
+	    Tcl_AppendFormatToObj(NULL, strPtr, " %d", 1, &numObjPtr);
+	    Tcl_DecrRefCount(numObjPtr);
+	}
+	listPtr->bytes = strPtr->bytes;
+	listPtr->length = strPtr->length;
+	strPtr->bytes = 0;
+	strPtr->length = 0;
+	Tcl_DecrRefCount(strPtr);
+    } else {
+	Tcl_InitStringRep(listPtr, NULL, 0);
+    }
+    listRepPtr->ownstring = 1;
+    return;
+}
+
+static void ListIntegerDecrRefCount(ListInteger *listIntegerPtr) {
+    if (--listIntegerPtr->refCount <= 0) {
+	Tcl_Free(listIntegerPtr);
+    }
+    return;
+}
+
+static int ListIntegerListStringIndex (
+    TCL_UNUSED(Tcl_Interp *),/* Used to report errors if not NULL. */ \
+    TCL_UNUSED(Tcl_Obj *),	/* List object to index into. */ \
+    TCL_UNUSED(Tcl_Size),	/* Index of element to return. */ \
+    TCL_UNUSED(Tcl_Obj **)/* The resulting Tcl_Obj* is stored here. */
+)
+{
+    return TCL_ERROR;
+}
+
+static int ListIntegerListStringIndexEnd(
+    TCL_UNUSED(Tcl_Interp *),/* Used to report errors if not NULL. */ \
+    TCL_UNUSED(Tcl_Obj *),/* List object to index into. */ \
+    TCL_UNUSED(Tcl_Size),/* Index of element to return. */ \
+    TCL_UNUSED(Tcl_Obj **)/* The resulting Tcl_Obj* is stored here. */
+) {
+    return TCL_ERROR;
+}
+
+static Tcl_Size ListIntegerListStringLength(
+    TCL_UNUSED(Tcl_Obj *);
+) {
+    return TCL_ERROR;
+}
+
+/*
+static int ListIntegerStringListIndexFromStringIndex(
+    TCL_UNUSEDVAR(Tcl_Size *index),
+    TCL_UNUSEDVAR(Tcl_Size *itemchars),
+    TCL_UNUSEDVAR(Tcl_Size *totalitems)
+) {
+    return TCL_ERROR;
+}
+*/
+
+static Tcl_Obj* ListIntegerListStringRange(
+    TCL_UNUSEDVAR(Tcl_Obj *objPtr),	/* The Tcl object to find the range of. */
+    TCL_UNUSEDVAR(Tcl_Size first),	/* First index of the range. */
+    TCL_UNUSEDVAR(Tcl_Size last)	/* Last index of the range. */
+) {
+    return NULL;
+}
+
+static Tcl_Obj* ListIntegerListStringRangeEnd(
+    TCL_UNUSED(Tcl_Obj *),/* The Tcl object to find the range of. */
+    TCL_UNUSED(Tcl_Size),/* First index of the range. */
+    TCL_UNUSED(Tcl_Size) /* Last index of the range. */
+) {
+    return NULL;
+}
+
+static int ListIntegerListObjGetElements(
+    TCL_UNUSEDVAR(Tcl_Interp *interp),	/* Used to report errors if not NULL. */
+    TCL_UNUSEDVAR(Tcl_Obj *listPtr),	/* List object for which an element array
+					 * is to be returned. */
+    TCL_UNUSEDVAR(Tcl_Size *objcPtr),	/* Where to store the count of objects
+					 * referenced by objv. */
+    TCL_UNUSEDVAR(Tcl_Obj ***objvPtr)	/* Where to store the pointer to an
+					 * array of */
+) {
+    ListInteger *listRepPtr;
+    listRepPtr = ListGetInternalRep(listPtr);
+    *objcPtr = listRepPtr->used;
+    *objvPtr = listRepPtr->values;
+    return TCL_OK;
+}
+
+static int ListIntegerListObjAppendElement(tclObjTypeInterfaceArgsListAppend) {
+    int status;
+    Tcl_Size length;
+    status = Tcl_ListObjLength(interp, listPtr, &length);
+    if (status != TCL_OK) {
+	return TCL_ERROR;
+    }
+    return ListIntegerListObjReplace(interp, listPtr, length, 0, 1, &objPtr);
+}
+
+static int ListIntegerListObjAppendList(
+    TCL_UNUSEDVAR(Tcl_Interp *interp),	    /* Used to report errors if not NULL. */ \
+    TCL_UNUSEDVAR(Tcl_Obj *listPtr),	    /* List object to append elements to. */ \
+    TCL_UNUSEDVAR(Tcl_Obj *elemListPtr)    /* List obj with elements to append. */
+) {
+    return TCL_ERROR;
+}
+
+static int ListIntegerListObjIndex(
+    TCL_UNUSED(Tcl_Interp *),/* Used to report errors if not NULL. */ \
+    Tcl_Obj * listObj,/* List object to index into. */ \
+    Tcl_Size index,	/* Index of element to return. */ \
+    Tcl_Obj **objPtrPtr	/* The resulting Tcl_Obj* is stored here. */
+) {
+    ListInteger *listRepPtr = ListGetInternalRep(listObj);
+    Tcl_Size num;
+    if (index >= 0 && index < listRepPtr->used) {
+	num = listRepPtr->values[index];
+	*objPtrPtr = Tcl_NewLongObj(num);
+    } else {
+	*objPtrPtr = NULL;
+    }
+    return TCL_OK;
+}
+
+static int ListIntegerListObjIndexEnd(
+    TCL_UNUSED(Tcl_Interp *),/* Used to report errors if not NULL. */ \
+    TCL_UNUSED(Tcl_Obj *),/* List object to index into. */ \
+    TCL_UNUSED(Tcl_Size),/* Index of element to return. */ \
+    TCL_UNUSED(Tcl_Obj **)/* The resulting Tcl_Obj* is stored here. */
+) {
+    return TCL_ERROR;
+}
+
+static int ListIntegerListObjIsSorted(
+    TCL_UNUSED(Tcl_Interp *), /* Used to report errors */
+    TCL_UNUSED(Tcl_Obj *),	/* The list in question */
+    TCL_UNUSED(size_t) /* flags */
+) {
+    return TCL_ERROR;
+}
+
+static int ListIntegerListObjLength(
+    TCL_UNUSED(Tcl_Interp *),	/* Used to report errors if not NULL. */
+    Tcl_Obj * listObj,	/* List object whose #elements to return. */
+    Tcl_Size *lenPtr		/* The resulting length is stored here. */
+) {
+    ListInteger *listRepPtr = ListGetInternalRep(listObj);
+    *lenPtr = listRepPtr->used;
+    return TCL_OK;
+}
+
+static Tcl_Obj* ListIntegerListObjRange(tclObjTypeInterfaceArgsListRange) {
+    ListInteger *listRepPtr = ListGetInternalRep(listObj);
+    Tcl_Size i, j, num, used = listRepPtr->used;
+    Tcl_Obj *numObjPtr, *resPtr;
+
+    if ((rangeStart == 0 && rangeEnd >= used - 1) || used == 0) {
+	return listObj;
+    }
+
+    if (Tcl_IsShared(listObj) ||
+	((listRepPtr->refCount > 1))) {
+	if (rangeStart >= used || rangeEnd < rangeStart) {
+	    return Tcl_NewObj();
+	} else {
+	    resPtr = NewTestListInteger();
+	    for (i = rangeStart, j = 0; i <= rangeEnd; i++, j++) {
+		num = listRepPtr->values[i];
+		numObjPtr = Tcl_NewIntObj(num);
+		Tcl_IncrRefCount(numObjPtr);
+		if (ListIntegerListObjReplace(
+		    interp, resPtr, j , 0 , 1 ,&numObjPtr) != TCL_OK) {
+		    Tcl_DecrRefCount(resPtr);
+		    Tcl_DecrRefCount(numObjPtr);
+		    return NULL;
+		}
+		Tcl_DecrRefCount(numObjPtr);
+	    }
+	    return resPtr;
+	}
+    }
+    return NULL;
+}
+
+
+static Tcl_Obj* ListIntegerListObjRangeEnd(
+    TCL_UNUSEDVAR(Tcl_Interp * interp), /* Used to report errors */ \
+    TCL_UNUSEDVAR(Tcl_Obj *listPtr),	/* List object to take a range from. */ \
+    TCL_UNUSEDVAR(Tcl_Size fromAnchor),/* 0 for start and 1 for end */ \
+    TCL_UNUSEDVAR(Tcl_Size fromIdx),	/* Index of first element to include. */ \
+    TCL_UNUSEDVAR(Tcl_Size toAnchor),	/* 0 for start and 1 for end */  \
+    TCL_UNUSEDVAR(Tcl_Size toIdx)	/* Index of last element to include. */
+) {
+    return NULL;
+}
+
+
+static int ListIntegerListObjReplace(tclObjTypeInterfaceArgsListReplace) {
+    int i, status;
+    Tcl_Obj *tmpListPtr = Tcl_NewObj();
+    Tcl_IncrRefCount(tmpListPtr);
+    for (i = 0; i < numToInsert; i++) {
+	status = Tcl_ListObjAppendElement(interp, tmpListPtr, insertObjs[i]);
+	if (status != TCL_OK) {
+	    Tcl_DecrRefCount(tmpListPtr);
+	    return status;
+	}
+    }
+    status = ListIntegerListObjReplaceList(
+	interp, listObj, first, numToDelete, tmpListPtr);
+    Tcl_DecrRefCount(tmpListPtr);
+    return status;
+}
+
+
+static int ListIntegerListObjReplaceList(tclObjTypeInterfaceArgsListReplaceList) {
+    ListInteger *listRepPtr = ListGetInternalRep(listPtr);
+    ListInteger *newListRepPtr;
+    int changed = 0, itemInt, status;
+    Tcl_Size i, index, newmemsize, itemsLength, j, newsize,
+	     newtailindex, newused, size, newtailend, tailindex, tailsize,
+	     used;
+    Tcl_Obj *itemPtr;
+    size = listRepPtr->size;
+    used = listRepPtr->used;
+    if (first < used) {
+	tailsize = used - first;
+    } else {
+	tailsize = 0;
+    }
+
+    status = Tcl_ListObjLength(interp, newItemsPtr, &itemsLength);
+    if (status != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    /* Currently this duplicates checks found in of Tcl_ListObjReplace, but
+     * maybe in the future Tcl remove those checks
+    */
+
+    if (first >= used) {
+	first = used;
+    } else if (first < 0) {
+	first = 0;
+    }
+
+    if (count > tailsize) {
+	count = tailsize;
+    }
+
+    /* If count == 0 and itemsLength == 0 this routine is logically a no-op,
+     * but any non-canonical string representation must still be invalidated.
+     */ 
+
+    /* to do:
+     * Recode this routine to work with incoming of unbounded length
+     */
+
+    if (used > 0) {
+	tailindex = first + count;
+	newtailindex = first + itemsLength;
+	if (INT_MAX - tailsize - 1 < newtailindex) {
+	    return ErrorMaxElementsExceeded(interp);
+	}
+	newused = newtailindex + tailsize;
+	if (itemsLength > 0 && INT_MAX - itemsLength < newused) {
+	    return ErrorMaxElementsExceeded(interp);
+	}
+    } else {
+	tailindex = 0;
+	newtailindex = 0;
+	newused = itemsLength;
+    }
+
+    if (newused > size && newused > 1) {
+	newsize = (newused + newused / 5 + 1);
+	if (newsize < size) {
+	    return ErrorMaxElementsExceeded(interp);
+	}
+    } else {
+	newsize = size;
+    }
+
+    if (!listRepPtr->ownstring) {
+	/* schedule canonicalization of the string rep */
+	Tcl_InvalidateStringRep(listPtr);
+	listRepPtr->ownstring = 1;
+    }
+
+    if (newused < used) {
+	Tcl_InvalidateStringRep(listPtr);
+    }
+
+
+    newmemsize = sizeof(ListInteger) + newsize * sizeof(int) - sizeof(int);
+    if (listRepPtr->refCount > 1) {
+	Tcl_ObjInternalRep intrep;
+	/* copy only the structure and the head of the old array */
+	int movsize = sizeof(ListInteger)
+	    + ((first + 1)  * sizeof(int) - sizeof(int));
+	newListRepPtr = (ListInteger *)Tcl_Alloc(newmemsize);
+	memmove(newListRepPtr, listRepPtr, movsize);
+	newListRepPtr->size = newsize;
+	newListRepPtr->refCount = 1;
+	/* move the tail to its new location to make room for the new additions
+	*/
+	memmove(newListRepPtr->values + newtailindex,
+	    listRepPtr->values + tailindex, tailsize * sizeof(int));
+	intrep.twoPtrValue.ptr1 = newListRepPtr;
+	Tcl_StoreInternalRep(listPtr, testListIntegerTypePtr, &intrep);
+    } else {
+	if (newsize > size && newused > 1) {
+	    newListRepPtr = (ListInteger *)Tcl_Realloc(listRepPtr, newmemsize);
+	} else {
+	    newListRepPtr = listRepPtr;
+	}
+	newListRepPtr->size = newsize;
+	if (tailsize > 0 && tailindex != newtailindex) {
+	    /* move the tail to its new location to make room for the new
+	     * additions */
+	    memmove(newListRepPtr->values + newtailindex,
+		    newListRepPtr->values + tailindex, tailsize);
+	}
+	listPtr->internalRep.twoPtrValue.ptr1 = newListRepPtr;
+    }
+
+    i = -1;
+    while (1) {
+	i++;
+	index = first + i;
+	status = Tcl_ListObjIndex(interp, newItemsPtr, i, &itemPtr);
+	if (status != TCL_OK) {
+	    return status;
+	}
+	if (itemPtr == NULL) {
+	    break;
+	}
+	if (Tcl_GetIntFromObj(interp, itemPtr, &itemInt)
+	    == TCL_OK) {
+	    if (newListRepPtr->values[index] != itemInt) {
+		changed = 1;
+		newListRepPtr->values[index] = itemInt;
+	    }
+	    newListRepPtr->values[index] = itemInt;
+	} else {
+	    Tcl_Obj *realListPtr;
+	    /* Fall back to normal list */
+	    realListPtr = Tcl_NewListObj(newsize, NULL);
+	    Tcl_IncrRefCount(realListPtr);
+
+	    for (j = 0; j < index; j++) {
+		itemPtr = Tcl_NewIntObj(newListRepPtr->values[j]);
+		status = Tcl_ListObjAppendElement(
+		    interp, realListPtr, itemPtr);
+		if (status != TCL_OK) {
+		    Tcl_DecrRefCount(realListPtr);
+		    return status;
+		}
+	    }
+	    while (1) {
+		if (itemsLength == TCL_LENGTH_NONE) {
+		    status = Tcl_ListObjLength(interp, newItemsPtr, &itemsLength);
+		    if (status != TCL_OK) {
+			Tcl_DecrRefCount(realListPtr);
+			return status;
+		    }
+		}
+		if (itemsLength != TCL_LENGTH_NONE && i >= itemsLength) {
+		    break;
+		}
+		status = Tcl_ListObjIndex(interp, newItemsPtr, i, &itemPtr);
+		if (status != TCL_OK) {
+		    Tcl_DecrRefCount(realListPtr);
+		    return status;
+		}
+		if (itemPtr == NULL) {
+		    break;
+		}
+		status = Tcl_ListObjAppendElement(
+		    interp, realListPtr, itemPtr);
+		if (status != TCL_OK) {
+		    Tcl_DecrRefCount(realListPtr);
+		    return status;
+		}
+		i++;
+	    }
+
+	    newtailend = newtailindex + tailsize;
+	    for (i = newtailindex; i < newtailend; i++) {
+		itemPtr = Tcl_NewIntObj(newListRepPtr->values[i]);
+		Tcl_ListObjAppendElement(interp, realListPtr, itemPtr);
+		if (status != TCL_OK) {
+		    Tcl_DecrRefCount(realListPtr);
+		    return status;
+		}
+	    }
+
+	    ListIntegerDecrRefCount(newListRepPtr);
+	    listPtr->internalRep = realListPtr->internalRep;
+	    listPtr->typePtr = realListPtr->typePtr;
+	    realListPtr->typePtr = NULL;
+	    Tcl_DecrRefCount(realListPtr);
+	    /* this might not always be necessary, but probably the best that
+	     * can be done in this case */
+	    Tcl_InvalidateStringRep(listPtr);
+	    return TCL_OK;
+	}
+    }
+
+    if (changed) {
+	Tcl_InvalidateStringRep(listPtr);
+    }
+
+    /* To make the operation transactional, update "used" only after all
+     * elemnts have been succesfully added.
+    */
+    newListRepPtr->used = newused;
+    return TCL_OK;
+}
+
+
+static int ListIntegerListObjSetElement(
+    TCL_UNUSED(Tcl_Interp *),	/* Tcl interpreter; used for error reporting
+				 * if not NULL. */
+    TCL_UNUSED(Tcl_Obj *),	/* List object in which element should be
+				 * stored. */
+    TCL_UNUSED(Tcl_Size), 	/* Index of element to store. */
+    TCL_UNUSED(Tcl_Obj *)	/* Tcl object to store in the designated list 
+				 * element. */
+) {
+    return TCL_ERROR;
+}
+
+
+static Tcl_Obj * ListIntegerLsetFlat(
+    TCL_UNUSED(Tcl_Interp *),	    /* Tcl interpreter. */ \
+    TCL_UNUSED(Tcl_Obj *),	    /* Pointer to the list being modified. */ \
+    TCL_UNUSED(Tcl_Size),    /* Number of index args. */ \
+    TCL_UNUSEDVAR(Tcl_Obj *const indexArray[]),    /* Index args. */ \
+    TCL_UNUSED(Tcl_Obj *)/* Value arg to 'lset' or NULL to 'lpop'. */
+) {
+    return NULL;
+}
+
+
+static int ErrorMaxElementsExceeded(Tcl_Interp *interp) {
+    if (interp != NULL) {
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+	    "max length of a Tcl list (%" TCL_T_MODIFIER "d elements) exceeded",
+	    LIST_MAX));
+    }
+    return TCL_ERROR;
+}

generic/tclUniData.c

@@ -195,7 +195,6 @@ static const unsigned short pageMap[] = {
     1344, 1344, 1344, 10112, 10144, 1344, 10176, 1344, 10208, 10240, 10272,
     10304, 10336, 10368, 1344, 1344, 1344, 10400, 10432, 64, 10464, 10496,
     10528, 4736, 10560, 10592
-#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6
     ,10624, 10656, 10688, 3296, 1344, 1344, 1344, 10720, 10752, 10784,
     10816, 10848, 10880, 10912, 10944, 10976, 3296, 3296, 3296, 3296, 9216,
     1344, 11008, 11040, 1344, 11072, 11104, 11136, 11168, 1344, 11200,
@@ -568,8 +567,6 @@ static const unsigned short pageMap[] = {
     1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
     1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344,
     1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 1344, 15520
-
-#endif /* TCL_UTF_MAX > 3 */
 };
 
 /*
@@ -1180,7 +1177,6 @@ static const unsigned char groupMap[] = {
     15, 15, 15, 0, 0, 15, 15, 15, 0, 0, 0, 4, 4, 7, 11, 14, 4, 4, 0, 14,
     7, 7, 7, 7, 14, 14, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 17, 17, 17, 14, 14,
     0, 0
-#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6
     ,15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 15, 15, 15, 15,
     15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
     15, 15, 15, 15, 15, 0, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15,
@@ -1653,8 +1649,6 @@ static const unsigned char groupMap[] = {
     15, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 15, 15, 15, 15, 15, 15,
     15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 0, 0, 0, 0, 0, 0, 0, 0,
     0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0
-
-#endif /* TCL_UTF_MAX > 3 */
 };
 
 /*
@@ -1702,11 +1696,7 @@ static const int groups[] = {
     18, 17, 10305, 10370, 10049, 10114, 8769, 8834
 };
 
-#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6
-#   define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1FFFFF) >= 0x323C0)
-#else
-#   define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1F0000) != 0)
-#endif
+# define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1FFFFF) >= 0x323C0)
 
 /*
  * The following constants are used to determine the category of a
@@ -1761,8 +1751,4 @@ enum {
  * Unicode character tables.
  */
 
-#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6
-#   define GetUniCharInfo(ch) (groups[groupMap[pageMap[((ch) & 0x1FFFFF) >> OFFSET_BITS] | ((ch) & ((1 << OFFSET_BITS)-1))]])
-#else
-#   define GetUniCharInfo(ch) (groups[groupMap[pageMap[((ch) & 0xFFFF) >> OFFSET_BITS] | ((ch) & ((1 << OFFSET_BITS)-1))]])
-#endif
+# define GetUniCharInfo(ch) (groups[groupMap[pageMap[((ch) & 0x1FFFFF) >> OFFSET_BITS] | ((ch) & ((1 << OFFSET_BITS)-1))]])

generic/tclUtf.c

@@ -215,9 +215,7 @@ Tcl_UniCharToUtf(
 		 * character (at most 4 bytes).
 		 */
 {
-#if TCL_UTF_MAX > 3
     int flags = ch;
-#endif
 
     if (ch >= TCL_COMBINE) {
 	ch &= (TCL_COMBINE - 1);
@@ -234,9 +232,7 @@ Tcl_UniCharToUtf(
 	}
 	if (ch <= 0xFFFF) {
 	    if (
-#if TCL_UTF_MAX > 3
 		    (flags & TCL_COMBINE) &&
-#endif
 		    ((ch & 0xF800) == 0xD800)) {
 		if (ch & 0x0400) {
 		    /* Low surrogate */
@@ -349,15 +345,6 @@ 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++;
@@ -402,15 +389,6 @@ 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. */
@@ -447,15 +425,6 @@ Tcl_Char16ToUtfDString(
  *	Tcl_UtfCharComplete() before calling this routine to ensure that
  *	enough bytes remain in the string.
  *
- *	If TCL_UTF_MAX < 4, special handling of Surrogate pairs is done:
- *	For any UTF-8 string containing a character outside of the BMP, the
- *	first call to this function will fill *chPtr with the high surrogate
- *	and generate a return value of 1. Calling Tcl_UtfToUniChar again
- *	will produce the low surrogate and a return value of 3. Because *chPtr
- *	is used to remember whether the high surrogate is already produced, it
- *	is recommended to initialize the variable it points to as 0 before
- *	the first call to Tcl_UtfToUniChar is done.
- *
  * Results:
  *	*chPtr is filled with the Tcl_UniChar, and the return value is the
  *	number of bytes from the UTF-8 string that were consumed.
@@ -715,11 +684,11 @@ Tcl_UtfToUniCharDString(
     endPtr = src + length;
     optPtr = endPtr - 4;
     while (p <= optPtr) {
-	p += TclUtfToUCS4(p, &ch);
+	p += Tcl_UtfToUniChar(p, &ch);
 	*w++ = ch;
     }
     while ((p < endPtr) && Tcl_UtfCharComplete(p, endPtr-p)) {
-	p += TclUtfToUCS4(p, &ch);
+	p += Tcl_UtfToUniChar(p, &ch);
 	*w++ = ch;
     }
     while (p < endPtr) {
@@ -965,7 +934,7 @@ Tcl_UtfFindFirst(
     int ch)			/* The Unicode character to search for. */
 {
     while (1) {
-	int find, len = TclUtfToUCS4(src, &find);
+	int find, len = Tcl_UtfToUniChar(src, &find);
 
 	if (find == ch) {
 	    return src;
@@ -1004,7 +973,7 @@ Tcl_UtfFindLast(
     const char *last = NULL;
 
     while (1) {
-	int find, len = TclUtfToUCS4(src, &find);
+	int find, len = Tcl_UtfToUniChar(src, &find);
 
 	if (find == ch) {
 	    last = src;
@@ -1227,13 +1196,7 @@ Tcl_UniCharAtIndex(
 	i = TclUtfToUniChar(src, &ch);
 	src += i;
     }
-#if TCL_UTF_MAX < 4
-    if ((ch >= 0xD800) && (i < 3)) {
-	/* Index points at character following high Surrogate */
-	return -1;
-    }
-#endif
-    TclUtfToUCS4(src, &i);
+    Tcl_UtfToUniChar(src, &i);
     return i;
 }
 
@@ -1242,10 +1205,8 @@ Tcl_UniCharAtIndex(
  *
  * Tcl_UtfAtIndex --
  *
- *	Returns a pointer to the specified character (not byte) position in
- *	the UTF-8 string. If TCL_UTF_MAX < 4, characters > U+FFFF count as
- *	2 positions, but then the pointer should never be placed between
- *	the two positions.
+ *	Returns a pointer to the specified character (not byte) position in the
+ *	UTF-8 string. 
  *
  * Results:
  *	As above.
@@ -1377,7 +1338,7 @@ Tcl_UtfToUpper(
 
     src = dst = str;
     while (*src) {
-	len = TclUtfToUCS4(src, &ch);
+	len = Tcl_UtfToUniChar(src, &ch);
 	upChar = Tcl_UniCharToUpper(ch);
 
 	/*
@@ -1430,7 +1391,7 @@ Tcl_UtfToLower(
 
     src = dst = str;
     while (*src) {
-	len = TclUtfToUCS4(src, &ch);
+	len = Tcl_UtfToUniChar(src, &ch);
 	lowChar = Tcl_UniCharToLower(ch);
 
 	/*
@@ -1486,7 +1447,7 @@ Tcl_UtfToTitle(
     src = dst = str;
 
     if (*src) {
-	len = TclUtfToUCS4(src, &ch);
+	len = Tcl_UtfToUniChar(src, &ch);
 	titleChar = Tcl_UniCharToTitle(ch);
 
 	if (len < TclUtfCount(titleChar)) {
@@ -1498,7 +1459,7 @@ Tcl_UtfToTitle(
 	src += len;
     }
     while (*src) {
-	len = TclUtfToUCS4(src, &ch);
+	len = Tcl_UtfToUniChar(src, &ch);
 	lowChar = ch;
 	/* Special exception for Georgian Asomtavruli chars, no titlecase. */
 	if ((unsigned)(lowChar - 0x1C90) >= 0x30) {
@@ -1605,16 +1566,6 @@ Tcl_UtfNcmp(
 	cs += TclUtfToUniChar(cs, &ch1);
 	ct += TclUtfToUniChar(ct, &ch2);
 	if (ch1 != ch2) {
-#if TCL_UTF_MAX < 4
-	    /* Surrogates always report higher than non-surrogates */
-	    if (((ch1 & 0xFC00) == 0xD800)) {
-	    if ((ch2 & 0xFC00) != 0xD800) {
-		return ch1;
-	    }
-	    } else if ((ch2 & 0xFC00) == 0xD800) {
-		return -ch2;
-	    }
-#endif
 	    return (ch1 - ch2);
 	}
     }
@@ -1656,16 +1607,6 @@ Tcl_UtfNcasecmp(
 	cs += TclUtfToUniChar(cs, &ch1);
 	ct += TclUtfToUniChar(ct, &ch2);
 	if (ch1 != ch2) {
-#if TCL_UTF_MAX < 4
-	    /* Surrogates always report higher than non-surrogates */
-	    if (((ch1 & 0xFC00) == 0xD800)) {
-	    if ((ch2 & 0xFC00) != 0xD800) {
-		return ch1;
-	    }
-	    } else if ((ch2 & 0xFC00) == 0xD800) {
-		return -ch2;
-	    }
-#endif
 	    ch1 = Tcl_UniCharToLower(ch1);
 	    ch2 = Tcl_UniCharToLower(ch2);
 	    if (ch1 != ch2) {
@@ -1705,16 +1646,6 @@ TclUtfCmp(
 	cs += TclUtfToUniChar(cs, &ch1);
 	ct += TclUtfToUniChar(ct, &ch2);
 	if (ch1 != ch2) {
-#if TCL_UTF_MAX < 4
-	    /* Surrogates always report higher than non-surrogates */
-	    if (((ch1 & 0xFC00) == 0xD800)) {
-	    if ((ch2 & 0xFC00) != 0xD800) {
-		return ch1;
-	    }
-	    } else if ((ch2 & 0xFC00) == 0xD800) {
-		return -ch2;
-	    }
-#endif
 	    return ch1 - ch2;
 	}
     }
@@ -1751,16 +1682,6 @@ TclUtfCasecmp(
 	cs += TclUtfToUniChar(cs, &ch1);
 	ct += TclUtfToUniChar(ct, &ch2);
 	if (ch1 != ch2) {
-#if TCL_UTF_MAX < 4
-	    /* Surrogates always report higher than non-surrogates */
-	    if (((ch1 & 0xFC00) == 0xD800)) {
-	    if ((ch2 & 0xFC00) != 0xD800) {
-		return ch1;
-	    }
-	    } else if ((ch2 & 0xFC00) == 0xD800) {
-		return -ch2;
-	    }
-#endif
 	    ch1 = Tcl_UniCharToLower(ch1);
 	    ch2 = Tcl_UniCharToLower(ch2);
 	    if (ch1 != ch2) {
@@ -1959,7 +1880,7 @@ TclUniCharNcmp(
     const Tcl_UniChar *uct,	/* Unicode string ucs is compared to. */
     size_t numChars)	/* Number of unichars to compare. */
 {
-#if defined(WORDS_BIGENDIAN) && (TCL_UTF_MAX > 3)
+#if defined(WORDS_BIGENDIAN)
     /*
      * We are definitely on a big-endian machine; memcmp() is safe
      */
@@ -1973,14 +1894,6 @@ TclUniCharNcmp(
 
     for ( ; numChars != 0; ucs++, uct++, numChars--) {
 	if (*ucs != *uct) {
-#if TCL_UTF_MAX < 4
-	    /* special case for handling upper surrogates */
-	    if (((*ucs & 0xFC00) == 0xD800) && ((*uct & 0xFC00) != 0xD800)) {
-		return 1;
-	    } else if (((*uct & 0xFC00) == 0xD800)) {
-		return -1;
-	    }
-#endif
 	    return (*ucs - *uct);
 	}
     }
@@ -2018,14 +1931,6 @@ TclUniCharNcasecmp(
 	    Tcl_UniChar lct = Tcl_UniCharToLower(*uct);
 
 	    if (lcs != lct) {
-#if TCL_UTF_MAX < 4
-	    /* special case for handling upper surrogates */
-	    if (((lcs & 0xFC00) == 0xD800) && ((lct & 0xFC00) != 0xD800)) {
-		return 1;
-	    } else if (((lct & 0xFC00) == 0xD800)) {
-		return -1;
-	    }
-#endif
 		return (lcs - lct);
 	    }
 	}
@@ -2752,71 +2657,6 @@ TclUniCharMatch(
     }
 }
 
-/*
- *---------------------------------------------------------------------------
- *
- * TclUtfToUCS4 --
- *
- *	Extracts the 4-byte codepoint from the leading bytes of the
- *	Modified UTF-8 string "src".  This is a utility routine to
- *	contain the surrogate gymnastics in one place.
- *
- *	The caller must ensure that the source buffer is long enough that this
- *	routine does not run off the end and dereference non-existent memory
- *	looking for trail bytes. If the source buffer is known to be '\0'
- *	terminated, this cannot happen. Otherwise, the caller should call
- *	Tcl_UtfCharComplete() before calling this routine to ensure that
- *	enough bytes remain in the string.
- *
- * Results:
- *	Fills *usc4Ptr with the UCS4 code point and returns the number of bytes
- *	consumed from the source string.
- *
- * Side effects:
- *	None.
- *
- *---------------------------------------------------------------------------
- */
-
-#if TCL_UTF_MAX < 4
-int
-TclUtfToUCS4(
-    const char *src,	/* The UTF-8 string. */
-    int *ucs4Ptr)	/* Filled with the UCS4 codepoint represented
-			 * by the UTF-8 string. */
-{
-    /* Make use of the #undef Tcl_UtfToUniChar above, which already handles UCS4. */
-    return Tcl_UtfToUniChar(src, ucs4Ptr);
-}
-
-int
-TclUniCharToUCS4(
-    const Tcl_UniChar *src,	/* The Tcl_UniChar string. */
-    int *ucs4Ptr)	/* Filled with the UCS4 codepoint represented
-			 * by the Tcl_UniChar string. */
-{
-    if (((src[0] & 0xFC00) == 0xD800) && ((src[1] & 0xFC00) == 0xDC00)) {
-	*ucs4Ptr = (((src[0] & 0x3FF) << 10) | (src[1] & 0x3FF)) + 0x10000;
-	return 2;
-    }
-    *ucs4Ptr = src[0];
-    return 1;
-}
-
-const Tcl_UniChar *TclUCS4Prev(const Tcl_UniChar *src, const Tcl_UniChar *ptr) {
-    if (src <= ptr + 1) {
-    	return ptr;
-    }
-    if (((src[-1] & 0xFC00) == 0xDC00) && ((src[-2] & 0xFC00) == 0xD800)) {
-	return src - 2;
-    }
-    return src - 1;
-}
-
-
-
-#endif
-
 /*
  * Local Variables:
  * mode: c

generic/tclUtil.c

@@ -123,24 +123,16 @@ static int		FindElement(Tcl_Interp *interp, const char *string,
  * is unregistered, so has no need of a setFromAnyProc either.
  */
 
-static const TclObjTypeWithAbstractList endOffsetType = {
-    {"end-offset",			/* name */
+static const Tcl_ObjType endOffsetType = {
+    "end-offset",			/* name */
     NULL,				/* freeIntRepProc */
     NULL,				/* dupIntRepProc */
     NULL,				/* updateStringProc */
     NULL,				/* setFromAnyProc */
-    TCL_OBJTYPE_V0_1(
-    TclLengthOne
-    )}
+	0
 };
 
-Tcl_Size
-TclLengthOne(
-    TCL_UNUSED(Tcl_Obj *))
-{
-    return 1;
-}
-
+
 /*
  *	*	STRING REPRESENTATION OF LISTS	*	*	*
  *
@@ -1670,7 +1662,7 @@ TclTrimRight(
 	pp = Tcl_UtfPrev(p, bytes);
 	do {
 	    pp += pInc;
- 	    pInc = TclUtfToUCS4(pp, &ch1);
+ 	    pInc = Tcl_UtfToUniChar(pp, &ch1);
 	} while (pp + pInc < p);
 
 	/*
@@ -1678,7 +1670,7 @@ TclTrimRight(
 	 */
 
 	do {
-	    pInc = TclUtfToUCS4(q, &ch2);
+	    pInc = Tcl_UtfToUniChar(q, &ch2);
 
 	    if (ch1 == ch2) {
 		break;
@@ -1743,7 +1735,7 @@ TclTrimLeft(
      */
 
     do {
-	Tcl_Size pInc = TclUtfToUCS4(p, &ch1);
+	Tcl_Size pInc = Tcl_UtfToUniChar(p, &ch1);
 	const char *q = trim;
 	Tcl_Size bytesLeft = numTrim;
 
@@ -1752,7 +1744,7 @@ TclTrimLeft(
 	 */
 
 	do {
-	    Tcl_Size qInc = TclUtfToUCS4(q, &ch2);
+	    Tcl_Size qInc = Tcl_UtfToUniChar(q, &ch2);
 
 	    if (ch1 == ch2) {
 		break;
@@ -1819,7 +1811,7 @@ TclTrim(
 	if (numBytes > 0) {
 	    int ch;
 	    const char *first = bytes + trimLeft;
-	    bytes += TclUtfToUCS4(first, &ch);
+	    bytes += Tcl_UtfToUniChar(first, &ch);
 	    numBytes -= (bytes - first);
 
 	    if (numBytes > 0) {
@@ -2005,7 +1997,7 @@ Tcl_ConcatObj(
 		}
 	    } else {
 		resPtr = TclDuplicatePureObj(
-		    NULL, objPtr, &tclListType.objType);
+		    NULL, objPtr, tclListType);
 		if (!resPtr) {
 		    return NULL;
 		}
@@ -2149,7 +2141,7 @@ Tcl_StringCaseMatch(
 		ch2 = (int)
 			(nocase ? tolower(UCHAR(*pattern)) : UCHAR(*pattern));
 	    } else {
-		TclUtfToUCS4(pattern, &ch2);
+		Tcl_UtfToUniChar(pattern, &ch2);
 		if (nocase) {
 		    ch2 = Tcl_UniCharToLower(ch2);
 		}
@@ -2165,7 +2157,7 @@ Tcl_StringCaseMatch(
 		if ((p != '[') && (p != '?') && (p != '\\')) {
 		    if (nocase) {
 			while (*str) {
-			    charLen = TclUtfToUCS4(str, &ch1);
+			    charLen = Tcl_UtfToUniChar(str, &ch1);
 			    if (ch2==ch1 || ch2==Tcl_UniCharToLower(ch1)) {
 				break;
 			    }
@@ -2179,7 +2171,7 @@ Tcl_StringCaseMatch(
 			 */
 
 			while (*str) {
-			    charLen = TclUtfToUCS4(str, &ch1);
+			    charLen = Tcl_UtfToUniChar(str, &ch1);
 			    if (ch2 == ch1) {
 				break;
 			    }
@@ -2193,7 +2185,7 @@ Tcl_StringCaseMatch(
 		if (*str == '\0') {
 		    return 0;
 		}
-		str += TclUtfToUCS4(str, &ch1);
+		str += Tcl_UtfToUniChar(str, &ch1);
 	    }
 	}
 
@@ -2204,7 +2196,7 @@ Tcl_StringCaseMatch(
 
 	if (p == '?') {
 	    pattern++;
-	    str += TclUtfToUCS4(str, &ch1);
+	    str += Tcl_UtfToUniChar(str, &ch1);
 	    continue;
 	}
 
@@ -2223,7 +2215,7 @@ Tcl_StringCaseMatch(
 			(nocase ? tolower(UCHAR(*str)) : UCHAR(*str));
 		str++;
 	    } else {
-		str += TclUtfToUCS4(str, &ch1);
+		str += Tcl_UtfToUniChar(str, &ch1);
 		if (nocase) {
 		    ch1 = Tcl_UniCharToLower(ch1);
 		}
@@ -2237,7 +2229,7 @@ Tcl_StringCaseMatch(
 			    ? tolower(UCHAR(*pattern)) : UCHAR(*pattern));
 		    pattern++;
 		} else {
-		    pattern += TclUtfToUCS4(pattern, &startChar);
+		    pattern += Tcl_UtfToUniChar(pattern, &startChar);
 		    if (nocase) {
 			startChar = Tcl_UniCharToLower(startChar);
 		    }
@@ -2252,7 +2244,7 @@ Tcl_StringCaseMatch(
 				? tolower(UCHAR(*pattern)) : UCHAR(*pattern));
 			pattern++;
 		    } else {
-			pattern += TclUtfToUCS4(pattern, &endChar);
+			pattern += Tcl_UtfToUniChar(pattern, &endChar);
 			if (nocase) {
 			    endChar = Tcl_UniCharToLower(endChar);
 			}
@@ -2300,8 +2292,8 @@ Tcl_StringCaseMatch(
 	 * each string match.
 	 */
 
-	str += TclUtfToUCS4(str, &ch1);
-	pattern += TclUtfToUCS4(pattern, &ch2);
+	str += Tcl_UtfToUniChar(str, &ch1);
+	pattern += Tcl_UtfToUniChar(pattern, &ch2);
 	if (nocase) {
 	    if (Tcl_UniCharToLower(ch1) != Tcl_UniCharToLower(ch2)) {
 		return 0;
@@ -3497,7 +3489,7 @@ GetEndOffsetFromObj(
     Tcl_WideInt offset = -1;	/* Offset in the "end-offset" expression - 1 */
     void *cd;
 
-    while ((irPtr = TclFetchInternalRep(objPtr, &endOffsetType.objType)) == NULL) {
+    while ((irPtr = TclFetchInternalRep(objPtr, &endOffsetType)) == NULL) {
 	Tcl_ObjInternalRep ir;
 	Tcl_Size length;
 	const char *bytes = Tcl_GetStringFromObj(objPtr, &length);
@@ -3509,13 +3501,10 @@ GetEndOffsetFromObj(
 
 	    /* Value doesn't start with "e" */
 
-	    /* If we reach here, the string rep of objPtr exists. */
-
 	    /*
-	     * The valid index syntax does not include any value that is
-	     * a list of more than one element. This is necessary so that
-	     * lists of index values can be reliably distinguished from any
-	     * single index value.
+	     * So that lists of index values can be reliably distinguished from
+	     * any single index value, the valid index syntax does not include
+	     * any value that is a list of more than one element.
 	     */
 
 	    /*
@@ -3633,6 +3622,7 @@ GetEndOffsetFromObj(
 	    /* Doesn't start with "end" */
 	    goto parseError;
 	}
+
 	if (length > 4) {
 	    int t;
 
@@ -3683,7 +3673,7 @@ GetEndOffsetFromObj(
     parseOK:
 	/* Success. Store the new internal rep. */
 	ir.wideValue = offset;
-	Tcl_StoreInternalRep(objPtr, &endOffsetType.objType, &ir);
+	Tcl_StoreInternalRep(objPtr, &endOffsetType, &ir);
     }
 
     offset = irPtr->wideValue;
@@ -3740,7 +3730,7 @@ GetEndOffsetFromObj(
  *
  *      Parse objPtr to determine if it is an index value. Two cases
  *	are possible.  The value objPtr might be parsed as an absolute
- *	index value in the Tcl_Size range.  Note that this includes
+ *	index value in the Tcl_Size range.  This includes
  *	index values that are integers as presented and it includes index
  *      arithmetic expressions.
  *
@@ -3835,7 +3825,7 @@ TclIndexEncode(
      */
 
     const Tcl_ObjInternalRep *irPtr =
-	TclFetchInternalRep(objPtr, &endOffsetType.objType);
+	TclFetchInternalRep(objPtr, &endOffsetType);
 
     if (irPtr && irPtr->wideValue >= 0) {
 	/*
@@ -3956,6 +3946,39 @@ TclIndexDecode(
     return TCL_INDEX_NONE;
 }
 
+int TclIndexIsFromEnd(Tcl_Size index) {
+    return index <= 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclIndexLast --
+ *
+ *	Determine the last index for an array of length "length", where -1 means N is
+ *	not bounded.
+ *
+ *----------------------------------------------------------------------
+ */
+Tcl_Size
+TclIndexLast (Tcl_Size length) {
+    return Tcl_LengthIsFinite(length) ? length - 1 : TCL_INDEX_NONE;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_LengthIsFinite --
+ *
+ *	True if length is Finite.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+Tcl_LengthIsFinite(Tcl_Size length) {
+    return length != TCL_LENGTH_NONE;
+}
+
 /*
  *------------------------------------------------------------------------
  *

generic/tclVar.c

@@ -3097,7 +3097,7 @@ ArrayForNRCmd(
      * loop) don't vanish.
      */
 
-    varListObj = TclDuplicatePureObj(interp, objv[1], &tclListType.objType);
+    varListObj = TclDuplicatePureObj(interp, objv[1], tclListType);
     if (!varListObj) {
 	return TCL_ERROR;
     }
@@ -4074,7 +4074,7 @@ ArraySetCmd(
 	 */
 
 	copyListObj =
-	    TclDuplicatePureObj(interp, arrayElemObj, &tclListType.objType);
+	    TclDuplicatePureObj(interp, arrayElemObj, tclListType);
 	if (!copyListObj) {
 	    return TCL_ERROR;
 	}

library/http/http.tcl

@@ -1746,9 +1746,6 @@ proc http::OpenSocket {token DoLater} {
 	    }
 	    fconfigure $sock -translation {auto crlf} \
 			     -buffersize $state(-blocksize)
-	    if {[package vsatisfies [package provide Tcl] 9.0-]} {
-		fconfigure $sock -profile tcl8
-	    }
 	    ##Log socket opened, DONE fconfigure - token $token
         }
 
@@ -2167,9 +2164,6 @@ proc http::Connected {token proto phost srvurl} {
     lassign [fconfigure $sock -translation] trRead trWrite
     fconfigure $sock -translation [list $trRead crlf] \
 		     -buffersize $state(-blocksize)
-    if {[package vsatisfies [package provide Tcl] 9.0-]} {
-	fconfigure $sock -profile tcl8
-    }
 
     # The following is disallowed in safe interpreters, but the socket is
     # already in non-blocking mode in that case.
@@ -2560,9 +2554,6 @@ proc http::ReceiveResponse {token} {
     lassign [fconfigure $sock -translation] trRead trWrite
     fconfigure $sock -translation [list auto $trWrite] \
 		     -buffersize $state(-blocksize)
-    if {[package vsatisfies [package provide Tcl] 9.0-]} {
-	fconfigure $sock -profile tcl8
-    }
     Log ^D$tk begin receiving response - token $token
 
     coroutine ${token}--EventCoroutine http::Event $sock $token
@@ -4554,11 +4545,7 @@ proc http::Eot {token {reason {}}} {
 
 	    set enc [CharsetToEncoding $state(charset)]
 	    if {$enc ne "binary"} {
-		if {[package vsatisfies [package provide Tcl] 9.0-]} {
-		    set state(body) [encoding convertfrom -profile tcl8 $enc $state(body)]
-		} else {
-		    set state(body) [encoding convertfrom $enc $state(body)]
-		}
+		set state(body) [encoding convertfrom $enc $state(body)]
 	    }
 
 	    # Translate text line endings.
@@ -4641,11 +4628,7 @@ proc http::GuessType {token} {
     if {$enc eq "binary"} {
         return 0
     }
-    if {[package vsatisfies [package provide Tcl] 9.0-]} {
-	set state(body) [encoding convertfrom -profile tcl8 $enc $state(body)]
-    } else {
-	set state(body) [encoding convertfrom $enc $state(body)]
-    }
+    set state(body) [encoding convertfrom $enc $state(body)]
     set state(body) [string map {\r\n \n \r \n} $state(body)]
     set state(type) application/xml
     set state(binary) 0
@@ -4726,11 +4709,7 @@ proc http::quoteString {string} {
     # a pre-computed map and [string map] to do the conversion (much faster
     # than [regsub]/[subst]). [Bug 1020491]
 
-    if {[package vsatisfies [package provide Tcl] 9.0-]} {
-	set string [encoding convertto -profile tcl8 $http(-urlencoding) $string]
-    } else {
-	set string [encoding convertto $http(-urlencoding) $string]
-    }
+    set string [encoding convertto $http(-urlencoding) $string]
     return [string map $formMap $string]
 }
 

library/tcltest/tcltest.tcl

@@ -400,7 +400,7 @@ namespace eval tcltest {
 	    default {
 		set outputChannel [open $filename a]
 		if {[package vsatisfies [package provide Tcl] 8.7-]} {
-		    fconfigure $outputChannel -profile tcl8 -encoding utf-8
+		    fconfigure $outputChannel -encoding utf-8
 		}
 		set ChannelsWeOpened($outputChannel) 1
 
@@ -447,7 +447,7 @@ namespace eval tcltest {
 	    default {
 		set errorChannel [open $filename a]
 		if {[package vsatisfies [package provide Tcl] 8.7-]} {
-		    fconfigure $errorChannel -profile tcl8 -encoding utf-8
+		    fconfigure $errorChannel -encoding utf-8
 		}
 		set ChannelsWeOpened($errorChannel) 1
 
@@ -792,7 +792,7 @@ namespace eval tcltest {
 	if {$Option(-loadfile) eq {}} {return}
 	set tmp [open $Option(-loadfile) r]
 	if {[package vsatisfies [package provide Tcl] 8.7-]} {
-	    fconfigure $tmp -profile tcl8 -encoding utf-8
+	    fconfigure $tmp -encoding utf-8
 	}
 	loadScript [read $tmp]
 	close $tmp
@@ -1134,6 +1134,7 @@ proc tcltest::SafeFetch {n1 n2 op} {
     }
 }
 
+
 # tcltest::Asciify --
 #
 #       Transforms the passed string to contain only printable ascii characters.
@@ -1371,7 +1372,7 @@ proc tcltest::DefineConstraintInitializers {} {
 	set code 0
 	if {![catch {set f [open "|[list [interpreter]]" w]}]} {
 	    if {[package vsatisfies [package provide Tcl] 8.7-]} {
-		fconfigure $f -profile tcl8 -encoding utf-8
+		fconfigure $f -encoding utf-8
 	    }
 	    if {![catch {puts $f exit}]} {
 		if {![catch {close $f}]} {
@@ -2221,7 +2222,7 @@ proc tcltest::test {name description args} {
 	    if {[file readable $testFile]} {
 		set testFd [open $testFile r]
 		if {[package vsatisfies [package provide Tcl] 8.7-]} {
-		    fconfigure $testFd -profile tcl8 -encoding utf-8
+		    fconfigure $testFd -encoding utf-8
 		}
 		set testLine [expr {[lsearch -regexp \
 			[split [read $testFd] "\n"] \
@@ -2252,11 +2253,7 @@ proc tcltest::test {name description args} {
 	if {$scriptCompare} {
 	    puts [outputChannel] "---- Error testing result: $scriptMatch"
 	} else {
-	    if {[catch {
-		puts [outputChannel] "---- Result was:\n[Asciify $actualAnswer]"
-	    } errMsg]} {
-		puts [outputChannel] "\n---- Result was:\n<error printing result: $errMsg>"
-	    }
+	    puts [outputChannel] "---- Result was:\n[Asciify $actualAnswer]"
 	    puts [outputChannel] "---- Result should have been\
 		    ($match matching):\n[Asciify $result]"
 	}
@@ -2936,7 +2933,7 @@ proc tcltest::runAllTests { {shell ""} } {
 		incr numTestFiles
 		set pipeFd [open $cmd "r"]
 		if {[package vsatisfies [package provide Tcl] 8.7-]} {
-		    fconfigure $pipeFd -profile tcl8 -encoding utf-8
+		    fconfigure $pipeFd -encoding utf-8
 		}
 		while {[gets $pipeFd line] >= 0} {
 		    if {[regexp [join {
@@ -3136,7 +3133,7 @@ proc tcltest::makeFile {contents name {directory ""}} {
     set fd [open $fullName w]
     fconfigure $fd -translation lf
     if {[package vsatisfies [package provide Tcl] 8.7-]} {
-	fconfigure $fd -profile tcl8 -encoding utf-8
+	fconfigure $fd -encoding utf-8
     }
     if {[string index $contents end] eq "\n"} {
 	puts -nonewline $fd $contents
@@ -3287,7 +3284,7 @@ proc tcltest::viewFile {name {directory ""}} {
     set fullName [file join $directory $name]
     set f [open $fullName]
     if {[package vsatisfies [package provide Tcl] 8.7-]} {
-	fconfigure $f -profile tcl8 -encoding utf-8
+	fconfigure $f -encoding utf-8
     }
     set data [read -nonewline $f]
     close $f

tests/append.test

@@ -72,15 +72,15 @@ test append-3.6 {append surrogates} -body {
 test append-3.7 {append \xC0 \x80} -constraints testbytestring -body {
     set x [testbytestring \xC0]
     string length [append x [testbytestring \x80]]
-} -result 2
+} -result 1
 test append-3.8 {append \xC0 \x80} -constraints testbytestring -body {
     set x [testbytestring \xC0]
     string length $x[testbytestring \x80]
-} -result 2
+} -result 1
 test append-3.9 {append \xC0 \x80} -constraints testbytestring -body {
     set x [testbytestring \x80]
     string length [testbytestring \xC0]$x
-} -result 2
+} -result 1
 test append-3.10 {append surrogates} -body {
     set x \uD83D
     string range $x 0 end

tests/binary.test

@@ -3042,9 +3042,6 @@ 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/chan.test

@@ -56,7 +56,7 @@ test chan-4.2 {chan command: [Bug 800753]} -body {
 test chan-4.3 {chan command: [Bug 800753]} -body {
     chan configure stdout -eofchar \x00
 } -returnCodes error -result {bad value for -eofchar: must be non-NUL ASCII character}
-test chan-4.4 {chan command: check valid inValue, no outValue} -constraints deprecated -body {
+test chan-4.4 {chan command: check valid inValue, no outValue} -body {
     chan configure stdout -eofchar [list \x27 {}]
 } -result {}
 test chan-4.5 {chan command: check valid inValue, invalid outValue} -body {

tests/chanio.test

@@ -5287,7 +5287,7 @@ test chan-io-39.21 {Tcl_SetChannelOption, setting read mode independently} \
 test chan-io-39.22 {Tcl_SetChannelOption, invariance} -setup {
     file delete $path(test1)
     set l ""
-} -constraints {unix deprecated} -body {
+} -constraints unix -body {
     set f1 [open $path(test1) w+]
     lappend l [chan configure $f1 -eofchar]
     chan configure $f1 -eofchar {O {}}
@@ -5297,7 +5297,7 @@ test chan-io-39.22 {Tcl_SetChannelOption, invariance} -setup {
 } -cleanup {
     chan close $f1
 } -result {{} O D}
-test chan-io-39.22a {Tcl_SetChannelOption, invariance} -constraints deprecated -setup {
+test chan-io-39.22a {Tcl_SetChannelOption, invariance} -setup {
     file delete $path(test1)
     set l [list]
 } -body {

tests/cmdAH.test

@@ -334,7 +334,6 @@ test cmdAH-4.2.2 {Tcl_EncodingObjCmd} -setup {
 } -cleanup {
     encoding system $system
 } -result iso8859-1
-
 #
 # encoding convertfrom 4.3.*
 

tests/encoding.test

@@ -569,12 +569,17 @@ test {encoding-16.19 strict} {Utf16ToUtfProc, bug [d19fe0a5b]} -body {
     encoding convertfrom -profile strict utf-16 "\x41\x41\x41"
 } -returnCodes 1 -result {unexpected byte sequence starting at index 2: '\x41'}
 test {encoding-16.19 tcl8} {Utf16ToUtfProc, bug [d19fe0a5b]} -body {
+    encoding convertfrom -profile strict utf-16 "\x41\x41\x41"
+} -returnCodes 1 -result {unexpected byte sequence starting at index 2: '\x41'}
+test encoding-16.19.tcl8 {Utf16ToUtfProc, bug [d19fe0a5b]} -body {
     encoding convertfrom -profile tcl8 utf-16 "\x41\x41\x41"
 } -result \u4141\uFFFD
-test encoding-16.20 {utf16ToUtfProc, bug [d19fe0a5b]} \
-    -constraints deprecated -body {
+test encoding-16.19.strict {Utf16ToUtfProc, bug [d19fe0a5b]} -body {
+    encoding convertfrom -profile strict utf-16 "\x41\x41\x41"
+} -returnCodes 1 -result {unexpected byte sequence starting at index 2: '\x41'}
+test encoding-16.20 {utf16ToUtfProc, bug [d19fe0a5b]} -body {
     encoding convertfrom utf-16 "\xD8\xD8"
-} -result \uD8D8
+} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xD8'}
 test encoding-16.21.tcl8 {Utf32ToUtfProc, bug [d19fe0a5b]} -body {
     encoding convertfrom -profile tcl8 utf-32 "\x00\x00\x00\x00\x41\x41"
 } -result \x00\uFFFD
@@ -779,9 +784,12 @@ test encoding-24.3 {EscapeFreeProc on open channels} {stdio} {
     list $count [viewable $line]
 } [list 3 "乎乞也 (\\u4E4E\\u4E5E\\u4E5F)"]
 
-test encoding-24.4 {Parse valid or invalid utf-8} {
-    string length [encoding convertfrom utf-8 "\xC0\x80"]
-} 1
+test {encoding-24.4 utf-8 invalid strict} {Parse invalid utf-8, strict} -body {
+    string length [encoding convertfrom -profile strict utf-8 "\xC0\x80"]
+} -returnCodes 1 -result {unexpected byte sequence starting at index 0: '\xC0'}
+test {encoding-24.4 utf-8 invalid tcl8} {UtfToUtfProc utf-8} {
+    encoding convertfrom -profile tcl8 utf-8 \xC0\x80
+} \x00
 test encoding-24.5 {Parse valid or invalid utf-8} {
     string length [encoding convertfrom -profile tcl8 utf-8 "\xC0\x81"]
 } 2
@@ -812,6 +820,9 @@ test encoding-24.13 {Parse invalid utf-8} -body {
 test encoding-24.14 {Parse valid utf-8} {
     expr {[encoding convertfrom utf-8 "\xC2\x80"] eq "\u80"}
 } 1
+test encoding-24.15.default {Parse invalid utf-8, default} -body {
+    encoding convertfrom -profile strict utf-8 "Z\xE0\x80"
+} -returnCodes 1 -result "unexpected byte sequence starting at index 1: '\\xE0'"
 test encoding-24.15.strict {Parse invalid utf-8, -profile strict} -body {
     encoding convertfrom -profile strict utf-8 "Z\xE0\x80"
 } -returnCodes 1 -result "unexpected byte sequence starting at index 1: '\\xE0'"
@@ -833,6 +844,9 @@ test encoding-24.19.1 {Parse valid or invalid utf-8} -body {
 test encoding-24.19.2 {Parse valid or invalid utf-8} -body {
     encoding convertto -profile strict utf-8 "ZX\uD800"
 } -returnCodes 1 -match glob -result "unexpected character at index 2: 'U+00D800'"
+test encoding-24.19.3 {Parse valid or invalid utf-8} -body {
+    encoding convertto utf-8 "ZX\uD800"
+} -returnCodes 1 -match glob -result "unexpected character at index 2: 'U+00D800'"
 test encoding-24.20 {Parse with -profile tcl8 but without providing encoding} -body {
     encoding convertfrom -profile tcl8 "\x20"
 } -result {wrong # args: should be "::tcl::encoding::convertfrom ?-profile profile? ?-failindex var? encoding data" or "::tcl::encoding::convertfrom data"} -returnCodes error
@@ -869,7 +883,7 @@ test encoding-24.30 {Parse noncharacter with -profile strict} -body {
 test encoding-24.31 {Parse invalid utf-8 with -profile tcl8} -body {
     encoding convertfrom -profile tcl8 utf-8 \xEF\xBF\xBF
 } -result \uFFFF
-test encoding-24.32 {Try to generate invalid utf-8} -body {
+test encoding-24.33 {Try to generate invalid utf-8} -body {
     encoding convertto utf-8 \uFFFF
 } -result \xEF\xBF\xBF
 test encoding-24.33 {Try to generate invalid utf-8} -body {

tests/encodingVectors.tcl

@@ -10,7 +10,7 @@
 
 # List of defined encoding profiles
 set encProfiles {tcl8 strict replace}
-set encDefaultProfile tcl8; # Should reflect the default from implementation
+set encDefaultProfile strict; # Should reflect the default from implementation
 
 # encValidStrings - Table of valid strings.
 #

tests/io.test

@@ -1614,6 +1614,46 @@ test io-12.8 {ReadChars: multibyte chars split} {
     close $f
     scan [string index $in end] %c
 } 160
+
+
+apply [list {} {
+    set template {
+	test {io-12.9 @variant@} {ReadChars: multibyte chars split, default (strict)} -body {
+	    set res {}
+	    set f [open $path(test1) w]
+	    fconfigure $f -translation binary
+	    puts -nonewline $f [string repeat a 9]\xC2
+	    close $f
+	    set f [open $path(test1)]
+	    fconfigure $f -encoding utf-8 @strict@ -buffersize 10
+	    set status [catch {read $f} cres copts]
+	    set in [dict get $copts -result]
+	    lappend res $in
+	    lappend res $status $cres
+	    set status [catch {read $f} cres copts]
+	    set in [dict get $copts -result]
+	    lappend res $in
+	    lappend res $status $cres
+	    set res
+	} -cleanup {
+	    catch {close $f}
+	} -match glob -result {{read aaaaaaaaa} 1 {error reading "file*":\
+		invalid or incomplete multibyte or wide character}\
+		{read {}} 1 {error reading "file*":\
+		invalid or incomplete multibyte or wide character}}
+    }
+
+	# if default encoding is not currently to strict
+    # foreach variant {default encodingstrict} strict {{} {-encodingstrict 1}} 
+    foreach variant {{profile strict}} strict {{-profile strict}} {
+	set script [string map [
+	    list @variant@ $variant @strict@ $strict] $template] 
+	uplevel 1 $script
+    }
+} [namespace current]]
+
+
+
 test {io-12.9 profile tcl8} {ReadChars: multibyte chars split} -body {
     set f [open $path(test1) w]
     fconfigure $f -translation binary
@@ -1627,6 +1667,7 @@ test {io-12.9 profile tcl8} {ReadChars: multibyte chars split} -body {
 } -cleanup {
     catch {close $f}
 } -result 194
+
 test {io-12.10 strict} {ReadChars: multibyte chars split} -body {
     set f [open $path(test1) w]
     fconfigure $f -translation binary
@@ -1643,7 +1684,7 @@ test {io-12.10 strict} {ReadChars: multibyte chars split} -body {
 	invalid or incomplete multibyte or wide character}
 
 
-test {io-12.10 tcl8} {ReadChars: multibyte chars split} -body {
+test io-12.10.profiletcl8 {ReadChars: multibyte chars split} -body {
     set f [open $path(test1) w]
     fconfigure $f -translation binary
     puts -nonewline $f [string repeat a 9]\xC2
@@ -5846,7 +5887,7 @@ test io-39.21 {Tcl_SetChannelOption, setting read mode independently} \
     close $s2
     set modes
 } {auto crlf}
-test io-39.22 {Tcl_SetChannelOption, invariance} -constraints {unix deprecated} -body {
+test io-39.22 {Tcl_SetChannelOption, invariance} -constraints unix -body {
     file delete $path(test1)
     set f1 [open $path(test1) w+]
     set l ""
@@ -5858,7 +5899,7 @@ test io-39.22 {Tcl_SetChannelOption, invariance} -constraints {unix deprecated}
     close $f1
     set l
 } -result {{} O D}
-test io-39.22a {Tcl_SetChannelOption, invariance} -constraints deprecated -body {
+test io-39.22a {Tcl_SetChannelOption, invariance} -body {
     file delete $path(test1)
     set f1 [open $path(test1) w+]
     set l [list]
@@ -5879,7 +5920,7 @@ test io-39.23 {Tcl_GetChannelOption, server socket is not readable or
     set l
 } {{} auto}
 test io-39.24 {Tcl_SetChannelOption, server socket is not readable or
-    writable so we can't change -eofchar or -translation } {
+	writable so we can't change -eofchar or -translation } {
     set l [list]
     set sock [socket -server [namespace code accept] -myaddr 127.0.0.1 0]
     fconfigure $sock -eofchar D -translation lf
@@ -9280,7 +9321,29 @@ test io-75.5 {invalid utf-8 encoding read is ignored (-profile tcl8)} -setup {
     removeFile io-75.5
 } -result 4181
 
-test io-75.6 {invalid utf-8 encoding, gets is not ignored (-profile strict)} -setup {
+test io-75.6.read {invalid utf-8 encoding, read is not ignored (-encodingstrict 1)} -setup {
+    set fn [makeFile {} io-75.6]
+    set f [open $fn w+]
+    fconfigure $f -encoding binary
+    # \x81 is invalid in utf-8
+    puts -nonewline $f A\x81
+    flush $f
+    seek $f 0
+    fconfigure $f -encoding utf-8 -buffering none -eofchar "" -translation lf \
+	-profile strict
+} -body {
+    set status [catch {read $f} cres copts]
+    set d [dict get $copts -result read]
+    binary scan $d H* hd
+    lappend hd $status $cres
+} -cleanup {
+    close $f
+    removeFile io-75.6
+} -match glob -result {41 1 {error reading "file*":\
+	invalid or incomplete multibyte or wide character}}
+
+
+test io-75.6.gets {invalid utf-8 encoding, gets is not ignored (-profile strict)} -setup {
     set fn [makeFile {} io-75.6]
     set f [open $fn w+]
     fconfigure $f -encoding binary
@@ -9298,7 +9361,7 @@ test io-75.6 {invalid utf-8 encoding, gets is not ignored (-profile strict)} -se
 } -match glob -returnCodes 1 -result {error reading "file*":\
 	invalid or incomplete multibyte or wide character}
 
-test io-75.7 {
+test io-75.7.gets {
     invalid utf-8 encoding gets is not ignored (-profile strict)
 } -setup {
     set fn [makeFile {} io-75.7]
@@ -9318,12 +9381,67 @@ test io-75.7 {
 } -match glob -result {1 {error reading "file*":\
     invalid or incomplete multibyte or wide character}}
 
-test io-75.8 {invalid utf-8 encoding eof handling (-profile strict)} -setup {
+test io-75.7.read {invalid utf-8 encoding eof handling (-profile strict)} -setup {
+    set fn [makeFile {} io-75.7]
+    set f [open $fn w+]
+    fconfigure $f -encoding binary
+    # \xA1 is invalid in utf-8. -eofchar is not detected, because it comes later.
+    puts -nonewline $f A\xA1\x1A
+    flush $f
+    seek $f 0
+    fconfigure $f -encoding utf-8 -buffering none -eofchar \x1A \
+	-translation lf -profile strict
+} -body {
+    set status [catch {read $f} cres copts]
+    set d [dict get $copts -result read]
+    binary scan $d H* hd
+    lappend hd [eof $f]
+    lappend hd $status
+    lappend hd $cres
+    fconfigure $f -encoding iso8859-1
+    lappend hd [read $f];# We changed encoding, so now we can read the \xA1
+    close $f
+    set hd
+} -cleanup {
+    removeFile io-75.7
+} -match glob -result {41 0 1 {error reading "file*":\
+	invalid or incomplete multibyte or wide character} ¡}
+
+test io-75.7.read {invalid utf-8 encoding eof handling (-profile strict)} -setup {
+    set fn [makeFile {} io-75.7]
+    set f [open $fn w+]
+    fconfigure $f -encoding binary
+    # \xA1 is invalid in utf-8. -eofchar is not detected, because it comes later.
+    puts -nonewline $f A\xA1\x1A
+    flush $f
+    seek $f 0
+    fconfigure $f -encoding utf-8 -buffering none -eofchar \x1A \
+	-translation lf -profile strict
+} -body {
+    set status [catch {read $f} cres copts]
+    set d [dict get $copts -result read]
+    binary scan $d H* hd
+    lappend hd [eof $f]
+    lappend hd $status
+    lappend hd $cres
+    fconfigure $f -encoding iso8859-1
+    lappend hd [read $f];# We changed encoding, so now we can read the \xA1
+    close $f
+    set hd
+} -cleanup {
+    removeFile io-75.7
+} -match glob -result {41 0 1 {error reading "file*":\
+	invalid or incomplete multibyte or wide character} ¡}
+
+test io-75.8.incomplete {
+    incomplete uft-8 char after eof char is not an error (-profile strict)
+} -setup {
+    set hd {}
     set fn [makeFile {} io-75.8]
     set f [open $fn w+]
     fconfigure $f -encoding binary
-    # \x81 is invalid in utf-8, but since \x1A comes first, -eofchar takes
-    # precedence.
+	# \x81 is invalid in utf-8, but since the eof character \x1A comes first,
+	# -eofchar takes precedence.
     puts -nonewline $f A\x1A\x81
     flush $f
     seek $f 0
@@ -9333,6 +9451,7 @@ test io-75.8 {invalid utf-8 encoding eof handling (-profile strict)} -setup {
     set d [read $f]
     binary scan $d H* hd
     lappend hd [eof $f]
+    # there should be no error on additional reads
     lappend hd [read $f]
     close $f
     set hd
@@ -9340,7 +9459,39 @@ test io-75.8 {invalid utf-8 encoding eof handling (-profile strict)} -setup {
     removeFile io-75.8
 } -result {41 1 {}}
 
-test io-75.8.eoflater {invalid utf-8 encoding eof handling (-profile strict)} -setup {
+
+test {io-75.8 {invalid after eof}} {
+	invalid utf-8 after eof char is not an error (-profile strict)
+} -setup {
+    set res {}
+    set fn [makeFile {} io-75.8]
+    set f [open $fn w+]
+    fconfigure $f -encoding binary
+    # \xc0\x80 is invalid utf-8 data, but because the eof character \x1A
+    # appears first, it's not an error.
+    puts -nonewline $f A\x1a\xc0\x80
+    flush $f
+    seek $f 0
+    fconfigure $f -encoding utf-8 -buffering none -eofchar \x1A \
+	-translation lf -profile strict
+} -body {
+    set d [read $f]
+    foreach char [split $d {}] {
+	lappend res [format %x [scan $char %c]]
+    }
+    lappend res [eof $f]
+    # there should be no error on additional reads
+    lappend res [read $f]
+    close $f
+    set res
+} -cleanup {
+    removeFile io-75.8
+} -result {41 1 {}}
+
+
+test {io-75.8 {invalid before eof}} {
+	invalid utf-8 encoding eof handling (-profile strict)
+} -setup {
     set fn [makeFile {} io-75.8]
     set f [open $fn w+]
     # This also configures the channel encoding profile as strict.
@@ -9386,6 +9537,7 @@ test io-strict-multibyte-eof {
 } -match glob -result {1 {error reading "*":\
     invalid or incomplete multibyte or wide character}}
 
+
 test io-75.9 {unrepresentable character write passes and is replaced by ?} -setup {
     set fn [makeFile {} io-75.9]
     set f [open $fn w+]
@@ -9401,7 +9553,42 @@ test io-75.9 {unrepresentable character write passes and is replaced by ?} -setu
 } -match glob -result [list {A} {error writing "*":\
     invalid or incomplete multibyte or wide character}]
 
-test io-75.10 {
+apply [list {} {
+    set template {
+	test {io-75.10 ${mode}} {
+	    incomplete multibyte encoding read is an error
+	} -setup {
+	    set res {}
+	    set fn [makeFile {} io-75.10]
+	    set f [open $fn w+]
+	    fconfigure $f -encoding binary
+	    puts -nonewline $f A\xC0
+	    flush $f
+	    seek $f 0
+	    fconfigure $f -encoding utf-8 -buffering none {*}${option}
+	} -body {
+	    set status [catch {read $f} cres copts]
+	    set d [dict get $copts -result read]
+	    close $f
+	    binary scan $d H* hd
+	    lappend res $hd
+	    lappend res $status
+	    lappend res $cres
+	    return $res
+	} -cleanup {
+	    removeFile io-75.10
+	} -match glob -result {41 1 {error reading "file*":\
+		invalid or incomplete multibyte or wide character}}
+    }
+	# the default encoding mode is not currently strict
+    #foreach mode {default strict} option {{} {-encodingstrict 1}} 
+    foreach mode {{profile strict}} option {{-profile strict}} {
+	set test [string map [
+	    list {${mode}} [list $mode] {${option}} [list $option]] $template]
+	uplevel $test
+    }
+} [namespace current]]
+test {io-75.10 {profile tcl8}} {
     incomplete multibyte encoding read is not ignored because "binary" sets
     profile to strict
 } -setup {
@@ -9455,9 +9642,45 @@ test io-75.11 {shiftjis encoding error read results in raw bytes} -setup {
 } -match glob -result {41 1 {error reading "file*":\
     invalid or incomplete multibyte or wide character}}
 
-test io-75.12 {
-    invalid utf-8 encoding read is not ignored because setting the encoding to
-    "binary" also set the profile to strict
+
+apply [list {} {
+    set template {
+	test {io-75.12 ${mode}} {invalid utf-8 encoding read returns an error} -setup {
+	    set res {}
+	    set fn [makeFile {} io-75.12]
+	    set f [open $fn w+]
+	    fconfigure $f -encoding binary
+	    puts -nonewline $f A\x81
+	    flush $f
+	    seek $f 0
+	    fconfigure $f -encoding utf-8 -buffering none -eofchar {} \
+		    -translation lf {*}${option}
+	} -body {
+	    set status [catch {read $f} cres copts]
+	    set d [dict get $copts -result read]
+	    close $f
+	    binary scan $d H* hd
+	    lappend res $hd $status $cres
+	    return $res
+	} -cleanup {
+	    removeFile io-75.12
+	} -match glob -result {41 1 {error reading "file*":\
+		invalid or incomplete multibyte or wide character}}
+    }
+
+    # the default encoding mod is not currently strict
+    #foreach mode {default strict} option {{} {-encodingstrict 1}}
+    foreach mode {{profile strict}} option {{-profile strict}} {
+	set test [string map [
+	    list {${mode}} [list $mode] {${option}} [list $option]] $template]
+	uplevel $test
+    }
+} [namespace current]]
+
+
+test {io-75.12 {profile tcl8}} {
+    invalid utf-8 encoding read, is not ignored because setting the encoding to
+    "binary" also sets the profile to strict
 } -setup {
     set res {}
     set fn [makeFile {} io-75.12]
@@ -9466,7 +9689,8 @@ test io-75.12 {
     puts -nonewline $f A\x81
     flush $f
     seek $f 0
-    fconfigure $f -encoding utf-8 -buffering none -eofchar {} -translation lf
+    fconfigure $f -encoding utf-8 -buffering none -eofchar {} \
+	-translation lf
 } -body {
     catch {read $f} errmsg
     lappend res $errmsg
@@ -9483,6 +9707,29 @@ test io-75.12 {
 } -match glob -result {{error reading "file*":\
     invalid or incomplete multibyte or wide character} 4181}
 test io-75.13 {
+    In blocking mode [read] produces an error and leaves the data succesfully
+    read so far in the return options dictionary.
+} -setup {
+    set fn [makeFile {} io-75.13]
+    set f [open $fn w+]
+    fconfigure $f -encoding binary
+    # \x81 is invalid in utf-8
+    puts -nonewline $f A\x81
+    flush $f
+    seek $f 0
+    fconfigure $f -encoding utf-8 -eofchar "" -translation lf -profile strict
+} -body {
+    set status [catch {read $f} cres copts]
+    set d [dict get $copts -result read]
+    binary scan $d H* hd
+    lappend hd $status
+    lappend hd $cres
+} -cleanup {
+    close $f
+    removeFile io-75.13
+} -match glob -result {41 1 {error reading "file*":\
+	invalid or incomplete multibyte or wide character}}
+test io-75.13.nonblocking {
     In nonblocking mode when there is an encoding error the data that has been
     successfully read so far is returned first and then the error is returned
     on the next call to [read].
@@ -9564,6 +9811,61 @@ test io-75.15 {
 } -match glob -result {hello AB 1 {error reading "*": invalid or incomplete multibyte or wide character}\
     1 {error reading "*": invalid or incomplete multibyte or wide character} 43 44 c0 40 EF GHI}
 
+test io-75.14 {invalid utf-8 encoding [gets] coninues in non-strict mode after error} -setup {
+    set res {}
+    set fn [makeFile {} io-75.14]
+    set f [open $fn w+]
+    fconfigure $f -encoding binary
+    # \xc0 is invalid in utf-8
+    puts -nonewline $f a\nb\xc0\nc\n
+    flush $f
+    seek $f 0
+    fconfigure $f -encoding utf-8 -buffering none -eofchar {} -translation lf -profile strict
+} -body {
+    lappend res [gets $f]
+    set status [catch {gets $f} cres copts]
+    lappend res $status $cres
+    chan configure $f -profile tcl8 
+    lappend res [gets $f]
+    lappend res [gets $f]
+    close $f
+    return $res
+} -cleanup {
+    removeFile io-75.14
+} -match glob -result {a 1 {error reading "file*":\
+	invalid or incomplete multibyte or wide character} bÀ c}
+
+
+test io-75.15 {invalid utf-8 encoding strict gets should not hang} -setup {
+    set res {}
+    set fn [makeFile {} io-75.15]
+    set chan [open $fn w+]
+    fconfigure $chan -encoding binary
+    # This is not valid UTF-8
+    puts $chan hello\nAB\xc0\x40CD\nEFG
+    close $chan
+} -body {
+    #Now try to read it with [gets]
+    set chan [open $fn]
+    fconfigure $chan -encoding utf-8 -profile strict
+    lappend res [gets $chan]
+    set status [catch {gets $chan} cres copts]
+    lappend res $status $cres
+    set status [catch {gets $chan} cres copts]
+    lappend res $status $cres
+	lappend res [dict get $copts -result]
+	chan configure $chan -encoding binary
+	foreach char [split [read $chan 2] {}] {
+	    lappend res [format %x [scan $char %c]]
+	}
+    return $res
+} -cleanup {
+    close $chan
+    removeFile io-75.15
+} -match glob -result {hello 1 {error reading "file*":\
+	invalid or incomplete multibyte or wide character} 1 {error reading "file*":\
+	invalid or incomplete multibyte or wide character} {read AB} 41 42}
+
 # ### ### ### ######### ######### #########
 
 

tests/ioCmd.test

@@ -1397,7 +1397,7 @@ test iocmd-25.1 {chan configure, cgetall, standard options} -match glob -body {
 } -result {{-blocking 1 -buffering full -buffersize 4096 -encoding * -eofchar {} -profile * -translation {auto *}}}
 test iocmd-25.2 {chan configure, cgetall, no options} -match glob -body {
     set res {}
-    proc foo args {oninit cget cgetall; onfinal; track; return ""}
+    proc foo args {oninit cget cgetall; onfinal; track; return {}}
     set c [chan create {r w} foo]
     note [fconfigure $c]
     close $c

tests/linsert.test

@@ -16,104 +16,133 @@ if {"::tcltest" ni [namespace children]} {
     namespace import -force ::tcltest::*
 }
 
-catch {unset lis}
-catch {rename p ""}
+proc newlist list {
+    return $list
+}
 
-test linsert-1.1 {linsert command} {
-    linsert {1 2 3 4 5} 0 a
-} {a 1 2 3 4 5}
-test linsert-1.2 {linsert command} {
-    linsert {1 2 3 4 5} 1 a
-} {1 a 2 3 4 5}
-test linsert-1.3 {linsert command} {
-    linsert {1 2 3 4 5} 2 a
-} {1 2 a 3 4 5}
-test linsert-1.4 {linsert command} {
-    linsert {1 2 3 4 5} 3 a
-} {1 2 3 a 4 5}
-test linsert-1.5 {linsert command} {
-    linsert {1 2 3 4 5} 4 a
-} {1 2 3 4 a 5}
-test linsert-1.6 {linsert command} {
-    linsert {1 2 3 4 5} 5 a
-} {1 2 3 4 5 a}
-test linsert-1.7 {linsert command} {
-    linsert {1 2 3 4 5} 2 one two \{three \$four
-} {1 2 one two \{three {$four} 3 4 5}
-test linsert-1.8 {linsert command} {
-    linsert {\{one \$two \{three \ four \ five} 2 a b c
-} {\{one {$two} a b c \{three { four} { five}}
-test linsert-1.9 {linsert command} {
-    linsert {{1 2} {3 4} {5 6} {7 8}} 2 {x y} {a b}
-} {{1 2} {3 4} {x y} {a b} {5 6} {7 8}}
-test linsert-1.10 {linsert command} {
-    linsert {} 2 a b c
-} {a b c}
-test linsert-1.11 {linsert command} {
-    linsert {} 2 {}
-} {{}}
-test linsert-1.12 {linsert command} {
-    linsert {a b "c c" d e} 3 1
-} {a b {c c} 1 d e}
-test linsert-1.13 {linsert command} {
-    linsert { a b c d} 0 1 2
-} {1 2 a b c d}
-test linsert-1.14 {linsert command} {
-    linsert {a b c {d e f}} 4 1 2
-} {a b c {d e f} 1 2}
-test linsert-1.15 {linsert command} {
-    linsert {a b c \{\  abc} 4 q r
-} {a b c \{\  q r abc}
-test linsert-1.16 {linsert command} {
-    linsert {a b c \{ abc} 4 q r
-} {a b c \{ q r abc}
-test linsert-1.17 {linsert command} {
-    linsert {a b c} end q r
-} {a b c q r}
-test linsert-1.18 {linsert command} {
-    linsert {a} end q r
-} {a q r}
-test linsert-1.19 {linsert command} {
-    linsert {} end q r
-} {q r}
-test linsert-1.20 {linsert command, use of end-int index} {
-    linsert {a b c d} end-2 e f
-} {a b e f c d}
+variable tests {
 
-test linsert-2.1 {linsert errors} {
-    list [catch linsert msg] $msg
-} {1 {wrong # args: should be "linsert list index ?element ...?"}}
-test linsert-2.2 {linsert errors} {
-    list [catch {linsert a b} msg] $msg
-} {1 {bad index "b": must be integer?[+-]integer? or end?[+-]integer?}}
-test linsert-2.3 {linsert errors} {
-    list [catch {linsert a 12x 2} msg] $msg
-} {1 {bad index "12x": must be integer?[+-]integer? or end?[+-]integer?}}
-test linsert-2.4 {linsert errors} {
-    list [catch {linsert \{ 12 2} msg] $msg
-} {1 {unmatched open brace in list}}
-test linsert-2.5 {syntax (TIP 323)} {
-    linsert {a b c} 0
-} [list a b c]
-test linsert-2.6 {syntax (TIP 323)} {
-    linsert "a\nb\nc" 0
-} [list a b c]
+    foreach map {
+	{
+	    @mode@ compiled
+	    @linsert@ linsert
+	}
+	{
+	    @mode@ uncompiled
+	    @linsert@ {[lindex linsert]}
+	}
+    } {
+	set script [string map $map {
+	    catch {unset lis}
+	    catch {rename p ""}
 
-test linsert-3.1 {linsert won't modify shared argument objects} {
-    proc p {} {
-        linsert "a b c" 1 "x y"
-        return "a b c"
+	    test linsert-1.1-@mode@ {linsert command} {
+		@linsert@ [newlist {1 2 3 4 5}] 0 a
+	    } {a 1 2 3 4 5}
+	    test linsert-1.2-@mode@ {linsert command} {
+		@linsert@ [newlist {1 2 3 4 5}] 1 a
+	    } {1 a 2 3 4 5}
+	    test linsert-1.3-@mode@ {linsert command} {
+		@linsert@ [newlist {1 2 3 4 5}] 2 a
+	    } {1 2 a 3 4 5}
+	    test linsert-1.4-@mode@ {linsert command} {
+		@linsert@ [newlist {1 2 3 4 5}] 3 a
+	    } {1 2 3 a 4 5}
+	    test linsert-1.5-@mode@ {linsert command} {
+		@linsert@ [newlist {1 2 3 4 5}] 4 a
+	    } {1 2 3 4 a 5}
+	    test linsert-1.6-@mode@ {linsert command} {
+		@linsert@ [newlist {1 2 3 4 5}] 5 a
+	    } {1 2 3 4 5 a}
+	    test linsert-1.7-@mode@ {linsert command} {
+		@linsert@ [newlist {1 2 3 4 5}] 2 one two \{three \$four
+	    } {1 2 one two \{three {$four} 3 4 5}
+	    test linsert-1.8-@mode@ {linsert command} {
+		@linsert@ [newlist {\{one \$two \{three \ four \ five}] 2 a b c
+	    } {\{one {$two} a b c \{three { four} { five}}
+	    test linsert-1.9-@mode@ {linsert command} {
+		@linsert@ [newlist {{1 2} {3 4} {5 6} {7 8}}] 2 {x y} {a b}
+	    } {{1 2} {3 4} {x y} {a b} {5 6} {7 8}}
+	    test linsert-1.10-@mode@ {linsert command} {
+		@linsert@ [newlist {}] 2 a b c
+	    } {a b c}
+	    test linsert-1.11-@mode@ {linsert command} {
+		@linsert@ [newlist {}] 2 {}
+	    } {{}}
+	    test linsert-1.12-@mode@ {linsert command} {
+		@linsert@ [newlist {a b "c c" d e}] 3 1
+	    } {a b {c c} 1 d e}
+	    test linsert-1.13-@mode@ {linsert command} {
+		@linsert@ [newlist { a b c d}] 0 1 2
+	    } {1 2 a b c d}
+	    test linsert-1.14-@mode@ {linsert command} {
+		@linsert@ [newlist {a b c {d e f}}] 4 1 2
+	    } {a b c {d e f} 1 2}
+	    test linsert-1.15-@mode@ {linsert command} {
+		@linsert@ [newlist {a b c \{\  abc}] 4 q r
+	    } {a b c \{\  q r abc}
+	    test linsert-1.16-@mode@ {linsert command} {
+		@linsert@ [newlist {a b c \{ abc}] 4 q r
+	    } {a b c \{ q r abc}
+	    test linsert-1.17-@mode@ {linsert command} {
+		@linsert@ [newlist {a b c}] end q r
+	    } {a b c q r}
+	    test linsert-1.18-@mode@ {linsert command} {
+		@linsert@ [newlist {a}] end q r
+	    } {a q r}
+	    test linsert-1.19-@mode@ {linsert command} {
+		@linsert@ [newlist {}] end q r
+	    } {q r}
+	    test linsert-1.20-@mode@ {linsert command, use of end-int index} {
+		@linsert@ [newlist {a b c d}] end-2 e f
+	    } {a b e f c d}
+
+	    test linsert-2.1-@mode@ {linsert errors} {
+		list [catch @linsert@ [newlist msg]] $msg
+	    } {1 {wrong # args: should be "linsert list index ?element ...?"}}
+	    test linsert-2.2-@mode@ {linsert errors} {
+		list [catch {@linsert@ [newlist a] b} msg] $msg
+	    } {1 {bad index "b": must be integer?[+-]integer? or end?[+-]integer?}}
+	    test linsert-2.3-@mode@ {linsert errors} {
+		list [catch {@linsert@ [newlist a] 12x 2} msg] $msg
+	    } {1 {bad index "12x": must be integer?[+-]integer? or end?[+-]integer?}}
+	    test linsert-2.4-@mode@ {linsert errors} {
+		list [catch {@linsert@ [newlist \{] 12 2} msg] $msg
+	    } {1 {unmatched open brace in list}}
+	    test linsert-2.5-@mode@ {syntax (TIP 323)} {
+		@linsert@ [newlist {a b c}] 0
+	    } [list a b c]
+	    test linsert-2.6-@mode@ {syntax (TIP 323)} {
+		@linsert@ [newlist "a\nb\nc"] 0
+	    } [list a b c]
+
+	    test linsert-3.1-@mode@ {linsert won't modify shared argument objects} {
+		proc p {} {
+		    set list "a b c"
+		    @linsert@ [newlist $list] 1 "x y"
+		    return "a b c"
+		}
+		p
+	    } "a b c"
+	    test linsert-3.2-@mode@ {linsert won't modify shared argument objects} {
+		catch {unset lis}
+		puts boom
+		set lis [format "a \"%s\" c" "b"]
+		@linsert@ [newlist $lis] 0 [string length $lis]
+	    } "7 a b c"
+
+	    # cleanup
+	    catch {unset lis}
+	    catch {rename p ""}
+	}]
+	try $script
     }
-    p
-} "a b c"
-test linsert-3.2 {linsert won't modify shared argument objects} {
-    catch {unset lis}
-    set lis [format "a \"%s\" c" "b"]
-    linsert $lis 0 [string length $lis]
-} "7 a b c"
+}
 
-# cleanup
-catch {unset lis}
-catch {rename p ""}
-::tcltest::cleanupTests
-return
+
+if {[info exists ::argv0] && [info script] eq $::argv0} {
+    try $tests
+
+    ::tcltest::cleanupTests
+    return
+}

tests/lseq.test

@@ -318,6 +318,7 @@ test lseq-3.14 {array for shimmer} -constraints arithSeriesShimmerOk -body {
     array set testarray {a Test for This great Function}
     set vars [lseq 2]
     set vars-rep [lindex [tcl::unsupported::representation $vars] 3]
+    after 1
     array for $vars testarray {
 	lappend keys $0
 	lappend vals $1

tests/lset.test

@@ -19,462 +19,493 @@ if {"::tcltest" ni [namespace children]} {
 ::tcltest::loadTestedCommands
 catch [list package require -exact tcl::test [info patchlevel]]
 
-proc failTrace {name1 name2 op} {
-    error "trace failed"
-}
-
 testConstraint testevalex [llength [info commands testevalex]]
 
-set noRead {}
-trace add variable noRead read failTrace
-set noWrite {a b c}
-trace add variable noWrite write failTrace
+proc newlist list {
+    return $list
+}
 
-test lset-1.1 {lset, not compiled, arg count} testevalex {
-    list [catch {testevalex lset} msg] $msg
-} "1 {wrong \# args: should be \"lset listVar ?index? ?index ...? value\"}"
-test lset-1.2 {lset, not compiled, no such var} testevalex {
-    list [catch {testevalex {lset noSuchVar 0 {}}} msg] $msg
-} "1 {can't read \"noSuchVar\": no such variable}"
-test lset-1.3 {lset, not compiled, var not readable} testevalex {
-    list [catch {testevalex {lset noRead 0 {}}} msg] $msg
-} "1 {can't read \"noRead\": trace failed}"
 
-test lset-2.1 {lset, not compiled, 3 args, second arg a plain index} testevalex {
-    set x {0 1 2}
-    list [testevalex {lset x 0 3}] $x
-} {{3 1 2} {3 1 2}}
-test lset-2.2 {lset, not compiled, 3 args, second arg neither index nor list} testevalex {
-    set x {0 1 2}
-    list [catch {
-	testevalex {lset x {{bad}1} 3}
-    } msg] $msg
-} {1 {bad index "{bad}1": must be integer?[+-]integer? or end?[+-]integer?}}
+variable tests {
+    foreach map {
+	{
+	    @mode@ compiled
+	    @lset@ lset
+	}
+	{
+	    @mode@ uncompiled
+	    @lset@ {[lindex lset]}
+	}
+    } {
+	set script [string map $map {
 
-test lset-3.1 {lset, not compiled, 3 args, data duplicated} testevalex {
-    set x {0 1 2}
-    list [testevalex {lset x 0 $x}] $x
-} {{{0 1 2} 1 2} {{0 1 2} 1 2}}
-test lset-3.2 {lset, not compiled, 3 args, data duplicated} testevalex {
-    set x {0 1}
-    set y $x
-    list [testevalex {lset x 0 2}] $x $y
-} {{2 1} {2 1} {0 1}}
-test lset-3.3 {lset, not compiled, 3 args, data duplicated} testevalex {
-    set x {0 1}
-    set y $x
-    list [testevalex {lset x 0 $x}] $x $y
-} {{{0 1} 1} {{0 1} 1} {0 1}}
-test lset-3.4 {lset, not compiled, 3 args, data duplicated} testevalex {
-    set x {0 1 2}
-    list [testevalex {lset x [list 0] $x}] $x
-} {{{0 1 2} 1 2} {{0 1 2} 1 2}}
-test lset-3.5 {lset, not compiled, 3 args, data duplicated} testevalex {
-    set x {0 1}
-    set y $x
-    list [testevalex {lset x [list 0] 2}] $x $y
-} {{2 1} {2 1} {0 1}}
-test lset-3.6 {lset, not compiled, 3 args, data duplicated} testevalex {
-    set x {0 1}
-    set y $x
-    list [testevalex {lset x [list 0] $x}] $x $y
-} {{{0 1} 1} {{0 1} 1} {0 1}}
+	    proc failTrace {name1 name2 op} {
+		error "trace failed"
+	    }
 
-test lset-4.1 {lset, not compiled, 3 args, not a list} testevalex {
-    set a "x \{"
-    list [catch {
-	testevalex {lset a [list 0] y}
-    } msg] $msg
-} {1 {unmatched open brace in list}}
-test lset-4.2 {lset, not compiled, 3 args, bad index} testevalex {
-    set a {x y z}
-    list [catch {
-	testevalex {lset a [list 2a2] w}
-    } msg] $msg
-} {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}}
-test lset-4.3 {lset, not compiled, 3 args, index out of range} testevalex {
-    set a {x y z}
-    list [catch {
-	testevalex {lset a [list -1] w}
-    } msg] $msg
-} {1 {index "-1" out of range}}
-test lset-4.4 {lset, not compiled, 3 args, index out of range} testevalex {
-    set a {x y z}
-    list [catch {
-	testevalex {lset a [list 4] w}
-    } msg] $msg
-} {1 {index "4" out of range}}
-test lset-4.5a {lset, not compiled, 3 args, index out of range} testevalex {
-    set a {x y z}
-    list [catch {
-	testevalex {lset a [list end--2] w}
-    } msg] $msg
-} {1 {index "end--2" out of range}}
-test lset-4.5b {lset, not compiled, 3 args, index out of range} testevalex {
-    set a {x y z}
-    list [catch {
-	testevalex {lset a [list end+2] w}
-    } msg] $msg
-} {1 {index "end+2" out of range}}
-test lset-4.6 {lset, not compiled, 3 args, index out of range} testevalex {
-    set a {x y z}
-    list [catch {
-	testevalex {lset a [list end-3] w}
-    } msg] $msg
-} {1 {index "end-3" out of range}}
-test lset-4.7 {lset, not compiled, 3 args, not a list} testevalex {
-    set a "x \{"
-    list [catch {
-	testevalex {lset a 0 y}
-    } msg] $msg
-} {1 {unmatched open brace in list}}
-test lset-4.8 {lset, not compiled, 3 args, bad index} testevalex {
-    set a {x y z}
-    list [catch {
-	testevalex {lset a 2a2 w}
-    } msg] $msg
-} {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}}
-test lset-4.9 {lset, not compiled, 3 args, index out of range} testevalex {
-    set a {x y z}
-    list [catch {
-	testevalex {lset a -1 w}
-    } msg] $msg
-} {1 {index "-1" out of range}}
-test lset-4.10 {lset, not compiled, 3 args, index out of range} testevalex {
-    set a {x y z}
-    list [catch {
-	testevalex {lset a 4 w}
-    } msg] $msg
-} {1 {index "4" out of range}}
-test lset-4.11a {lset, not compiled, 3 args, index out of range} testevalex {
-    set a {x y z}
-    list [catch {
-	testevalex {lset a end--2 w}
-    } msg] $msg
-} {1 {index "end--2" out of range}}
-test lset-4.11 {lset, not compiled, 3 args, index out of range} testevalex {
-    set a {x y z}
-    list [catch {
-	testevalex {lset a end+2 w}
-    } msg] $msg
-} {1 {index "end+2" out of range}}
-test lset-4.12 {lset, not compiled, 3 args, index out of range} testevalex {
-    set a {x y z}
-    list [catch {
-	testevalex {lset a end-3 w}
-    } msg] $msg
-} {1 {index "end-3" out of range}}
+	    set noRead {}
+	    trace add variable noRead read failTrace
+	    set noWrite {a b c}
+	    trace add variable noWrite write failTrace
 
-test lset-5.1 {lset, not compiled, 3 args, can't set variable} testevalex {
-    list [catch {
-	testevalex {lset noWrite 0 d}
-    } msg] $msg $noWrite
-} {1 {can't set "noWrite": trace failed} {d b c}}
-test lset-5.2 {lset, not compiled, 3 args, can't set variable} testevalex {
-    list [catch {
-	testevalex {lset noWrite [list 0] d}
-    } msg] $msg $noWrite
-} {1 {can't set "noWrite": trace failed} {d b c}}
+	    test lset-1.1-@mode@ {lset, not compiled, arg count} testevalex {
+		list [catch {testevalex @lset@} msg] $msg
+	    } "1 {wrong \# args: should be \"lset listVar ?index? ?index ...? value\"}"
+	    test lset-1.2-@mode@ {lset, not compiled, no such var} testevalex {
+		list [catch {testevalex {@lset@ noSuchVar 0 {}}} msg] $msg
+	    } "1 {can't read \"noSuchVar\": no such variable}"
+	    test lset-1.3-@mode@ {lset, not compiled, var not readable} testevalex {
+		list [catch {testevalex {@lset@ noRead 0 {}}} msg] $msg
+	    } "1 {can't read \"noRead\": trace failed}"
 
-test lset-6.1 {lset, not compiled, 3 args, 1-d list basics} testevalex {
-    set a {x y z}
-    list [testevalex {lset a 0 a}] $a
-} {{a y z} {a y z}}
-test lset-6.2 {lset, not compiled, 3 args, 1-d list basics} testevalex {
-    set a {x y z}
-    list [testevalex {lset a [list 0] a}] $a
-} {{a y z} {a y z}}
-test lset-6.3 {lset, not compiled, 1-d list basics} testevalex {
-    set a {x y z}
-    list [testevalex {lset a 2 a}] $a
-} {{x y a} {x y a}}
-test lset-6.4 {lset, not compiled, 1-d list basics} testevalex {
-    set a {x y z}
-    list [testevalex {lset a [list 2] a}] $a
-} {{x y a} {x y a}}
-test lset-6.5 {lset, not compiled, 1-d list basics} testevalex {
-    set a {x y z}
-    list [testevalex {lset a end a}] $a
-} {{x y a} {x y a}}
-test lset-6.6 {lset, not compiled, 1-d list basics} testevalex {
-    set a {x y z}
-    list [testevalex {lset a [list end] a}] $a
-} {{x y a} {x y a}}
-test lset-6.7 {lset, not compiled, 1-d list basics} testevalex {
-    set a {x y z}
-    list [testevalex {lset a end-0 a}] $a
-} {{x y a} {x y a}}
-test lset-6.8 {lset, not compiled, 1-d list basics} testevalex {
-    set a {x y z}
-    list [testevalex {lset a [list end-0] a}] $a
-} {{x y a} {x y a}}
-test lset-6.9 {lset, not compiled, 1-d list basics} testevalex {
-    set a {x y z}
-    list [testevalex {lset a end-2 a}] $a
-} {{a y z} {a y z}}
-test lset-6.10 {lset, not compiled, 1-d list basics} testevalex {
-    set a {x y z}
-    list [testevalex {lset a [list end-2] a}] $a
-} {{a y z} {a y z}}
+	    test lset-2.1-@mode@ {lset, not compiled, 3 args, second arg a plain index} testevalex {
+		set x {0 1 2}
+		list [testevalex {@lset@ x 0 3}] $x
+	    } {{3 1 2} {3 1 2}}
+	    test lset-2.2-@mode@ {lset, not compiled, 3 args, second arg neither index nor list} testevalex {
+		set x {0 1 2}
+		list [catch {
+		    testevalex {@lset@ x {{bad}1} 3}
+		} msg] $msg
+	    } {1 {bad index "{bad}1": must be integer?[+-]integer? or end?[+-]integer?}}
 
-test lset-7.1 {lset, not compiled, data sharing} testevalex {
-    set a 0
-    list [testevalex {lset a $a {gag me}}] $a
-} {{{gag me}} {{gag me}}}
-test lset-7.2 {lset, not compiled, data sharing} testevalex {
-    set a [list 0]
-    list [testevalex {lset a $a {gag me}}] $a
-} {{{gag me}} {{gag me}}}
-test lset-7.3 {lset, not compiled, data sharing} testevalex {
-    set a {x y}
-    list [testevalex {lset a 0 $a}] $a
-} {{{x y} y} {{x y} y}}
-test lset-7.4 {lset, not compiled, data sharing} testevalex {
-    set a {x y}
-    list [testevalex {lset a [list 0] $a}] $a
-} {{{x y} y} {{x y} y}}
-test lset-7.5 {lset, not compiled, data sharing} testevalex {
-    set n 0
-    set a {x y}
-    list [testevalex {lset a $n $n}] $a $n
-} {{0 y} {0 y} 0}
-test lset-7.6 {lset, not compiled, data sharing} testevalex {
-    set n [list 0]
-    set a {x y}
-    list [testevalex {lset a $n $n}] $a $n
-} {{0 y} {0 y} 0}
-test lset-7.7 {lset, not compiled, data sharing} testevalex {
-    set n 0
-    set a [list $n $n]
-    list [testevalex {lset a $n 1}] $a $n
-} {{1 0} {1 0} 0}
-test lset-7.8 {lset, not compiled, data sharing} testevalex {
-    set n [list 0]
-    set a [list $n $n]
-    list [testevalex {lset a $n 1}] $a $n
-} {{1 0} {1 0} 0}
-test lset-7.9 {lset, not compiled, data sharing} testevalex {
-    set a 0
-    list [testevalex {lset a $a $a}] $a
-} {0 0}
-test lset-7.10 {lset, not compiled, data sharing} testevalex {
-    set a [list 0]
-    list [testevalex {lset a $a $a}] $a
-} {0 0}
+	    test lset-3.1-@mode@ {lset, not compiled, 3 args, data duplicated} testevalex {
+		set x {0 1 2}
+		list [testevalex {@lset@ x 0 $x}] $x
+	    } {{{0 1 2} 1 2} {{0 1 2} 1 2}}
+	    test lset-3.2-@mode@ {lset, not compiled, 3 args, data duplicated} testevalex {
+		set x {0 1}
+		set y $x
+		list [testevalex {@lset@ x 0 2}] $x $y
+	    } {{2 1} {2 1} {0 1}}
+	    test lset-3.3-@mode@ {lset, not compiled, 3 args, data duplicated} testevalex {
+		set x {0 1}
+		set y $x
+		list [testevalex {@lset@ x 0 $x}] $x $y
+	    } {{{0 1} 1} {{0 1} 1} {0 1}}
+	    test lset-3.4-@mode@ {lset, not compiled, 3 args, data duplicated} testevalex {
+		set x {0 1 2}
+		list [testevalex {@lset@ x [list 0] $x}] $x
+	    } {{{0 1 2} 1 2} {{0 1 2} 1 2}}
+	    test lset-3.5-@mode@ {lset, not compiled, 3 args, data duplicated} testevalex {
+		set x {0 1}
+		set y $x
+		list [testevalex {@lset@ x [list 0] 2}] $x $y
+	    } {{2 1} {2 1} {0 1}}
+	    test lset-3.6-@mode@ {lset, not compiled, 3 args, data duplicated} testevalex {
+		set x {0 1}
+		set y $x
+		list [testevalex {@lset@ x [list 0] $x}] $x $y
+	    } {{{0 1} 1} {{0 1} 1} {0 1}}
 
-test lset-8.1 {lset, not compiled, malformed sublist} testevalex {
-    set a [list "a \{" b]
-    list [catch {testevalex {lset a 0 1 c}} msg] $msg
-} {1 {unmatched open brace in list}}
-test lset-8.2 {lset, not compiled, malformed sublist} testevalex {
-    set a [list "a \{" b]
-    list [catch {testevalex {lset a {0 1} c}} msg] $msg
-} {1 {unmatched open brace in list}}
-test lset-8.3 {lset, not compiled, bad second index} testevalex {
-    set a {{b c} {d e}}
-    list [catch {testevalex {lset a 0 2a2 f}} msg] $msg
-} {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}}
-test lset-8.4 {lset, not compiled, bad second index} testevalex {
-    set a {{b c} {d e}}
-    list [catch {testevalex {lset a {0 2a2} f}} msg] $msg
-} {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}}
-test lset-8.5 {lset, not compiled, second index out of range} testevalex {
-    set a {{b c} {d e} {f g}}
-    list [catch {testevalex {lset a 2 -1 h}} msg] $msg
-} {1 {index "-1" out of range}}
-test lset-8.6 {lset, not compiled, second index out of range} testevalex {
-    set a {{b c} {d e} {f g}}
-    list [catch {testevalex {lset a {2 -1} h}} msg] $msg
-} {1 {index "-1" out of range}}
-test lset-8.7 {lset, not compiled, second index out of range} testevalex {
-    set a {{b c} {d e} {f g}}
-    list [catch {testevalex {lset a 2 3 h}} msg] $msg
-} {1 {index "3" out of range}}
-test lset-8.8 {lset, not compiled, second index out of range} testevalex {
-    set a {{b c} {d e} {f g}}
-    list [catch {testevalex {lset a {2 3} h}} msg] $msg
-} {1 {index "3" out of range}}
-test lset-8.9a {lset, not compiled, second index out of range} testevalex {
-    set a {{b c} {d e} {f g}}
-    list [catch {testevalex {lset a 2 end--2 h}} msg] $msg
-} {1 {index "end--2" out of range}}
-test lset-8.9b {lset, not compiled, second index out of range} testevalex {
-    set a {{b c} {d e} {f g}}
-    list [catch {testevalex {lset a 2 end+2 h}} msg] $msg
-} {1 {index "end+2" out of range}}
-test lset-8.10a {lset, not compiled, second index out of range} testevalex {
-    set a {{b c} {d e} {f g}}
-    list [catch {testevalex {lset a {2 end--2} h}} msg] $msg
-} {1 {index "end--2" out of range}}
-test lset-8.10b {lset, not compiled, second index out of range} testevalex {
-    set a {{b c} {d e} {f g}}
-    list [catch {testevalex {lset a {2 end+2} h}} msg] $msg
-} {1 {index "end+2" out of range}}
-test lset-8.11 {lset, not compiled, second index out of range} testevalex {
-    set a {{b c} {d e} {f g}}
-    list [catch {testevalex {lset a 2 end-2 h}} msg] $msg
-} {1 {index "end-2" out of range}}
-test lset-8.12 {lset, not compiled, second index out of range} testevalex {
-    set a {{b c} {d e} {f g}}
-    list [catch {testevalex {lset a {2 end-2} h}} msg] $msg
-} {1 {index "end-2" out of range}}
+	    test lset-4.1-@mode@ {lset, not compiled, 3 args, not a list} testevalex {
+		set a "x \{"
+		list [catch {
+		    testevalex {@lset@ a [list 0] y}
+		} msg] $msg
+	    } {1 {unmatched open brace in list}}
+	    test lset-4.2-@mode@ {lset, not compiled, 3 args, bad index} testevalex {
+		set a {x y z}
+		list [catch {
+		    testevalex {@lset@ a [list 2a2] w}
+		} msg] $msg
+	    } {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}}
+	    test lset-4.3-@mode@ {lset, not compiled, 3 args, index out of range} testevalex {
+		set a {x y z}
+		list [catch {
+		    testevalex {@lset@ a [list -1] w}
+		} msg] $msg
+	    } {1 {index "-1" out of range}}
+	    test lset-4.4-@mode@ {lset, not compiled, 3 args, index out of range} testevalex {
+		set a {x y z}
+		list [catch {
+		    testevalex {@lset@ a [list 4] w}
+		} msg] $msg
+	    } {1 {index "4" out of range}}
+	    test lset-4.5a-@mode@ {lset, not compiled, 3 args, index out of range} testevalex {
+		set a {x y z}
+		list [catch {
+		    testevalex {@lset@ a [list end--2] w}
+		} msg] $msg
+	    } {1 {index "end--2" out of range}}
+	    test lset-4.5b-@mode@ {lset, not compiled, 3 args, index out of range} testevalex {
+		set a {x y z}
+		list [catch {
+		    testevalex {@lset@ a [list end+2] w}
+		} msg] $msg
+	    } {1 {index "end+2" out of range}}
+	    test lset-4.6-@mode@ {lset, not compiled, 3 args, index out of range} testevalex {
+		set a {x y z}
+		list [catch {
+		    testevalex {@lset@ a [list end-3] w}
+		} msg] $msg
+	    } {1 {index "end-3" out of range}}
+	    test lset-4.7-@mode@ {lset, not compiled, 3 args, not a list} testevalex {
+		set a "x \{"
+		list [catch {
+		    testevalex {@lset@ a 0 y}
+		} msg] $msg
+	    } {1 {unmatched open brace in list}}
+	    test lset-4.8-@mode@ {lset, not compiled, 3 args, bad index} testevalex {
+		set a {x y z}
+		list [catch {
+		    testevalex {@lset@ a 2a2 w}
+		} msg] $msg
+	    } {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}}
+	    test lset-4.9-@mode@ {lset, not compiled, 3 args, index out of range} testevalex {
+		set a {x y z}
+		list [catch {
+		    testevalex {@lset@ a -1 w}
+		} msg] $msg
+	    } {1 {index "-1" out of range}}
+	    test lset-4.10-@mode@ {lset, not compiled, 3 args, index out of range} testevalex {
+		set a {x y z}
+		list [catch {
+		    testevalex {@lset@ a 4 w}
+		} msg] $msg
+	    } {1 {index "4" out of range}}
+	    test lset-4.11a-@mode@ {lset, not compiled, 3 args, index out of range} testevalex {
+		set a {x y z}
+		list [catch {
+		    testevalex {@lset@ a end--2 w}
+		} msg] $msg
+	    } {1 {index "end--2" out of range}}
+	    test lset-4.11-@mode@ {lset, not compiled, 3 args, index out of range} testevalex {
+		set a {x y z}
+		list [catch {
+		    testevalex {@lset@ a end+2 w}
+		} msg] $msg
+	    } {1 {index "end+2" out of range}}
+	    test lset-4.12-@mode@ {lset, not compiled, 3 args, index out of range} testevalex {
+		set a {x y z}
+		list [catch {
+		    testevalex {@lset@ a end-3 w}
+		} msg] $msg
+	    } {1 {index "end-3" out of range}}
 
-test lset-9.1 {lset, not compiled, entire variable} testevalex {
-    set a x
-    list [testevalex {lset a y}] $a
-} {y y}
-test lset-9.2 {lset, not compiled, entire variable} testevalex {
-    set a x
-    list [testevalex {lset a {} y}] $a
-} {y y}
+	    test lset-5.1-@mode@ {lset, not compiled, 3 args, can't set variable} testevalex {
+		list [catch {
+		    testevalex {@lset@ noWrite 0 d}
+		} msg] $msg $noWrite
+	    } {1 {can't set "noWrite": trace failed} {d b c}}
+	    test lset-5.2-@mode@ {lset, not compiled, 3 args, can't set variable} testevalex {
+		list [catch {
+		    testevalex {@lset@ noWrite [list 0] d}
+		} msg] $msg $noWrite
+	    } {1 {can't set "noWrite": trace failed} {d b c}}
 
-test lset-10.1 {lset, not compiled, shared data} testevalex {
-    set row {p q}
-    set a [list $row $row]
-    list [testevalex {lset a 0 0 x}] $a
-} {{{x q} {p q}} {{x q} {p q}}}
-test lset-10.2 {lset, not compiled, shared data} testevalex {
-    set row {p q}
-    set a [list $row $row]
-    list [testevalex {lset a {0 0} x}] $a
-} {{{x q} {p q}} {{x q} {p q}}}
-test lset-10.3 {lset, not compiled, shared data, [Bug 1333036]} testevalex {
-    set a [list [list p q] [list r s]]
-    set b $a
-    list [testevalex {lset b {0 0} x}] $a
-} {{{x q} {r s}} {{p q} {r s}}}
+	    test lset-6.1-@mode@ {lset, not compiled, 3 args, 1-d list basics} testevalex {
+		set a {x y z}
+		list [testevalex {@lset@ a 0 a}] $a
+	    } {{a y z} {a y z}}
+	    test lset-6.2-@mode@ {lset, not compiled, 3 args, 1-d list basics} testevalex {
+		set a {x y z}
+		list [testevalex {@lset@ a [list 0] a}] $a
+	    } {{a y z} {a y z}}
+	    test lset-6.3-@mode@ {lset, not compiled, 1-d list basics} testevalex {
+		set a {x y z}
+		list [testevalex {@lset@ a 2 a}] $a
+	    } {{x y a} {x y a}}
+	    test lset-6.4-@mode@ {lset, not compiled, 1-d list basics} testevalex {
+		set a {x y z}
+		list [testevalex {@lset@ a [list 2] a}] $a
+	    } {{x y a} {x y a}}
+	    test lset-6.5-@mode@ {lset, not compiled, 1-d list basics} testevalex {
+		set a {x y z}
+		list [testevalex {@lset@ a end a}] $a
+	    } {{x y a} {x y a}}
+	    test lset-6.6-@mode@ {lset, not compiled, 1-d list basics} testevalex {
+		set a {x y z}
+		list [testevalex {@lset@ a [list end] a}] $a
+	    } {{x y a} {x y a}}
+	    test lset-6.7-@mode@ {lset, not compiled, 1-d list basics} testevalex {
+		set a {x y z}
+		list [testevalex {@lset@ a end-0 a}] $a
+	    } {{x y a} {x y a}}
+	    test lset-6.8-@mode@ {lset, not compiled, 1-d list basics} testevalex {
+		set a {x y z}
+		list [testevalex {@lset@ a [list end-0] a}] $a
+	    } {{x y a} {x y a}}
+	    test lset-6.9-@mode@ {lset, not compiled, 1-d list basics} testevalex {
+		set a {x y z}
+		list [testevalex {@lset@ a end-2 a}] $a
+	    } {{a y z} {a y z}}
+	    test lset-6.10-@mode@ {lset, not compiled, 1-d list basics} testevalex {
+		set a {x y z}
+		list [testevalex {@lset@ a [list end-2] a}] $a
+	    } {{a y z} {a y z}}
 
-test lset-11.1 {lset, not compiled, 2-d basics} testevalex {
-    set a {{b c} {d e}}
-    list [testevalex {lset a 0 0 f}] $a
-} {{{f c} {d e}} {{f c} {d e}}}
-test lset-11.2 {lset, not compiled, 2-d basics} testevalex {
-    set a {{b c} {d e}}
-    list [testevalex {lset a {0 0} f}] $a
-} {{{f c} {d e}} {{f c} {d e}}}
-test lset-11.3 {lset, not compiled, 2-d basics} testevalex {
-    set a {{b c} {d e}}
-    list [testevalex {lset a 0 1 f}] $a
-} {{{b f} {d e}} {{b f} {d e}}}
-test lset-11.4 {lset, not compiled, 2-d basics} testevalex {
-    set a {{b c} {d e}}
-    list [testevalex {lset a {0 1} f}] $a
-} {{{b f} {d e}} {{b f} {d e}}}
-test lset-11.5 {lset, not compiled, 2-d basics} testevalex {
-    set a {{b c} {d e}}
-    list [testevalex {lset a 1 0 f}] $a
-} {{{b c} {f e}} {{b c} {f e}}}
-test lset-11.6 {lset, not compiled, 2-d basics} testevalex {
-    set a {{b c} {d e}}
-    list [testevalex {lset a {1 0} f}] $a
-} {{{b c} {f e}} {{b c} {f e}}}
-test lset-11.7 {lset, not compiled, 2-d basics} testevalex {
-    set a {{b c} {d e}}
-    list [testevalex {lset a 1 1 f}] $a
-} {{{b c} {d f}} {{b c} {d f}}}
-test lset-11.8 {lset, not compiled, 2-d basics} testevalex {
-    set a {{b c} {d e}}
-    list [testevalex {lset a {1 1} f}] $a
-} {{{b c} {d f}} {{b c} {d f}}}
+	    test lset-7.1-@mode@ {lset, not compiled, data sharing} testevalex {
+		set a 0
+		list [testevalex {@lset@ a $a {gag me}}] $a
+	    } {{{gag me}} {{gag me}}}
+	    test lset-7.2-@mode@ {lset, not compiled, data sharing} testevalex {
+		set a [list 0]
+		list [testevalex {@lset@ a $a {gag me}}] $a
+	    } {{{gag me}} {{gag me}}}
+	    test lset-7.3-@mode@ {lset, not compiled, data sharing} testevalex {
+		set a {x y}
+		list [testevalex {@lset@ a 0 $a}] $a
+	    } {{{x y} y} {{x y} y}}
+	    test lset-7.4-@mode@ {lset, not compiled, data sharing} testevalex {
+		set a {x y}
+		list [testevalex {@lset@ a [list 0] $a}] $a
+	    } {{{x y} y} {{x y} y}}
+	    test lset-7.5-@mode@ {lset, not compiled, data sharing} testevalex {
+		set n 0
+		set a {x y}
+		list [testevalex {@lset@ a $n $n}] $a $n
+	    } {{0 y} {0 y} 0}
+	    test lset-7.6-@mode@ {lset, not compiled, data sharing} testevalex {
+		set n [list 0]
+		set a {x y}
+		list [testevalex {@lset@ a $n $n}] $a $n
+	    } {{0 y} {0 y} 0}
+	    test lset-7.7-@mode@ {lset, not compiled, data sharing} testevalex {
+		set n 0
+		set a [list $n $n]
+		list [testevalex {@lset@ a $n 1}] $a $n
+	    } {{1 0} {1 0} 0}
+	    test lset-7.8-@mode@ {lset, not compiled, data sharing} testevalex {
+		set n [list 0]
+		set a [list $n $n]
+		list [testevalex {@lset@ a $n 1}] $a $n
+	    } {{1 0} {1 0} 0}
+	    test lset-7.9-@mode@ {lset, not compiled, data sharing} testevalex {
+		set a 0
+		list [testevalex {@lset@ a $a $a}] $a
+	    } {0 0}
+	    test lset-7.10-@mode@ {lset, not compiled, data sharing} testevalex {
+		set a [list 0]
+		list [testevalex {@lset@ a $a $a}] $a
+	    } {0 0}
 
-test lset-12.0 {lset, not compiled, typical sharing pattern} testevalex {
-    set zero 0
-    set row [list $zero $zero $zero $zero]
-    set ident [list $row $row $row $row]
-    for { set i 0 } { $i < 4 } { incr i } {
-	testevalex {lset ident $i $i 1}
+	    test lset-8.1-@mode@ {lset, not compiled, malformed sublist} testevalex {
+		set a [list "a \{" b]
+		list [catch {testevalex {@lset@ a 0 1 c}} msg] $msg
+	    } {1 {unmatched open brace in list}}
+	    test lset-8.2-@mode@ {lset, not compiled, malformed sublist} testevalex {
+		set a [list "a \{" b]
+		list [catch {testevalex {@lset@ a {0 1} c}} msg] $msg
+	    } {1 {unmatched open brace in list}}
+	    test lset-8.3-@mode@ {lset, not compiled, bad second index} testevalex {
+		set a {{b c} {d e}}
+		list [catch {testevalex {@lset@ a 0 2a2 f}} msg] $msg
+	    } {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}}
+	    test lset-8.4-@mode@ {lset, not compiled, bad second index} testevalex {
+		set a {{b c} {d e}}
+		list [catch {testevalex {@lset@ a {0 2a2} f}} msg] $msg
+	    } {1 {bad index "2a2": must be integer?[+-]integer? or end?[+-]integer?}}
+	    test lset-8.5-@mode@ {lset, not compiled, second index out of range} testevalex {
+		set a {{b c} {d e} {f g}}
+		list [catch {testevalex {@lset@ a 2 -1 h}} msg] $msg
+	    } {1 {index "-1" out of range}}
+	    test lset-8.6-@mode@ {lset, not compiled, second index out of range} testevalex {
+		set a {{b c} {d e} {f g}}
+		list [catch {testevalex {@lset@ a {2 -1} h}} msg] $msg
+	    } {1 {index "-1" out of range}}
+	    test lset-8.7-@mode@ {lset, not compiled, second index out of range} testevalex {
+		set a {{b c} {d e} {f g}}
+		list [catch {testevalex {@lset@ a 2 3 h}} msg] $msg
+	    } {1 {index "3" out of range}}
+	    test lset-8.8-@mode@ {lset, not compiled, second index out of range} testevalex {
+		set a {{b c} {d e} {f g}}
+		list [catch {testevalex {@lset@ a {2 3} h}} msg] $msg
+	    } {1 {index "3" out of range}}
+	    test lset-8.9a-@mode@ {lset, not compiled, second index out of range} testevalex {
+		set a {{b c} {d e} {f g}}
+		list [catch {testevalex {@lset@ a 2 end--2 h}} msg] $msg
+	    } {1 {index "end--2" out of range}}
+	    test lset-8.9b-@mode@ {lset, not compiled, second index out of range} testevalex {
+		set a {{b c} {d e} {f g}}
+		list [catch {testevalex {@lset@ a 2 end+2 h}} msg] $msg
+	    } {1 {index "end+2" out of range}}
+	    test lset-8.10a-@mode@ {lset, not compiled, second index out of range} testevalex {
+		set a {{b c} {d e} {f g}}
+		list [catch {testevalex {@lset@ a {2 end--2} h}} msg] $msg
+	    } {1 {index "end--2" out of range}}
+	    test lset-8.10b-@mode@ {lset, not compiled, second index out of range} testevalex {
+		set a {{b c} {d e} {f g}}
+		list [catch {testevalex {@lset@ a {2 end+2} h}} msg] $msg
+	    } {1 {index "end+2" out of range}}
+	    test lset-8.11-@mode@ {lset, not compiled, second index out of range} testevalex {
+		set a {{b c} {d e} {f g}}
+		list [catch {testevalex {@lset@ a 2 end-2 h}} msg] $msg
+	    } {1 {index "end-2" out of range}}
+	    test lset-8.12-@mode@ {lset, not compiled, second index out of range} testevalex {
+		set a {{b c} {d e} {f g}}
+		list [catch {testevalex {@lset@ a {2 end-2} h}} msg] $msg
+	    } {1 {index "end-2" out of range}}
+
+	    test lset-9.1-@mode@ {lset, not compiled, entire variable} testevalex {
+		set a x
+		list [testevalex {@lset@ a y}] $a
+	    } {y y}
+	    test lset-9.2-@mode@ {lset, not compiled, entire variable} testevalex {
+		set a x
+		list [testevalex {@lset@ a {} y}] $a
+	    } {y y}
+
+	    test lset-10.1-@mode@ {lset, not compiled, shared data} testevalex {
+		set row {p q}
+		set a [list $row $row]
+		list [testevalex {@lset@ a 0 0 x}] $a
+	    } {{{x q} {p q}} {{x q} {p q}}}
+	    test lset-10.2-@mode@ {lset, not compiled, shared data} testevalex {
+		set row {p q}
+		set a [list $row $row]
+		list [testevalex {@lset@ a {0 0} x}] $a
+	    } {{{x q} {p q}} {{x q} {p q}}}
+	    test lset-10.3-@mode@ {lset, not compiled, shared data, [Bug 1333036]} testevalex {
+		set a [list [list p q] [list r s]]
+		set b $a
+		list [testevalex {@lset@ b {0 0} x}] $a
+	    } {{{x q} {r s}} {{p q} {r s}}}
+
+	    test lset-11.1-@mode@ {lset, not compiled, 2-d basics} testevalex {
+		set a {{b c} {d e}}
+		list [testevalex {@lset@ a 0 0 f}] $a
+	    } {{{f c} {d e}} {{f c} {d e}}}
+	    test lset-11.2-@mode@ {lset, not compiled, 2-d basics} testevalex {
+		set a {{b c} {d e}}
+		list [testevalex {@lset@ a {0 0} f}] $a
+	    } {{{f c} {d e}} {{f c} {d e}}}
+	    test lset-11.3-@mode@ {lset, not compiled, 2-d basics} testevalex {
+		set a {{b c} {d e}}
+		list [testevalex {@lset@ a 0 1 f}] $a
+	    } {{{b f} {d e}} {{b f} {d e}}}
+	    test lset-11.4-@mode@ {lset, not compiled, 2-d basics} testevalex {
+		set a {{b c} {d e}}
+		list [testevalex {@lset@ a {0 1} f}] $a
+	    } {{{b f} {d e}} {{b f} {d e}}}
+	    test lset-11.5-@mode@ {lset, not compiled, 2-d basics} testevalex {
+		set a {{b c} {d e}}
+		list [testevalex {@lset@ a 1 0 f}] $a
+	    } {{{b c} {f e}} {{b c} {f e}}}
+	    test lset-11.6-@mode@ {lset, not compiled, 2-d basics} testevalex {
+		set a {{b c} {d e}}
+		list [testevalex {@lset@ a {1 0} f}] $a
+	    } {{{b c} {f e}} {{b c} {f e}}}
+	    test lset-11.7-@mode@ {lset, not compiled, 2-d basics} testevalex {
+		set a {{b c} {d e}}
+		list [testevalex {@lset@ a 1 1 f}] $a
+	    } {{{b c} {d f}} {{b c} {d f}}}
+	    test lset-11.8-@mode@ {lset, not compiled, 2-d basics} testevalex {
+		set a {{b c} {d e}}
+		list [testevalex {@lset@ a {1 1} f}] $a
+	    } {{{b c} {d f}} {{b c} {d f}}}
+
+	    test lset-12.0-@mode@ {lset, not compiled, typical sharing pattern} testevalex {
+		set zero 0
+		set row [list $zero $zero $zero $zero]
+		set ident [list $row $row $row $row]
+		for { set i 0 } { $i < 4 } { incr i } {
+		    testevalex {@lset@ ident $i $i 1}
+		}
+		set ident
+	    } {{1 0 0 0} {0 1 0 0} {0 0 1 0} {0 0 0 1}}
+
+	    test lset-13.0-@mode@ {lset, not compiled, shimmering hell} testevalex {
+		set a 0
+		list [testevalex {@lset@ a $a $a $a $a {gag me}}] $a
+	    } {{{{{{gag me}}}}} {{{{{gag me}}}}}}
+	    test lset-13.1-@mode@ {lset, not compiled, shimmering hell} testevalex {
+		set a [list 0]
+		list [testevalex {@lset@ a $a $a $a $a {gag me}}] $a
+	    } {{{{{{gag me}}}}} {{{{{gag me}}}}}}
+	    test lset-13.2-@mode@ {lset, not compiled, shimmering hell} testevalex {
+		set a [list 0 0 0 0]
+		list [testevalex {@lset@ a $a {gag me}}] $a
+	    } {{{{{{gag me}}}} 0 0 0} {{{{{gag me}}}} 0 0 0}}
+
+	    test lset-14.1-@mode@ {lset, not compiled, list args, is string rep preserved?} testevalex {
+		set a { { 1 2 } { 3 4 } }
+		catch { testevalex {@lset@ a {1 5} 5} }
+		list $a [lindex $a 1]
+	    } "{ { 1 2 } { 3 4 } } { 3 4 }"
+	    test lset-14.2-@mode@ {lset, not compiled, flat args, is string rep preserved?} testevalex {
+		set a { { 1 2 } { 3 4 } }
+		catch { testevalex {@lset@ a 1 5 5} }
+		list $a [lindex $a 1]
+	    } "{ { 1 2 } { 3 4 } } { 3 4 }"
+
+	    testConstraint testobj [llength [info commands testobj]]
+	    test lset-15.1-@mode@ {lset: shared internalrep [Bug 1677512]} -setup {
+		teststringobj set 1 {{1 2} 3}
+		testobj convert 1 list
+		testobj duplicate 1 2
+		variable x [teststringobj get 1]
+		variable y [teststringobj get 2]
+		testobj freeallvars
+		set l [list $y z]
+		unset y
+	    } -constraints testobj -body {
+		@lset@ l 0 0 0 5
+		lindex $x 0 0
+	    } -cleanup {
+		unset -nocomplain x l
+	    } -result 1
+
+	    test lset-16.1-@mode@ {lset - grow a variable} testevalex {
+		set x {}
+		testevalex {@lset@ x 0 {test 1}}
+		testevalex {lset x 1 {test 2}}
+		set x
+	    } {{test 1} {test 2}}
+	    test lset-16.2-@mode@ {@lset@ - multiple created sublists} testevalex {
+		set x {}
+		testevalex {lset x 0 0 {test 1}}
+	    } {{{test 1}}}
+	    test lset-16.3-@mode@ {@lset@ - sublists 3 deep} testevalex {
+		set x {}
+		testevalex {lset x 0 0 0 {test 1}}
+	    } {{{{test 1}}}}
+	    test lset-16.4-@mode@ {@lset@ - append to inner list} testevalex {
+		set x {test 1}
+		testevalex {@lset@ x 1 1 2}
+		testevalex {@lset@ x 1 2 3}
+		testevalex {@lset@ x 1 2 1 4}
+	    } {test {1 2 {3 4}}}
+
+	    test lset-16.5-@mode@ {lset - grow a variable} testevalex {
+		set x {}
+		testevalex {@lset@ x end+1 {test 1}}
+		testevalex {@lset@ x end+1 {test 2}}
+		set x
+	    } {{test 1} {test 2}}
+	    test lset-16.6-@mode@ {lset - multiple created sublists} testevalex {
+		set x {}
+		testevalex {@lset@ x end+1 end+1 {test 1}}
+	    } {{{test 1}}}
+	    test lset-16.7-@mode@ {lset - sublists 3 deep} testevalex {
+		set x {}
+		testevalex {@lset@ x end+1 end+1 end+1 {test 1}}
+	    } {{{{test 1}}}}
+	    test lset-16.8-@mode@ {lset - append to inner list} testevalex {
+		set x {test 1}
+		testevalex {@lset@ x end end+1 2}
+		testevalex {@lset@ x end end+1 3}
+		testevalex {@lset@ x end end end+1 4}
+	    } {test {1 2 {3 4}}}
+
+	    catch {unset noRead}
+	    catch {unset noWrite}
+	    catch {rename failTrace {}}
+	    catch {unset ::x}
+	    catch {unset ::y}
+	}]
+	try $script
     }
-    set ident
-} {{1 0 0 0} {0 1 0 0} {0 0 1 0} {0 0 0 1}}
+}
 
-test lset-13.0 {lset, not compiled, shimmering hell} testevalex {
-    set a 0
-    list [testevalex {lset a $a $a $a $a {gag me}}] $a
-} {{{{{{gag me}}}}} {{{{{gag me}}}}}}
-test lset-13.1 {lset, not compiled, shimmering hell} testevalex {
-    set a [list 0]
-    list [testevalex {lset a $a $a $a $a {gag me}}] $a
-} {{{{{{gag me}}}}} {{{{{gag me}}}}}}
-test lset-13.2 {lset, not compiled, shimmering hell} testevalex {
-    set a [list 0 0 0 0]
-    list [testevalex {lset a $a {gag me}}] $a
-} {{{{{{gag me}}}} 0 0 0} {{{{{gag me}}}} 0 0 0}}
+try $tests
+if {[info exists ::argv0] && [info script] eq $::argv0} {
+    try $tests
 
-test lset-14.1 {lset, not compiled, list args, is string rep preserved?} testevalex {
-    set a { { 1 2 } { 3 4 } }
-    catch { testevalex {lset a {1 5} 5} }
-    list $a [lindex $a 1]
-} "{ { 1 2 } { 3 4 } } { 3 4 }"
-test lset-14.2 {lset, not compiled, flat args, is string rep preserved?} testevalex {
-    set a { { 1 2 } { 3 4 } }
-    catch { testevalex {lset a 1 5 5} }
-    list $a [lindex $a 1]
-} "{ { 1 2 } { 3 4 } } { 3 4 }"
+    ::tcltest::cleanupTests
+    return
+}
 
-testConstraint testobj [llength [info commands testobj]]
-test lset-15.1 {lset: shared internalrep [Bug 1677512]} -setup {
-    teststringobj set 1 {{1 2} 3}
-    testobj convert 1 list
-    testobj duplicate 1 2
-    variable x [teststringobj get 1]
-    variable y [teststringobj get 2]
-    testobj freeallvars
-    set l [list $y z]
-    unset y
-} -constraints testobj -body {
-    lset l 0 0 0 5
-    lindex $x 0 0
-} -cleanup {
-    unset -nocomplain x l
-} -result 1
-
-test lset-16.1 {lset - grow a variable} testevalex {
-    set x {}
-    testevalex {lset x 0 {test 1}}
-    testevalex {lset x 1 {test 2}}
-    set x
-} {{test 1} {test 2}}
-test lset-16.2 {lset - multiple created sublists} testevalex {
-    set x {}
-    testevalex {lset x 0 0 {test 1}}
-} {{{test 1}}}
-test lset-16.3 {lset - sublists 3 deep} testevalex {
-    set x {}
-    testevalex {lset x 0 0 0 {test 1}}
-} {{{{test 1}}}}
-test lset-16.4 {lset - append to inner list} testevalex {
-    set x {test 1}
-    testevalex {lset x 1 1 2}
-    testevalex {lset x 1 2 3}
-    testevalex {lset x 1 2 1 4}
-} {test {1 2 {3 4}}}
-
-test lset-16.5 {lset - grow a variable} testevalex {
-    set x {}
-    testevalex {lset x end+1 {test 1}}
-    testevalex {lset x end+1 {test 2}}
-    set x
-} {{test 1} {test 2}}
-test lset-16.6 {lset - multiple created sublists} testevalex {
-    set x {}
-    testevalex {lset x end+1 end+1 {test 1}}
-} {{{test 1}}}
-test lset-16.7 {lset - sublists 3 deep} testevalex {
-    set x {}
-    testevalex {lset x end+1 end+1 end+1 {test 1}}
-} {{{{test 1}}}}
-test lset-16.8 {lset - append to inner list} testevalex {
-    set x {test 1}
-    testevalex {lset x end end+1 2}
-    testevalex {lset x end end+1 3}
-    testevalex {lset x end end end+1 4}
-} {test {1 2 {3 4}}}
-
-catch {unset noRead}
-catch {unset noWrite}
-catch {rename failTrace {}}
-catch {unset ::x}
-catch {unset ::y}
 
 # cleanup
 ::tcltest::cleanupTests

tests/objInterface.test

@@ -0,0 +1,456 @@
+# Copyright © 2021 Nathan Coulter
+
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+if {"::tcltest" ni [namespace children]} {
+    package require tcltest 2.5
+    namespace import -force ::tcltest::*
+}
+
+::tcltest::loadTestedCommands
+testConstraint testindexhex [expr {[namespace which testindexhex] ne {}}]
+testConstraint testlistinteger [expr {[namespace which testlistinteger] ne {}}]
+
+apply [list {} {
+    variable list
+    variable res
+
+    foreach map {
+	{
+	    @mode@ compiled
+	    @lappend@ lappend
+	    @lindex@ lindex
+	    @linsert@ linsert
+	    @llength@ length
+	    @lrange@ lrange
+	    @lreplace@ lreplace
+	}
+	{
+	    @mode@ uncompiled
+	    @lappend@ {[lindex lappend]}
+	    @lindex@ {[lindex lindex]}
+	    @linsert@ {[lindex linsert]}
+	    @llength@ {[lindex llength]}
+	    @lrange@ {[lindex lrange]}
+	    @lreplace@ {[lindex lreplace]}
+	}
+    } {
+		set script [string map $map {
+			proc data1 iterations {
+				for {set i 0} {$i < $iterations} {incr i} {
+					@lappend@ expected [format %x $i]
+				}
+				return $expected
+			}
+
+
+			test {indexhex llength @mode@} {INST_LIST_INDEX_IMM} \
+			-constraints testindexhex \
+			-body {
+				set list [testindexhex]
+				llength $list
+			} -cleanup {
+				catch {unset list}
+			} -result -1 
+
+			test {indexhex lindex constant @mode@} {INST_LIST_INDEX_IMM} \
+			-constraints testindexhex \
+			-body {
+				set list [testindexhex]
+				@lindex@ $list 731
+			} -cleanup {
+				catch {unset list}
+			} -result 2db
+
+
+			test {indexhex lindex constant end @mode@} {INST_LIST_INDEX_IMM} \
+			-constraints testindexhex \
+			-body {
+				set list [testindexhex]
+				@lindex@ $list end
+			} -cleanup {
+				catch {unset list}
+				catch {unset res}
+			} -returnCodes 1 -result {list length indeterminate}
+
+
+
+			test {indexhex lindex dynamic @mode@} {INST_LIST_INDEX} \
+			-constraints testindexhex \
+			-body {
+				set list [testindexhex]
+				set val [expr {731 + 0}]
+				@lindex@ $list $val
+			} -cleanup {
+				catch {unset list}
+			} -result 2db
+
+
+			test {indexhex lindex dynamic end @mode@} {INST_LIST_INDEX} \
+			-constraints testindexhex \
+			-body {
+				set index {}
+				set list [testindexhex]
+				append index e n d
+				@lindex@ $list $index
+			} -cleanup {
+				catch {unset index}
+				catch {unset list}
+				catch {unset res}
+			} -returnCodes 1 -result {list length indeterminate}
+
+
+			test {indexhex lindex drill @mode@} {} \
+			-constraints testindexhex \
+			-body {
+				set list [testindexhex]
+				@lindex@ $list 731 0 0 0
+			} -cleanup {
+				catch {unset list}
+			} -result 2db
+
+
+			test {indexhex lrange constant @mode@} {} \
+			-constraints testindexhex \
+			-body {
+				set list [testindexhex]
+				@lrange@ $list 10 15
+			} -cleanup {
+				catch {unset list}
+			} -result {a b c d e f}
+
+
+			test {indexhex lrange dynamic @mode@} {} \
+			-constraints testindexhex \
+			-body {
+				set list [testindexhex]
+				set first [expr {10 + 0}]
+				set last [expr {15 + 0}]
+				@lrange@ $list $first $last
+			} -cleanup {
+				catch {unset list}
+			} -result {a b c d e f}
+
+
+			test {indexhex lrange end constant @mode@} {} \
+			-constraints testindexhex \
+			-body {
+				set list [testindexhex]
+				@lrange@ $list 10 end
+			} -cleanup {
+				catch {unset list}
+			} -returnCodes 1 -result {list length indeterminate}
+
+
+			test {indexhex lrange end dynamic @mode@} {} \
+			-constraints testindexhex \
+			-body {
+				set list [testindexhex]
+				set back [expr {-5 + 0}]
+				@lrange@ $list 10 end-$back
+			} -cleanup {
+				catch {unset list}
+			} -returnCodes 1 -result {list length indeterminate}
+
+
+			test {indexhex lrange end minus constant @mode@} {} \
+			-constraints testindexhex \
+			-body {
+				set list [testindexhex]
+				@lrange@ $list 10 end-1
+			} -cleanup {
+				catch {unset list}
+			} -returnCodes 1 -result {list length indeterminate}
+
+
+			test {indexhex lsearch @mode@} {} \
+			-constraints testindexhex \
+			-body {
+				set list [testindexhex]
+				lsearch $list ff
+			} -cleanup {
+				catch {unset list}
+			} -result 255
+
+
+			test {indexhex lsearch sorted @mode@} {} \
+			-constraints testindexhex \
+			-body {
+				set list [testindexhex]
+				lsearch -sorted $list ff
+			} -cleanup {
+				catch {unset list}
+			} -returnCodes 1 -result {sorted list is incoherent}
+
+
+			test {indexhex lsearch start @mode@} {} \
+			-constraints testindexhex \
+			-body {
+				set list [testindexhex]
+				lsearch -start 5171 -glob $list a*
+			} -cleanup {
+				catch {unset list}
+			} -result 40960
+
+
+			test {indexhex string index @mode@} {} \
+			-constraints testindexhex \
+			-body {
+				set iterations 4097
+				set expected [data1 $iterations]
+				set list [testindexhex]
+				set progres {}
+				set iterations [string length $expected]
+				for {set i 0} {$i < $iterations} {incr i} {
+				set eitem [string index $expected $i]
+				set item [string index $list $i]
+				if {$item ne $eitem} {
+					error [list {failed at index} $i [
+					format %x $i] expected $eitem got $item]
+				}
+				@lappend@ progress $item
+				}
+				return success
+			} -cleanup {
+				catch {unset i}
+				catch {unset list}
+			} -result success
+
+
+			test {indexhex string index end @mode@} {} \
+			-constraints testindexhex \
+			-body {
+				set list [testindexhex]
+				string index $list end
+				return success
+			} -cleanup {
+				catch {unset list}
+			} -returnCodes 1 -result {list length indeterminate}
+
+
+			test {indexhex string length @mode@} {} \
+			-constraints testindexhex \
+			-body {
+				set list [testindexhex]
+				string length $list
+			} -cleanup {
+				catch {unset list}
+			} -result -1
+
+
+			test {indexhex string range @mode@} {} \
+			-constraints testindexhex \
+			-body {
+				set res {}
+				set iterations 4097
+				set data1 [data1 $iterations]
+				set data1Length [string length $data1]
+				set list [testindexhex]
+				for {set first 0} {$first < $data1Length } {
+				set first [expr {($first + 1) * 2}]} {
+
+				for {set last $first} {$last < $data1Length} {
+					set last [expr {($last + 1) * 3}]} {
+
+					set expected [string range $data1 $first $last]
+					set range [string range $list $first $last]
+					if {$range ne $expected} {
+					set length [expr {
+						max([string length $expected], [string length $range])
+					}]
+					for {set i 0} {$i < $length} {incr i} {
+						set item1 [string index $range $i]
+						set item2 [string index $expected $i]
+						if {$item1 ne $item2} {
+						error [list {failed at} $first $last $i \
+							expected $item2 got $item1]
+						}
+					}
+					}
+				}
+				}
+				@lappend@ res success
+
+				# The largest string index currently allowed.
+				@lappend@ res [string range $list 2147483640 2147483647]
+
+				# This produces an error until index ranges are expanded in some later
+				# version of Tcl.
+				set status [catch {string range $list 2147483640 2147483648} cres copts]
+
+				@lappend@ res $status $cres
+				return $res
+			} -cleanup {
+				catch {unset list}
+			} -result {success {d73ac8f } 1 {}}
+
+
+			test {integer lappend @mode@} {} \
+			-constraints testlistinteger \
+			-body {
+				set list [testlistinteger {}]
+				@lappend@ list 8 9 10
+				@lappend@ list 11 12 13
+			} -cleanup {
+				catch {unset list}
+			} -result {8 9 10 11 12 13}
+
+
+			test {integer lappend empty @mode@} {} \
+			-constraints testlistinteger \
+			-body {
+				set list [testlistinteger {}]
+				@lappend@ list 8 9 10
+			} -cleanup {
+				catch {unset list}
+			} -result {8 9 10}
+
+
+			test {integer lappend noninteger @mode@} {} \
+			-constraints testlistinteger \
+			-body {
+				set list [testlistinteger {}]
+				@lappend@ list {8 9 10 11 12 13}
+			} -cleanup {
+				catch {unset list}
+			} -result {{8 9 10 11 12 13}}
+
+
+			test {integer lindex before before after @mode@} {
+			This test just tries to trigger a segmentation fault
+			} \
+			-constraints testlistinteger \
+			-body {
+				set list [testlistinteger {}]
+				@lappend@ list 8 9 10 11 12 13
+				@lindex@ $list -1 -1 7 
+			} -cleanup {
+				catch {unset list}
+			} -result {}
+
+
+			test {integer lindex middle @mode@} {} \
+			-constraints testlistinteger \
+			-body {
+				set list [testlistinteger {}]
+				@lappend@ list 8 9 10 11 12 13
+				@lindex@ $list 3 
+			} -cleanup {
+				catch {unset list}
+			} -result 11 
+
+
+			test {integer lindex end @mode@} {} \
+			-constraints testlistinteger \
+			-body {
+				set list [testlistinteger {}]
+				@lappend@ list 8 9 10 11 12 13
+				@lindex@ $list end 
+			} -cleanup {
+				catch {unset list}
+			} -result 13 
+
+
+			apply [list {} {
+				for {set i 0} {$i < 7} {incr i} {
+					set items {8 9 10 11 12 13}
+					set results {13 12 11 10 9 8}
+
+					set comment [list integer lindex end-$i @mode@]
+					set body [string map {@i@ $i @items@ $items} {
+						set list [testlistinteger {}]
+						@lappend@ list {*}$items
+						@lindex@ $list end-$i
+					}]
+					set result [lindex $results $i]
+
+					test $comment {} \
+					-constraints testlistinteger \
+					-body $body -cleanup {
+						catch {unset list}
+					} -result $result 
+				}
+				unset i
+			} [namespace current]]
+
+
+			test {integer linsert middle one @mode@} {} \
+			-constraints testlistinteger \
+			-body {
+				set list [testlistinteger {}]
+				set res {}
+				@lappend@ list 8 9 10 12 13
+				after 100
+				lappend res [@linsert@ $list 3 11]
+				set representation [::tcl::unsupported::representation $list]
+				regsub {(value is a testListInteger).*} $representation {\1} representation
+				lappend res $representation
+				return $res
+			} -cleanup {
+				catch {unset list}
+				catch {unset res}
+				catch {unset representation}
+			} -result  {{8 9 10 11 12 13} {value is a testListInteger}}
+
+
+			test {integer lrange middle @mode@} {} \
+			-constraints testlistinteger \
+			-body {
+				set list [testlistinteger {}]
+				@lappend@ list 8 9 10 11 12 13
+				@lrange@ $list 3 4
+			} -cleanup {
+				catch {unset list}
+			} -result {11 12}
+
+
+			test {integer lreplace prepend @mode@} {} \
+			-constraints testlistinteger \
+			-body {
+				set list [testlistinteger {}]
+				@lappend@ list 8 9 10 11 12 13
+				after 100
+				@lreplace@ $list -1 -1 7 
+			} -cleanup {
+				catch {unset list}
+			} -result {7 8 9 10 11 12 13}
+		}]
+		#try $script
+
+    }
+
+	set suites {linsert lset}  
+
+	foreach suite {linsert lset} {
+		set namespace [list $suite tests]
+		namespace eval $namespace [list source [
+			file join [file dirname [file dirname [
+				file normalize [file join [info script] ...]]]] $suite.test]]
+		namespace eval $namespace {
+			proc newlist list {
+				if {[string is list $list]} {
+					set integer 1
+					foreach item $list {
+						if {![string is integer $item]} {
+							set integer 0
+							break
+						}
+					}
+					if {$integer} {
+						testlistinteger $list
+					}
+				}
+				return $list
+			}
+			try $tests
+		}
+		namespace delete $namespace
+	}
+
+
+    # cleanup
+    ::tcltest::cleanupTests
+} [namespace current]]
+
+return

tests/tcltests.tcl

@@ -6,7 +6,6 @@ if {[package provide tcltests] ne {}} return
 package require tcltest 2.5
 namespace import ::tcltest::*
 testConstraint exec [llength [info commands exec]]
-testConstraint deprecated [expr {![tcl::build-info no-deprecate]}]
 testConstraint debug [tcl::build-info debug]
 testConstraint purify [tcl::build-info purify]
 testConstraint debugpurify [

tests/utf.test

@@ -95,11 +95,11 @@ test utf-1.15 {Tcl_UniCharToUtf: surrogate pairs from concat} {
 test utf-1.16 {Tcl_UniCharToUtf: \xC0 + \x80} testbytestring {
     set lo [testbytestring \x80]
     string length [testbytestring \xC0]$lo
-} 2
+} 1
 test utf-1.17 {Tcl_UniCharToUtf: \xC0 + \x80} testbytestring {
     set hi [testbytestring \xC0]
     string length $hi[testbytestring \x80]
-} 2
+} 1
 test utf-1.18 {Tcl_UniCharToUtf: surrogate pairs from concat} {
     string cat \uD83D \uDE02
 } \uD83D\uDE02

tools/uniParse.tcl

@@ -212,7 +212,6 @@ static const unsigned short pageMap\[\] = {"
 	    puts $f $line
 	    set lastpage [expr {[lindex $line end] >> $shift}]
 	    puts stdout "lastpage: $lastpage"
-	    puts $f "#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6"
 	    set line "    ,"
 	}
 	append line [lindex $pMap $i]
@@ -225,7 +224,6 @@ static const unsigned short pageMap\[\] = {"
 	}
     }
     puts $f $line
-    puts $f "#endif /* TCL_UTF_MAX > 3 */"
     puts $f "};
 
 /*
@@ -242,7 +240,6 @@ static const unsigned char groupMap\[\] = {"
 	set lastj [expr {[llength $page] - 1}]
 	if {$i == ($lastpage + 1)} {
 	    puts $f [string trimright $line " \t,"]
-	    puts $f "#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6"
 	    set line "    ,"
 	}
 	for {set j 0} {$j <= $lastj} {incr j} {
@@ -257,7 +254,6 @@ static const unsigned char groupMap\[\] = {"
 	}
     }
     puts $f $line
-    puts $f "#endif /* TCL_UTF_MAX > 3 */"
     puts $f "};
 
 /*
@@ -342,11 +338,7 @@ static const int groups\[\] = {"
     puts $f $line
     puts -nonewline $f "};
 
-#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6
-#   define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1FFFFF) >= [format 0x%X $next])
-#else
-#   define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1F0000) != 0)
-#endif
+#define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1FFFFF) >= [format 0x%X $next])
 
 /*
  * The following constants are used to determine the category of a
@@ -401,11 +393,7 @@ enum {
  * Unicode character tables.
  */
 
-#if TCL_UTF_MAX > 3 || TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6
-#   define GetUniCharInfo(ch) (groups\[groupMap\[pageMap\[((ch) & 0x1FFFFF) >> OFFSET_BITS\] | ((ch) & ((1 << OFFSET_BITS)-1))\]\])
-#else
-#   define GetUniCharInfo(ch) (groups\[groupMap\[pageMap\[((ch) & 0xFFFF) >> OFFSET_BITS\] | ((ch) & ((1 << OFFSET_BITS)-1))\]\])
-#endif
+#define GetUniCharInfo(ch) (groups\[groupMap\[pageMap\[((ch) & 0x1FFFFF) >> OFFSET_BITS\] | ((ch) & ((1 << OFFSET_BITS)-1))\]\])
 "
 
     close $f

unix/Makefile.in

@@ -136,11 +136,6 @@ STUB_LIB_FILE		= ${TCL_STUB_LIB_FILE}
 TCL_STUB_LIB_FLAG	= @TCL_STUB_LIB_FLAG@
 #TCL_STUB_LIB_FLAG	= -ltclstub
 
-# To compile without backward compatibility and deprecated code uncomment the
-# following
-NO_DEPRECATED_FLAGS	=
-#NO_DEPRECATED_FLAGS	= -DTCL_NO_DEPRECATED
-
 # Some versions of make, like SGI's, use the following variable to determine
 # which shell to use for executing commands:
 SHELL			= @MAKEFILE_SHELL@
@@ -292,11 +287,14 @@ DEPEND_SWITCHES	= ${CFLAGS} -I${UNIX_DIR} -I${GENERIC_DIR} \
 
 TCLSH_OBJS = tclAppInit.o
 
-TCLTEST_OBJS = tclTestInit.o tclTest.o tclTestObj.o tclTestProcBodyObj.o \
-	tclThreadTest.o tclUnixTest.o
+TCLTEST_OBJS = tclTestInit.o tclTest.o tclTestObj.o tclTestObjInterface.o \
+	tclTestObjInterfaceInteger.o \
+	tclTestProcBodyObj.o tclThreadTest.o tclUnixTest.o
 
-XTTEST_OBJS = xtTestInit.o tclTest.o tclTestObj.o tclTestProcBodyObj.o \
-	tclThreadTest.o tclUnixTest.o tclXtNotify.o tclXtTest.o
+XTTEST_OBJS = xtTestInit.o tclTest.o tclTestObj.o tclTestObjInterface.o \
+	tclTestObjInterfaceInteger.o \
+	tclTestProcBodyObj.o tclThreadTest.o tclUnixTest.o tclXtNotify.o \
+	tclXtTest.o
 
 GENERIC_OBJS = regcomp.o regexec.o regfree.o regerror.o tclAlloc.o \
 	tclArithSeries.o tclAssembly.o tclAsync.o tclBasic.o tclBinary.o \
@@ -469,6 +467,8 @@ GENERIC_SRCS = \
 	$(GENERIC_DIR)/tclStrToD.c \
 	$(GENERIC_DIR)/tclTest.c \
 	$(GENERIC_DIR)/tclTestObj.c \
+	$(GENERIC_DIR)/tclTestObjInterface.c \
+	$(GENERIC_DIR)/tclTestObjInterfaceInteger \
 	$(GENERIC_DIR)/tclTestProcBodyObj.c \
 	$(GENERIC_DIR)/tclThread.c \
 	$(GENERIC_DIR)/tclThreadAlloc.c \
@@ -1562,6 +1562,13 @@ tclTest.o: $(GENERIC_DIR)/tclTest.c $(IOHDR) $(TCLREHDRS) tclUuid.h
 tclTestObj.o: $(GENERIC_DIR)/tclTestObj.c $(MATHHDRS)
 	$(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclTestObj.c
 
+tclTestObjInterface.o: $(GENERIC_DIR)/tclTestObjInterface.c $(MATHHDRS)
+	$(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclTestObjInterface.c
+
+tclTestObjInterfaceInteger.o: $(GENERIC_DIR)/tclTestObjInterfaceInteger.c \
+	$(MATHHDRS)
+	$(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclTestObjInterfaceInteger.c
+
 tclTestProcBodyObj.o: $(GENERIC_DIR)/tclTestProcBodyObj.c
 	$(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclTestProcBodyObj.c
 

unix/config.status.lineno

@@ -1,920 +0,0 @@
-#! /bin/bash
-# Generated by configure.
-# Run this file to recreate the current configuration.
-# Compiler output produced by configure, useful for debugging
-# configure, is in config.log if it exists.
-
-debug=false
-ac_cs_recheck=false
-ac_cs_silent=false
-SHELL=${CONFIG_SHELL-/bin/bash}
-## --------------------- ##
-## M4sh Initialization.  ##
-## --------------------- ##
-
-# Be Bourne compatible
-if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then
-  emulate sh
-  NULLCMD=:
-  # Zsh 3.x and 4.x performs word splitting on ${1+"$@"}, which
-  # is contrary to our usage.  Disable this feature.
-  alias -g '${1+"$@"}'='"$@"'
-elif test -n "${BASH_VERSION+set}" && (set -o posix) >/dev/null 2>&1; then
-  set -o posix
-fi
-DUALCASE=1; export DUALCASE # for MKS sh
-
-# Support unset when possible.
-if ( (MAIL=60; unset MAIL) || exit) >/dev/null 2>&1; then
-  as_unset=unset
-else
-  as_unset=false
-fi
-
-
-# Work around bugs in pre-3.0 UWIN ksh.
-$as_unset ENV MAIL MAILPATH
-PS1='$ '
-PS2='> '
-PS4='+ '
-
-# NLS nuisances.
-for as_var in \
-  LANG LANGUAGE LC_ADDRESS LC_ALL LC_COLLATE LC_CTYPE LC_IDENTIFICATION \
-  LC_MEASUREMENT LC_MESSAGES LC_MONETARY LC_NAME LC_NUMERIC LC_PAPER \
-  LC_TELEPHONE LC_TIME
-do
-  if (set +x; test -z "`(eval $as_var=C; export $as_var) 2>&1`"); then
-    eval $as_var=C; export $as_var
-  else
-    $as_unset $as_var
-  fi
-done
-
-# Required to use basename.
-if expr a : '\(a\)' >/dev/null 2>&1; then
-  as_expr=expr
-else
-  as_expr=false
-fi
-
-if (basename /) >/dev/null 2>&1 && test "X`basename / 2>&1`" = "X/"; then
-  as_basename=basename
-else
-  as_basename=false
-fi
-
-
-# Name of the executable.
-as_me=`$as_basename "$0" ||
-$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \
-	 X"$0" : 'X\(//\)$' \| \
-	 X"$0" : 'X\(/\)$' \| \
-	 .     : '\(.\)' 2>/dev/null ||
-echo X/"$0" |
-    sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/; q; }
-  	  /^X\/\(\/\/\)$/{ s//\1/; q; }
-  	  /^X\/\(\/\).*/{ s//\1/; q; }
-  	  s/.*/./; q'`
-
-
-# PATH needs CR, and LINENO needs CR and PATH.
-# Avoid depending upon Character Ranges.
-as_cr_letters='abcdefghijklmnopqrstuvwxyz'
-as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
-as_cr_Letters=$as_cr_letters$as_cr_LETTERS
-as_cr_digits='0123456789'
-as_cr_alnum=$as_cr_Letters$as_cr_digits
-
-# The user is always right.
-if test "${PATH_SEPARATOR+set}" != set; then
-  echo "#! /bin/sh" >conf$$.sh
-  echo  "exit 0"   >>conf$$.sh
-  chmod +x conf$$.sh
-  if (PATH="/nonexistent;."; conf$$.sh) >/dev/null 2>&1; then
-    PATH_SEPARATOR=';'
-  else
-    PATH_SEPARATOR=:
-  fi
-  rm -f conf$$.sh
-fi
-
-
-  as_lineno_1=103
-  as_lineno_2=104
-  as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
-  test "x$as_lineno_1" != "x$as_lineno_2" &&
-  test "x$as_lineno_3"  = "x$as_lineno_2"  || {
-  # Find who we are.  Look in the path if we contain no path at all
-  # relative or not.
-  case $0 in
-    *[\\/]* ) as_myself=$0 ;;
-    *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in $PATH
-do
-  IFS=$as_save_IFS
-  test -z "$as_dir" && as_dir=.
-  test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break
-done
-
-       ;;
-  esac
-  # We did not find ourselves, most probably we were run as `sh COMMAND'
-  # in which case we are not to be found in the path.
-  if test "x$as_myself" = x; then
-    as_myself=$0
-  fi
-  if test ! -f "$as_myself"; then
-    { { echo "$as_me:128: error: cannot find myself; rerun with an absolute path" >&5
-echo "$as_me: error: cannot find myself; rerun with an absolute path" >&2;}
-   { (exit 1); exit 1; }; }
-  fi
-  case $CONFIG_SHELL in
-  '')
-    as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
-for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH
-do
-  IFS=$as_save_IFS
-  test -z "$as_dir" && as_dir=.
-  for as_base in sh bash ksh sh5; do
-	 case $as_dir in
-	 /*)
-	   if ("$as_dir/$as_base" -c '
-  as_lineno_1=143
-  as_lineno_2=144
-  as_lineno_3=`(expr $as_lineno_1 + 1) 2>/dev/null`
-  test "x$as_lineno_1" != "x$as_lineno_2" &&
-  test "x$as_lineno_3"  = "x$as_lineno_2" ') 2>/dev/null; then
-	     $as_unset BASH_ENV || test "${BASH_ENV+set}" != set || { BASH_ENV=; export BASH_ENV; }
-	     $as_unset ENV || test "${ENV+set}" != set || { ENV=; export ENV; }
-	     CONFIG_SHELL=$as_dir/$as_base
-	     export CONFIG_SHELL
-	     exec "$CONFIG_SHELL" "$0" ${1+"$@"}
-	   fi;;
-	 esac
-       done
-done
-;;
-  esac
-
-  # Create $as_me.lineno as a copy of $as_myself, but with 160
-  # uniformly replaced by the line number.  The first 'sed' inserts a
-  # line-number line before each line; the second 'sed' does the real
-  # work.  The second script uses 'N' to pair each line-number line
-  # with the numbered line, and appends trailing '-' during
-  # substitution so that 165 is not a special case at line end.
-  # (Raja R Harinath suggested sed '=', and Paul Eggert wrote the
-  # second 'sed' script.  Blame Lee E. McMahon for sed's syntax.  :-)
-  sed '=' <$as_myself |
-    sed '
-      N
-      s,$,-,
-      : loop
-      s,^\(['$as_cr_digits']*\)\(.*\)[$]LINENO\([^'$as_cr_alnum'_]\),\1\2\1\3,
-      t loop
-      s,-$,,
-      s,^['$as_cr_digits']*\n,,
-    ' >$as_me.lineno &&
-  chmod +x $as_me.lineno ||
-    { { echo "$as_me:179: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&5
-echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2;}
-   { (exit 1); exit 1; }; }
-
-  # Don't try to exec as it changes $[0], causing all sort of problems
-  # (the dirname of $[0] is not the place where we might find the
-  # original and so on.  Autoconf is especially sensible to this).
-  . ./$as_me.lineno
-  # Exit status is that of the last command.
-  exit
-}
-
-
-case `echo "testing\c"; echo 1,2,3`,`echo -n testing; echo 1,2,3` in
-  *c*,-n*) ECHO_N= ECHO_C='
-' ECHO_T='	' ;;
-  *c*,*  ) ECHO_N=-n ECHO_C= ECHO_T= ;;
-  *)       ECHO_N= ECHO_C='\c' ECHO_T= ;;
-esac
-
-if expr a : '\(a\)' >/dev/null 2>&1; then
-  as_expr=expr
-else
-  as_expr=false
-fi
-
-rm -f conf$$ conf$$.exe conf$$.file
-echo >conf$$.file
-if ln -s conf$$.file conf$$ 2>/dev/null; then
-  # We could just check for DJGPP; but this test a) works b) is more generic
-  # and c) will remain valid once DJGPP supports symlinks (DJGPP 2.04).
-  if test -f conf$$.exe; then
-    # Don't use ln at all; we don't have any links
-    as_ln_s='cp -p'
-  else
-    as_ln_s='ln -s'
-  fi
-elif ln conf$$.file conf$$ 2>/dev/null; then
-  as_ln_s=ln
-else
-  as_ln_s='cp -p'
-fi
-rm -f conf$$ conf$$.exe conf$$.file
-
-if mkdir -p . 2>/dev/null; then
-  as_mkdir_p=:
-else
-  test -d ./-p && rmdir ./-p
-  as_mkdir_p=false
-fi
-
-as_executable_p="test -f"
-
-# Sed expression to map a string onto a valid CPP name.
-as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
-
-# Sed expression to map a string onto a valid variable name.
-as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"
-
-
-# IFS
-# We need space, tab and new line, in precisely that order.
-as_nl='
-'
-IFS=" 	$as_nl"
-
-# CDPATH.
-$as_unset CDPATH
-
-exec 6>&1
-
-# Open the log real soon, to keep \$[0] and so on meaningful, and to
-# report actual input values of CONFIG_FILES etc. instead of their
-# values after options handling.  Logging --version etc. is OK.
-exec 5>>config.log
-{
-  echo
-  sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX
-## Running $as_me. ##
-_ASBOX
-} >&5
-cat >&5 <<_CSEOF
-
-This file was extended by tcl $as_me 8.6, which was
-generated by GNU Autoconf 2.59.  Invocation command line was
-
-  CONFIG_FILES    = $CONFIG_FILES
-  CONFIG_HEADERS  = $CONFIG_HEADERS
-  CONFIG_LINKS    = $CONFIG_LINKS
-  CONFIG_COMMANDS = $CONFIG_COMMANDS
-  $ $0 $@
-
-_CSEOF
-echo "on `(hostname || uname -n) 2>/dev/null | sed 1q`" >&5
-echo >&5
-config_files=" Makefile:../unix/Makefile.in dltest/Makefile:../unix/dltest/Makefile.in tclConfig.sh:../unix/tclConfig.sh.in tcl.pc:../unix/tcl.pc.in"
-
-ac_cs_usage="\
-\`$as_me' instantiates files from templates according to the
-current configuration.
-
-Usage: $0 [OPTIONS] [FILE]...
-
-  -h, --help       print this help, then exit
-  -V, --version    print version number, then exit
-  -q, --quiet      do not print progress messages
-  -d, --debug      don't remove temporary files
-      --recheck    update $as_me by reconfiguring in the same conditions
-  --file=FILE[:TEMPLATE]
-		   instantiate the configuration file FILE
-
-Configuration files:
-$config_files
-
-Configuration commands:
-$config_commands
-
-Report bugs to <bug-autoconf@gnu.org>."
-ac_cs_version="\
-tcl config.status 8.6
-configured by ./configure, generated by GNU Autoconf 2.59,
-  with options \"'--prefix=/home/jima/space/ins/lin64/dynamic/main'\"
-
-Copyright (C) 2003 Free Software Foundation, Inc.
-This config.status script is free software; the Free Software Foundation
-gives unlimited permission to copy, distribute and modify it."
-srcdir=/home/jima/space/bui/lin64/dynamic/main/tcl/unix
-# If no file are specified by the user, then we need to provide default
-# value.  By we need to know if files were specified by the user.
-ac_need_defaults=:
-while test $# != 0
-do
-  case $1 in
-  --*=*)
-    ac_option=`expr "x$1" : 'x\([^=]*\)='`
-    ac_optarg=`expr "x$1" : 'x[^=]*=\(.*\)'`
-    ac_shift=:
-    ;;
-  -*)
-    ac_option=$1
-    ac_optarg=$2
-    ac_shift=shift
-    ;;
-  *) # This is not an option, so the user has probably given explicit
-     # arguments.
-     ac_option=$1
-     ac_need_defaults=false;;
-  esac
-
-  case $ac_option in
-  # Handling of the options.
-  -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
-    ac_cs_recheck=: ;;
-  --version | --vers* | -V )
-    echo "$ac_cs_version"; exit 0 ;;
-  --he | --h)
-    # Conflict between --help and --header
-    { { echo "$as_me:336: error: ambiguous option: $1
-Try \`$0 --help' for more information." >&5
-echo "$as_me: error: ambiguous option: $1
-Try \`$0 --help' for more information." >&2;}
-   { (exit 1); exit 1; }; };;
-  --help | --hel | -h )
-    echo "$ac_cs_usage"; exit 0 ;;
-  --debug | --d* | -d )
-    debug=: ;;
-  --file | --fil | --fi | --f )
-    $ac_shift
-    CONFIG_FILES="$CONFIG_FILES $ac_optarg"
-    ac_need_defaults=false;;
-  --header | --heade | --head | --hea )
-    $ac_shift
-    CONFIG_HEADERS="$CONFIG_HEADERS $ac_optarg"
-    ac_need_defaults=false;;
-  -q | -quiet | --quiet | --quie | --qui | --qu | --q \
-  | -silent | --silent | --silen | --sile | --sil | --si | --s)
-    ac_cs_silent=: ;;
-
-  # This is an error.
-  -*) { { echo "$as_me:358: error: unrecognized option: $1
-Try \`$0 --help' for more information." >&5
-echo "$as_me: error: unrecognized option: $1
-Try \`$0 --help' for more information." >&2;}
-   { (exit 1); exit 1; }; } ;;
-
-  *) ac_config_targets="$ac_config_targets $1" ;;
-
-  esac
-  shift
-done
-
-ac_configure_extra_args=
-
-if $ac_cs_silent; then
-  exec 6>/dev/null
-  ac_configure_extra_args="$ac_configure_extra_args --silent"
-fi
-
-if $ac_cs_recheck; then
-  echo "running /bin/bash ./configure " '--prefix=/home/jima/space/ins/lin64/dynamic/main' $ac_configure_extra_args " --no-create --no-recursion" >&6
-  exec /bin/bash ./configure '--prefix=/home/jima/space/ins/lin64/dynamic/main' $ac_configure_extra_args --no-create --no-recursion
-fi
-
-#
-# INIT-COMMANDS section.
-#
-
-VERSION=8.6
-
-for ac_config_target in $ac_config_targets
-do
-  case "$ac_config_target" in
-  # Handling of arguments.
-  "Tcl-Info.plist" ) CONFIG_FILES="$CONFIG_FILES Tcl-Info.plist:../macosx/Tcl-Info.plist.in" ;;
-  "Tclsh-Info.plist" ) CONFIG_FILES="$CONFIG_FILES Tclsh-Info.plist:../macosx/Tclsh-Info.plist.in" ;;
-  "Makefile" ) CONFIG_FILES="$CONFIG_FILES Makefile:../unix/Makefile.in" ;;
-  "dltest/Makefile" ) CONFIG_FILES="$CONFIG_FILES dltest/Makefile:../unix/dltest/Makefile.in" ;;
-  "tclConfig.sh" ) CONFIG_FILES="$CONFIG_FILES tclConfig.sh:../unix/tclConfig.sh.in" ;;
-  "tcl.pc" ) CONFIG_FILES="$CONFIG_FILES tcl.pc:../unix/tcl.pc.in" ;;
-  "Tcl.framework" ) CONFIG_COMMANDS="$CONFIG_COMMANDS Tcl.framework" ;;
-  *) { { echo "$as_me:399: error: invalid argument: $ac_config_target" >&5
-echo "$as_me: error: invalid argument: $ac_config_target" >&2;}
-   { (exit 1); exit 1; }; };;
-  esac
-done
-
-# If the user did not use the arguments to specify the items to instantiate,
-# then the envvar interface is used.  Set only those that are not.
-# We use the long form for the default assignment because of an extremely
-# bizarre bug on SunOS 4.1.3.
-if $ac_need_defaults; then
-  test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files
-  test "${CONFIG_COMMANDS+set}" = set || CONFIG_COMMANDS=$config_commands
-fi
-
-# Have a temporary directory for convenience.  Make it in the build tree
-# simply because there is no reason to put it here, and in addition,
-# creating and moving files from /tmp can sometimes cause problems.
-# Create a temporary directory, and hook for its removal unless debugging.
-$debug ||
-{
-  trap 'exit_status=$?; rm -rf $tmp && exit $exit_status' 0
-  trap '{ (exit 1); exit 1; }' 1 2 13 15
-}
-
-# Create a (secure) tmp directory for tmp files.
-
-{
-  tmp=`(umask 077 && mktemp -d -q "./confstatXXXXXX") 2>/dev/null` &&
-  test -n "$tmp" && test -d "$tmp"
-}  ||
-{
-  tmp=./confstat$$-$RANDOM
-  (umask 077 && mkdir $tmp)
-} ||
-{
-   echo "$me: cannot create a temporary directory in ." >&2
-   { (exit 1); exit 1; }
-}
-
-
-#
-# CONFIG_FILES section.
-#
-
-# No need to generate the scripts if there are no CONFIG_FILES.
-# This happens for instance when ./config.status config.h
-if test -n "$CONFIG_FILES"; then
-  # Protect against being on the right side of a sed subst in config.status.
-  sed 's/,@/@@/; s/@,/@@/; s/,;t t$/@;t t/; /@;t t$/s/[\\&,]/\\&/g;
-   s/@@/,@/; s/@@/@,/; s/@;t t$/,;t t/' >$tmp/subs.sed <<\CEOF
-s,@SHELL@,/bin/bash,;t t
-s,@PATH_SEPARATOR@,:,;t t
-s,@PACKAGE_NAME@,tcl,;t t
-s,@PACKAGE_TARNAME@,tcl,;t t
-s,@PACKAGE_VERSION@,8.6,;t t
-s,@PACKAGE_STRING@,tcl 8.6,;t t
-s,@PACKAGE_BUGREPORT@,,;t t
-s,@exec_prefix@,/home/jima/space/ins/lin64/dynamic/main,;t t
-s,@prefix@,/home/jima/space/ins/lin64/dynamic/main,;t t
-s,@program_transform_name@,s,x,x,,;t t
-s,@bindir@,${exec_prefix}/bin,;t t
-s,@sbindir@,${exec_prefix}/sbin,;t t
-s,@libexecdir@,${exec_prefix}/libexec,;t t
-s,@datadir@,${prefix}/share,;t t
-s,@sysconfdir@,${prefix}/etc,;t t
-s,@sharedstatedir@,${prefix}/com,;t t
-s,@localstatedir@,${prefix}/var,;t t
-s,@libdir@,/home/jima/space/ins/lin64/dynamic/main/lib,;t t
-s,@includedir@,${prefix}/include,;t t
-s,@oldincludedir@,/usr/include,;t t
-s,@infodir@,${prefix}/info,;t t
-s,@mandir@,${prefix}/man,;t t
-s,@build_alias@,,;t t
-s,@host_alias@,,;t t
-s,@target_alias@,,;t t
-s,@DEFS@,-DPACKAGE_NAME=\"tcl\" -DPACKAGE_TARNAME=\"tcl\" -DPACKAGE_VERSION=\"8.6\" -DPACKAGE_STRING=\"tcl\ 8.6\" -DPACKAGE_BUGREPORT=\"\" -DSTDC_HEADERS=1 -DHAVE_SYS_TYPES_H=1 -DHAVE_SYS_STAT_H=1 -DHAVE_STDLIB_H=1 -DHAVE_STRING_H=1 -DHAVE_MEMORY_H=1 -DHAVE_STRINGS_H=1 -DHAVE_INTTYPES_H=1 -DHAVE_STDINT_H=1 -DHAVE_UNISTD_H=1 -DHAVE_SYS_PARAM_H=1 -DUSE_THREAD_ALLOC=1 -D_REENTRANT=1 -D_THREAD_SAFE=1 -DHAVE_PTHREAD_ATTR_SETSTACKSIZE=1 -DHAVE_PTHREAD_ATFORK=1 -DTCL_THREADS=1 -DTCL_CFGVAL_ENCODING=\"iso8859-1\" -DHAVE_ZLIB=1 -DMODULE_SCOPE=extern\ __attribute__\(\(__visibility__\(\"hidden\"\)\)\) -DHAVE_HIDDEN=1 -DHAVE_CAST_TO_UNION=1 -DTCL_SHLIB_EXT=\".so\" -DNDEBUG=1 -DTCL_CFG_OPTIMIZED=1 -DTCL_TOMMATH=1 -DMP_PREC=4 -D_LARGEFILE64_SOURCE=1 -DTCL_WIDE_INT_IS_LONG=1 -DHAVE_GETCWD=1 -DHAVE_MKSTEMP=1 -DHAVE_OPENDIR=1 -DHAVE_STRTOL=1 -DHAVE_WAITPID=1 -DHAVE_GETNAMEINFO=1 -DHAVE_GETADDRINFO=1 -DHAVE_FREEADDRINFO=1 -DHAVE_GAI_STRERROR=1 -DHAVE_STRUCT_ADDRINFO=1 -DHAVE_STRUCT_IN6_ADDR=1 -DHAVE_STRUCT_SOCKADDR_IN6=1 -DHAVE_STRUCT_SOCKADDR_STORAGE=1 -DHAVE_GETPWUID_R_5=1 -DHAVE_GETPWUID_R=1 -DHAVE_GETPWNAM_R_5=1 -DHAVE_GETPWNAM_R=1 -DHAVE_GETGRGID_R_5=1 -DHAVE_GETGRGID_R=1 -DHAVE_GETGRNAM_R_5=1 -DHAVE_GETGRNAM_R=1 -DHAVE_DECL_GETHOSTBYNAME_R=1 -DHAVE_GETHOSTBYNAME_R_6=1 -DHAVE_GETHOSTBYNAME_R=1 -DHAVE_DECL_GETHOSTBYADDR_R=1 -DHAVE_GETHOSTBYADDR_R_8=1 -DHAVE_GETHOSTBYADDR_R=1 -DHAVE_TERMIOS_H=1 -DHAVE_SYS_IOCTL_H=1 -DHAVE_SYS_TIME_H=1 -DTIME_WITH_SYS_TIME=1 -DHAVE_GMTIME_R=1 -DHAVE_LOCALTIME_R=1 -DHAVE_MKTIME=1 -DHAVE_TM_GMTOFF=1 -DHAVE_TIMEZONE_VAR=1 -DHAVE_STRUCT_STAT_ST_BLOCKS=1 -DHAVE_STRUCT_STAT_ST_BLKSIZE=1 -DHAVE_BLKCNT_T=1 -DHAVE_INTPTR_T=1 -DHAVE_UINTPTR_T=1 -DNO_UNION_WAIT=1 -DHAVE_SIGNED_CHAR=1 -DHAVE_LANGINFO=1 -DHAVE_MKSTEMPS=1 -DHAVE_FTS=1 -DHAVE_SYS_IOCTL_H=1 -DTCL_UNLOAD_DLLS=1 -DHAVE_CPUID=1 ,;t t
-s,@ECHO_C@,,;t t
-s,@ECHO_N@,-n,;t t
-s,@ECHO_T@,,;t t
-s,@LIBS@,-lz  -lpthread,;t t
-s,@MAN_FLAGS@,,;t t
-s,@CC@,gcc,;t t
-s,@CFLAGS@, -pipe ,;t t
-s,@LDFLAGS@, -Wl,--export-dynamic ,;t t
-s,@CPPFLAGS@,,;t t
-s,@ac_ct_CC@,gcc,;t t
-s,@EXEEXT@,,;t t
-s,@OBJEXT@,o,;t t
-s,@CPP@,gcc -E,;t t
-s,@EGREP@,grep -E,;t t
-s,@TCL_THREADS@,1,;t t
-s,@TCLSH_PROG@,/usr/bin/tclsh8.6,;t t
-s,@ZLIB_OBJS@,,;t t
-s,@ZLIB_SRCS@,,;t t
-s,@ZLIB_INCLUDE@,,;t t
-s,@RANLIB@,ranlib,;t t
-s,@ac_ct_RANLIB@,ranlib,;t t
-s,@AR@,ar,;t t
-s,@ac_ct_AR@,ar,;t t
-s,@LIBOBJS@,,;t t
-s,@TCL_LIBS@,-ldl -lz  -lpthread -lm,;t t
-s,@DL_LIBS@,-ldl,;t t
-s,@DL_OBJS@,tclLoadDl.o,;t t
-s,@PLAT_OBJS@,,;t t
-s,@PLAT_SRCS@,,;t t
-s,@LDAIX_SRC@,,;t t
-s,@CFLAGS_DEBUG@,-g,;t t
-s,@CFLAGS_OPTIMIZE@,-O2,;t t
-s,@CFLAGS_WARNING@,-Wall,;t t
-s,@LDFLAGS_DEBUG@,,;t t
-s,@LDFLAGS_OPTIMIZE@,,;t t
-s,@CC_SEARCH_FLAGS@,-Wl,-rpath,${LIB_RUNTIME_DIR},;t t
-s,@LD_SEARCH_FLAGS@,-Wl,-rpath,${LIB_RUNTIME_DIR},;t t
-s,@STLIB_LD@,${AR} cr,;t t
-s,@SHLIB_LD@,${CC} ${CFLAGS} ${LDFLAGS} -shared,;t t
-s,@TCL_SHLIB_LD_EXTRAS@,,;t t
-s,@TK_SHLIB_LD_EXTRAS@,,;t t
-s,@SHLIB_LD_LIBS@,${LIBS},;t t
-s,@SHLIB_CFLAGS@,-fPIC,;t t
-s,@SHLIB_SUFFIX@,.so,;t t
-s,@MAKE_LIB@,${SHLIB_LD} -o $@ ${OBJS} ${SHLIB_LD_LIBS} ${TCL_SHLIB_LD_EXTRAS} ${TK_SHLIB_LD_EXTRAS} ${LD_SEARCH_FLAGS},;t t
-s,@MAKE_STUB_LIB@,${STLIB_LD} $@ ${STUB_LIB_OBJS} ; ${RANLIB} $@,;t t
-s,@INSTALL_LIB@,$(INSTALL_LIBRARY) $(LIB_FILE) "$(LIB_INSTALL_DIR)/$(LIB_FILE)",;t t
-s,@DLL_INSTALL_DIR@,$(LIB_INSTALL_DIR),;t t
-s,@INSTALL_STUB_LIB@,$(INSTALL_LIBRARY) $(STUB_LIB_FILE) "$(LIB_INSTALL_DIR)/$(STUB_LIB_FILE)",;t t
-s,@CFLAGS_DEFAULT@,$(CFLAGS_OPTIMIZE),;t t
-s,@LDFLAGS_DEFAULT@,$(LDFLAGS_OPTIMIZE),;t t
-s,@DTRACE@,,;t t
-s,@TCL_VERSION@,8.6,;t t
-s,@TCL_MAJOR_VERSION@,8,;t t
-s,@TCL_MINOR_VERSION@,6,;t t
-s,@TCL_PATCH_LEVEL@,.10,;t t
-s,@TCL_YEAR@,,;t t
-s,@PKG_CFG_ARGS@,'--prefix=/home/jima/space/ins/lin64/dynamic/main' ,;t t
-s,@TCL_LIB_FILE@,libtcl8.6.so,;t t
-s,@TCL_LIB_FLAG@,-ltcl8.6,;t t
-s,@TCL_LIB_SPEC@,-L/home/jima/space/ins/lin64/dynamic/main/lib -ltcl8.6,;t t
-s,@TCL_STUB_LIB_FILE@,libtclstub8.6.a,;t t
-s,@TCL_STUB_LIB_FLAG@,-ltclstub8.6,;t t
-s,@TCL_STUB_LIB_SPEC@,-L/home/jima/space/ins/lin64/dynamic/main/lib -ltclstub8.6,;t t
-s,@TCL_STUB_LIB_PATH@,/home/jima/space/ins/lin64/dynamic/main/lib/libtclstub8.6.a,;t t
-s,@TCL_INCLUDE_SPEC@,-I/home/jima/space/ins/lin64/dynamic/main/include,;t t
-s,@TCL_BUILD_STUB_LIB_SPEC@,-L/home/jima/space/bui/lin64/dynamic/main/tcl/unix -ltclstub8.6,;t t
-s,@TCL_BUILD_STUB_LIB_PATH@,/home/jima/space/bui/lin64/dynamic/main/tcl/unix/libtclstub8.6.a,;t t
-s,@TCL_SRC_DIR@,/home/jima/space/bui/lin64/dynamic/main/tcl,;t t
-s,@CFG_TCL_SHARED_LIB_SUFFIX@,${VERSION}.so,;t t
-s,@CFG_TCL_UNSHARED_LIB_SUFFIX@,${VERSION}.a,;t t
-s,@TCL_SHARED_BUILD@,1,;t t
-s,@LD_LIBRARY_PATH_VAR@,LD_LIBRARY_PATH,;t t
-s,@TCL_BUILD_LIB_SPEC@,-L/home/jima/space/bui/lin64/dynamic/main/tcl/unix -ltcl8.6,;t t
-s,@TCL_LIB_VERSIONS_OK@,ok,;t t
-s,@TCL_SHARED_LIB_SUFFIX@,${VERSION}${SHLIB_SUFFIX},;t t
-s,@TCL_UNSHARED_LIB_SUFFIX@,${VERSION}.a,;t t
-s,@TCL_HAS_LONGLONG@,,;t t
-s,@INSTALL_TZDATA@,,;t t
-s,@DTRACE_SRC@,,;t t
-s,@DTRACE_HDR@,,;t t
-s,@DTRACE_OBJ@,,;t t
-s,@MAKEFILE_SHELL@,/bin/sh,;t t
-s,@BUILD_DLTEST@,$(DLTEST_TARGETS),;t t
-s,@TCL_PACKAGE_PATH@,/home/jima/space/ins/lin64/dynamic/main/lib ,;t t
-s,@TCL_MODULE_PATH@,,;t t
-s,@TCL_LIBRARY@,$(prefix)/lib/tcl$(VERSION),;t t
-s,@PRIVATE_INCLUDE_DIR@,$(includedir),;t t
-s,@HTML_DIR@,$(DISTDIR)/html,;t t
-s,@PACKAGE_DIR@,/home/jima/space/ins/lin64/dynamic/main/lib,;t t
-s,@EXTRA_CC_SWITCHES@,,;t t
-s,@EXTRA_APP_CC_SWITCHES@,,;t t
-s,@EXTRA_INSTALL@,,;t t
-s,@EXTRA_INSTALL_BINARIES@,@:,;t t
-s,@EXTRA_BUILD_HTML@,@:,;t t
-s,@EXTRA_TCLSH_LIBS@,,;t t
-s,@DLTEST_LD@,${SHLIB_LD},;t t
-s,@DLTEST_SUFFIX@,,;t t
-CEOF
-
-  # Split the substitutions into bite-sized pieces for seds with
-  # small command number limits, like on Digital OSF/1 and HP-UX.
-  ac_max_sed_lines=48
-  ac_sed_frag=1 # Number of current file.
-  ac_beg=1 # First line for current file.
-  ac_end=$ac_max_sed_lines # Line after last line for current file.
-  ac_more_lines=:
-  ac_sed_cmds=
-  while $ac_more_lines; do
-    if test $ac_beg -gt 1; then
-      sed "1,${ac_beg}d; ${ac_end}q" $tmp/subs.sed >$tmp/subs.frag
-    else
-      sed "${ac_end}q" $tmp/subs.sed >$tmp/subs.frag
-    fi
-    if test ! -s $tmp/subs.frag; then
-      ac_more_lines=false
-    else
-      # The purpose of the label and of the branching condition is to
-      # speed up the sed processing (if there are no `@' at all, there
-      # is no need to browse any of the substitutions).
-      # These are the two extra sed commands mentioned above.
-      (echo ':t
-  /@[a-zA-Z_][a-zA-Z_0-9]*@/!b' && cat $tmp/subs.frag) >$tmp/subs-$ac_sed_frag.sed
-      if test -z "$ac_sed_cmds"; then
-	ac_sed_cmds="sed -f $tmp/subs-$ac_sed_frag.sed"
-      else
-	ac_sed_cmds="$ac_sed_cmds | sed -f $tmp/subs-$ac_sed_frag.sed"
-      fi
-      ac_sed_frag=`expr $ac_sed_frag + 1`
-      ac_beg=$ac_end
-      ac_end=`expr $ac_end + $ac_max_sed_lines`
-    fi
-  done
-  if test -z "$ac_sed_cmds"; then
-    ac_sed_cmds=cat
-  fi
-fi # test -n "$CONFIG_FILES"
-
-for ac_file in : $CONFIG_FILES; do test "x$ac_file" = x: && continue
-  # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
-  case $ac_file in
-  - | *:- | *:-:* ) # input from stdin
-	cat >$tmp/stdin
-	ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'`
-	ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;;
-  *:* ) ac_file_in=`echo "$ac_file" | sed 's,[^:]*:,,'`
-	ac_file=`echo "$ac_file" | sed 's,:.*,,'` ;;
-  * )   ac_file_in=$ac_file.in ;;
-  esac
-
-  # Compute @srcdir@, @top_srcdir@, and @INSTALL@ for subdirectories.
-  ac_dir=`(dirname "$ac_file") 2>/dev/null ||
-$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
-	 X"$ac_file" : 'X\(//\)[^/]' \| \
-	 X"$ac_file" : 'X\(//\)$' \| \
-	 X"$ac_file" : 'X\(/\)' \| \
-	 .     : '\(.\)' 2>/dev/null ||
-echo X"$ac_file" |
-    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
-  	  /^X\(\/\/\)[^/].*/{ s//\1/; q; }
-  	  /^X\(\/\/\)$/{ s//\1/; q; }
-  	  /^X\(\/\).*/{ s//\1/; q; }
-  	  s/.*/./; q'`
-  { if $as_mkdir_p; then
-    mkdir -p "$ac_dir"
-  else
-    as_dir="$ac_dir"
-    as_dirs=
-    while test ! -d "$as_dir"; do
-      as_dirs="$as_dir $as_dirs"
-      as_dir=`(dirname "$as_dir") 2>/dev/null ||
-$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
-	 X"$as_dir" : 'X\(//\)[^/]' \| \
-	 X"$as_dir" : 'X\(//\)$' \| \
-	 X"$as_dir" : 'X\(/\)' \| \
-	 .     : '\(.\)' 2>/dev/null ||
-echo X"$as_dir" |
-    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
-  	  /^X\(\/\/\)[^/].*/{ s//\1/; q; }
-  	  /^X\(\/\/\)$/{ s//\1/; q; }
-  	  /^X\(\/\).*/{ s//\1/; q; }
-  	  s/.*/./; q'`
-    done
-    test ! -n "$as_dirs" || mkdir $as_dirs
-  fi || { { echo "$as_me:660: error: cannot create directory \"$ac_dir\"" >&5
-echo "$as_me: error: cannot create directory \"$ac_dir\"" >&2;}
-   { (exit 1); exit 1; }; }; }
-
-  ac_builddir=.
-
-if test "$ac_dir" != .; then
-  ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'`
-  # A "../" for each directory in $ac_dir_suffix.
-  ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'`
-else
-  ac_dir_suffix= ac_top_builddir=
-fi
-
-case $srcdir in
-  .)  # No --srcdir option.  We are building in place.
-    ac_srcdir=.
-    if test -z "$ac_top_builddir"; then
-       ac_top_srcdir=.
-    else
-       ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'`
-    fi ;;
-  [\\/]* | ?:[\\/]* )  # Absolute path.
-    ac_srcdir=$srcdir$ac_dir_suffix;
-    ac_top_srcdir=$srcdir ;;
-  *) # Relative path.
-    ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix
-    ac_top_srcdir=$ac_top_builddir$srcdir ;;
-esac
-
-# Do not use `cd foo && pwd` to compute absolute paths, because
-# the directories may not exist.
-case `pwd` in
-.) ac_abs_builddir="$ac_dir";;
-*)
-  case "$ac_dir" in
-  .) ac_abs_builddir=`pwd`;;
-  [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";;
-  *) ac_abs_builddir=`pwd`/"$ac_dir";;
-  esac;;
-esac
-case $ac_abs_builddir in
-.) ac_abs_top_builddir=${ac_top_builddir}.;;
-*)
-  case ${ac_top_builddir}. in
-  .) ac_abs_top_builddir=$ac_abs_builddir;;
-  [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;;
-  *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;;
-  esac;;
-esac
-case $ac_abs_builddir in
-.) ac_abs_srcdir=$ac_srcdir;;
-*)
-  case $ac_srcdir in
-  .) ac_abs_srcdir=$ac_abs_builddir;;
-  [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;;
-  *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;;
-  esac;;
-esac
-case $ac_abs_builddir in
-.) ac_abs_top_srcdir=$ac_top_srcdir;;
-*)
-  case $ac_top_srcdir in
-  .) ac_abs_top_srcdir=$ac_abs_builddir;;
-  [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;;
-  *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;;
-  esac;;
-esac
-
-
-
-  if test x"$ac_file" != x-; then
-    { echo "$as_me:732: creating $ac_file" >&5
-echo "$as_me: creating $ac_file" >&6;}
-    rm -f "$ac_file"
-  fi
-  # Let's still pretend it is `configure' which instantiates (i.e., don't
-  # use $as_me), people would be surprised to read:
-  #    /* config.h.  Generated by config.status.  */
-  if test x"$ac_file" = x-; then
-    configure_input=
-  else
-    configure_input="$ac_file.  "
-  fi
-  configure_input=$configure_input"Generated from `echo $ac_file_in |
-				     sed 's,.*/,,'` by configure."
-
-  # First look for the input files in the build tree, otherwise in the
-  # src tree.
-  ac_file_inputs=`IFS=:
-    for f in $ac_file_in; do
-      case $f in
-      -) echo $tmp/stdin ;;
-      [\\/$]*)
-	 # Absolute (can't be DOS-style, as IFS=:)
-	 test -f "$f" || { { echo "$as_me:755: error: cannot find input file: $f" >&5
-echo "$as_me: error: cannot find input file: $f" >&2;}
-   { (exit 1); exit 1; }; }
-	 echo "$f";;
-      *) # Relative
-	 if test -f "$f"; then
-	   # Build tree
-	   echo "$f"
-	 elif test -f "$srcdir/$f"; then
-	   # Source tree
-	   echo "$srcdir/$f"
-	 else
-	   # /dev/null tree
-	   { { echo "$as_me:768: error: cannot find input file: $f" >&5
-echo "$as_me: error: cannot find input file: $f" >&2;}
-   { (exit 1); exit 1; }; }
-	 fi;;
-      esac
-    done` || { (exit 1); exit 1; }
-  sed "
-
-:t
-/@[a-zA-Z_][a-zA-Z_0-9]*@/!b
-s,@configure_input@,$configure_input,;t t
-s,@srcdir@,$ac_srcdir,;t t
-s,@abs_srcdir@,$ac_abs_srcdir,;t t
-s,@top_srcdir@,$ac_top_srcdir,;t t
-s,@abs_top_srcdir@,$ac_abs_top_srcdir,;t t
-s,@builddir@,$ac_builddir,;t t
-s,@abs_builddir@,$ac_abs_builddir,;t t
-s,@top_builddir@,$ac_top_builddir,;t t
-s,@abs_top_builddir@,$ac_abs_top_builddir,;t t
-" $ac_file_inputs | (eval "$ac_sed_cmds") >$tmp/out
-  rm -f $tmp/stdin
-  if test x"$ac_file" != x-; then
-    mv $tmp/out $ac_file
-  else
-    cat $tmp/out
-    rm -f $tmp/out
-  fi
-
-done
-
-#
-# CONFIG_COMMANDS section.
-#
-for ac_file in : $CONFIG_COMMANDS; do test "x$ac_file" = x: && continue
-  ac_dest=`echo "$ac_file" | sed 's,:.*,,'`
-  ac_source=`echo "$ac_file" | sed 's,[^:]*:,,'`
-  ac_dir=`(dirname "$ac_dest") 2>/dev/null ||
-$as_expr X"$ac_dest" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
-	 X"$ac_dest" : 'X\(//\)[^/]' \| \
-	 X"$ac_dest" : 'X\(//\)$' \| \
-	 X"$ac_dest" : 'X\(/\)' \| \
-	 .     : '\(.\)' 2>/dev/null ||
-echo X"$ac_dest" |
-    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
-  	  /^X\(\/\/\)[^/].*/{ s//\1/; q; }
-  	  /^X\(\/\/\)$/{ s//\1/; q; }
-  	  /^X\(\/\).*/{ s//\1/; q; }
-  	  s/.*/./; q'`
-  { if $as_mkdir_p; then
-    mkdir -p "$ac_dir"
-  else
-    as_dir="$ac_dir"
-    as_dirs=
-    while test ! -d "$as_dir"; do
-      as_dirs="$as_dir $as_dirs"
-      as_dir=`(dirname "$as_dir") 2>/dev/null ||
-$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \
-	 X"$as_dir" : 'X\(//\)[^/]' \| \
-	 X"$as_dir" : 'X\(//\)$' \| \
-	 X"$as_dir" : 'X\(/\)' \| \
-	 .     : '\(.\)' 2>/dev/null ||
-echo X"$as_dir" |
-    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/; q; }
-  	  /^X\(\/\/\)[^/].*/{ s//\1/; q; }
-  	  /^X\(\/\/\)$/{ s//\1/; q; }
-  	  /^X\(\/\).*/{ s//\1/; q; }
-  	  s/.*/./; q'`
-    done
-    test ! -n "$as_dirs" || mkdir $as_dirs
-  fi || { { echo "$as_me:837: error: cannot create directory \"$ac_dir\"" >&5
-echo "$as_me: error: cannot create directory \"$ac_dir\"" >&2;}
-   { (exit 1); exit 1; }; }; }
-
-  ac_builddir=.
-
-if test "$ac_dir" != .; then
-  ac_dir_suffix=/`echo "$ac_dir" | sed 's,^\.[\\/],,'`
-  # A "../" for each directory in $ac_dir_suffix.
-  ac_top_builddir=`echo "$ac_dir_suffix" | sed 's,/[^\\/]*,../,g'`
-else
-  ac_dir_suffix= ac_top_builddir=
-fi
-
-case $srcdir in
-  .)  # No --srcdir option.  We are building in place.
-    ac_srcdir=.
-    if test -z "$ac_top_builddir"; then
-       ac_top_srcdir=.
-    else
-       ac_top_srcdir=`echo $ac_top_builddir | sed 's,/$,,'`
-    fi ;;
-  [\\/]* | ?:[\\/]* )  # Absolute path.
-    ac_srcdir=$srcdir$ac_dir_suffix;
-    ac_top_srcdir=$srcdir ;;
-  *) # Relative path.
-    ac_srcdir=$ac_top_builddir$srcdir$ac_dir_suffix
-    ac_top_srcdir=$ac_top_builddir$srcdir ;;
-esac
-
-# Do not use `cd foo && pwd` to compute absolute paths, because
-# the directories may not exist.
-case `pwd` in
-.) ac_abs_builddir="$ac_dir";;
-*)
-  case "$ac_dir" in
-  .) ac_abs_builddir=`pwd`;;
-  [\\/]* | ?:[\\/]* ) ac_abs_builddir="$ac_dir";;
-  *) ac_abs_builddir=`pwd`/"$ac_dir";;
-  esac;;
-esac
-case $ac_abs_builddir in
-.) ac_abs_top_builddir=${ac_top_builddir}.;;
-*)
-  case ${ac_top_builddir}. in
-  .) ac_abs_top_builddir=$ac_abs_builddir;;
-  [\\/]* | ?:[\\/]* ) ac_abs_top_builddir=${ac_top_builddir}.;;
-  *) ac_abs_top_builddir=$ac_abs_builddir/${ac_top_builddir}.;;
-  esac;;
-esac
-case $ac_abs_builddir in
-.) ac_abs_srcdir=$ac_srcdir;;
-*)
-  case $ac_srcdir in
-  .) ac_abs_srcdir=$ac_abs_builddir;;
-  [\\/]* | ?:[\\/]* ) ac_abs_srcdir=$ac_srcdir;;
-  *) ac_abs_srcdir=$ac_abs_builddir/$ac_srcdir;;
-  esac;;
-esac
-case $ac_abs_builddir in
-.) ac_abs_top_srcdir=$ac_top_srcdir;;
-*)
-  case $ac_top_srcdir in
-  .) ac_abs_top_srcdir=$ac_abs_builddir;;
-  [\\/]* | ?:[\\/]* ) ac_abs_top_srcdir=$ac_top_srcdir;;
-  *) ac_abs_top_srcdir=$ac_abs_builddir/$ac_top_srcdir;;
-  esac;;
-esac
-
-
-  { echo "$as_me:907: executing $ac_dest commands" >&5
-echo "$as_me: executing $ac_dest commands" >&6;}
-  case $ac_dest in
-    Tcl.framework ) n=Tcl &&
-        f=$n.framework && v=Versions/$VERSION &&
-        rm -rf $f && mkdir -p $f/$v/Resources &&
-        ln -s $v/$n $v/Resources $f && ln -s ../../../$n $f/$v &&
-        ln -s ../../../../$n-Info.plist $f/$v/Resources/Info.plist &&
-        unset n f v
-     ;;
-  esac
-done
-
-{ (exit 0); exit 0; }

unix/dltest/Makefile.in

@@ -17,7 +17,7 @@ TCL_VERSION=		@TCL_VERSION@
 
 CFLAGS_DEBUG		= @CFLAGS_DEBUG@
 CFLAGS_OPTIMIZE		= @CFLAGS_OPTIMIZE@
-CFLAGS			= @CFLAGS_DEFAULT@ @CFLAGS@ -DTCL_NO_DEPRECATED=1 -Wall -Wextra -Wc++-compat -Wconversion -Werror
+CFLAGS			= @CFLAGS_DEFAULT@ @CFLAGS@ -Wall -Wextra -Wc++-compat -Wconversion -Werror
 LDFLAGS_DEBUG		= @LDFLAGS_DEBUG@
 LDFLAGS_OPTIMIZE	= @LDFLAGS_OPTIMIZE@
 LDFLAGS			= @LDFLAGS_DEFAULT@ @LDFLAGS@
@@ -27,13 +27,13 @@ CC_SWITCHES = $(CFLAGS) -I${SRC_DIR}/../../generic -DTCL_MEM_DEBUG \
 
 all: embtest tcl9pkga${SHLIB_SUFFIX} tcl9pkgb${SHLIB_SUFFIX} tcl9pkgc${SHLIB_SUFFIX} \
 	tcl9pkgd${SHLIB_SUFFIX} tcl9pkge${SHLIB_SUFFIX} tcl9pkgt${SHLIB_SUFFIX} tcl9pkgua${SHLIB_SUFFIX} \
-	tcl9pkgooa${SHLIB_SUFFIX} pkga${SHLIB_SUFFIX} pkgb${SHLIB_SUFFIX} pkgc${SHLIB_SUFFIX}  pkgt${SHLIB_SUFFIX}
+	tcl9pkgooa${SHLIB_SUFFIX}
 	@if test -n "$(DLTEST_SUFFIX)"; then $(MAKE) dltest_suffix; fi
 	@touch ../dltest.marker
 
 dltest_suffix: tcl9pkga${DLTEST_SUFFIX} tcl9pkgb${DLTEST_SUFFIX} tcl9pkgc${DLTEST_SUFFIX} \
 	tcl9pkgd${DLTEST_SUFFIX} tcl9pkge${DLTEST_SUFFIX} tcl9pkgt${DLTEST_SUFFIX} tcl9pkgua${DLTEST_SUFFIX} \
-	tcl9pkgooa${DLTEST_SUFFIX} pkga${DLTEST_SUFFIX} pkgb${DLTEST_SUFFIX} pkgc${DLTEST_SUFFIX} pkgt${DLTEST_SUFFIX}
+	tcl9pkgooa${DLTEST_SUFFIX}
 	@touch ../dltest.marker
 
 embtest.o: $(SRC_DIR)/embtest.c
@@ -54,18 +54,6 @@ pkgc.o: $(SRC_DIR)/pkgc.c
 pkgt.o: $(SRC_DIR)/pkgt.c
 	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgt.c
 
-tcl8pkga.o: $(SRC_DIR)/pkga.c
-	$(CC) -o $@ -c $(CC_SWITCHES) -DTCL_MAJOR_VERSION=8 $(SRC_DIR)/pkga.c
-
-tcl8pkgb.o: $(SRC_DIR)/pkgb.c
-	$(CC) -o $@ -c $(CC_SWITCHES) -DTCL_MAJOR_VERSION=8 $(SRC_DIR)/pkgb.c
-
-tcl8pkgc.o: $(SRC_DIR)/pkgc.c
-	$(CC) -o $@ -c $(CC_SWITCHES) -DTCL_MAJOR_VERSION=8 $(SRC_DIR)/pkgc.c
-
-tcl8pkgt.o: $(SRC_DIR)/pkgt.c
-	$(CC) -o $@ -c $(CC_SWITCHES) -DTCL_MAJOR_VERSION=8 $(SRC_DIR)/pkgt.c
-
 pkgd.o: $(SRC_DIR)/pkgd.c
 	$(CC) -c $(CC_SWITCHES) $(SRC_DIR)/pkgd.c
 
@@ -96,18 +84,6 @@ tcl9pkgc${SHLIB_SUFFIX}: pkgc.o
 tcl9pkgt${SHLIB_SUFFIX}: pkgt.o
 	${SHLIB_LD} -o $@ pkgt.o ${SHLIB_LD_LIBS}
 
-pkga${SHLIB_SUFFIX}: tcl8pkga.o
-	${SHLIB_LD} -o $@ tcl8pkga.o ${SHLIB_LD_LIBS}
-
-pkgb${SHLIB_SUFFIX}: tcl8pkgb.o
-	${SHLIB_LD} -o $@ tcl8pkgb.o ${SHLIB_LD_LIBS}
-
-pkgc${SHLIB_SUFFIX}: tcl8pkgc.o
-	${SHLIB_LD} -o $@ tcl8pkgc.o ${SHLIB_LD_LIBS}
-
-pkgt${SHLIB_SUFFIX}: tcl8pkgt.o
-	${SHLIB_LD} -o $@ tcl8pkgt.o ${SHLIB_LD_LIBS}
-
 tcl9pkgd${SHLIB_SUFFIX}: pkgd.o
 	${SHLIB_LD} -o $@ pkgd.o ${SHLIB_LD_LIBS}
 
@@ -135,18 +111,6 @@ tcl9pkgc${DLTEST_SUFFIX}: pkgc.o
 tcl9pkgt${DLTEST_SUFFIX}: pkgt.o
 	${DLTEST_LD} -o $@ pkgt.o ${SHLIB_LD_LIBS}
 
-pkga${DLTEST_SUFFIX}: tcl8pkga.o
-	${DLTEST_LD} -o $@ tcl8pkga.o ${SHLIB_LD_LIBS}
-
-pkgb${DLTEST_SUFFIX}: tcl8pkgb.o
-	${DLTEST_LD} -o $@ tcl8pkgb.o ${SHLIB_LD_LIBS}
-
-pkgc${DLTEST_SUFFIX}: tcl8pkgc.o
-	${DLTEST_LD} -o $@ tcl8pkgc.o ${SHLIB_LD_LIBS}
-
-pkgt${DLTEST_SUFFIX}: tcl8pkgt.o
-	${DLTEST_LD} -o $@ tcl8pkgt.o ${SHLIB_LD_LIBS}
-
 tcl9pkgd${DLTEST_SUFFIX}: pkgd.o
 	${DLTEST_LD} -o $@ pkgd.o ${SHLIB_LD_LIBS}
 

unix/tclAppInit.c

@@ -13,15 +13,6 @@
  */
 
 #include "tcl.h"
-#if TCL_MAJOR_VERSION < 9
-#  if defined(USE_TCL_STUBS)
-#	error "Don't build with USE_TCL_STUBS!"
-#  endif
-#  if TCL_MINOR_VERSION < 7
-#   define Tcl_LibraryInitProc Tcl_PackageInitProc
-#   define Tcl_StaticLibrary Tcl_StaticPackage
-#  endif
-#endif
 
 #ifdef TCL_TEST
 extern Tcl_LibraryInitProc Tcltest_Init;
@@ -86,7 +77,7 @@ main(
 
 #ifdef TCL_LOCAL_MAIN_HOOK
     TCL_LOCAL_MAIN_HOOK(&argc, &argv);
-#elif (TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6) && (!defined(_WIN32) || defined(UNICODE))
+#elif !defined(_WIN32) || defined(UNICODE)
     /* New in Tcl 8.7. This doesn't work on Windows without UNICODE */
     TclZipfs_AppHook(&argc, &argv);
 #endif

win/Makefile.in

@@ -84,11 +84,6 @@ CFLAGS_OPTIMIZE	= @CFLAGS_OPTIMIZE@
 #CFLAGS = 		$(CFLAGS_DEBUG) $(CFLAGS_OPTIMIZE)
 CFLAGS = 		@CFLAGS@ @CFLAGS_DEFAULT@ -DMP_FIXED_CUTOFFS -D__USE_MINGW_ANSI_STDIO=0 -DMP_NO_STDINT
 
-# To compile without backward compatibility and deprecated code uncomment the
-# following
-NO_DEPRECATED_FLAGS	=
-#NO_DEPRECATED_FLAGS	= -DTCL_NO_DEPRECATED
-
 # To enable compilation debugging reverse the comment characters on one of the
 # following lines.
 COMPILE_DEBUG_FLAGS =
@@ -150,10 +145,8 @@ TCL_STUB_LIB_FILE	= @TCL_STUB_LIB_FILE@
 TCL_DLL_FILE		= @TCL_DLL_FILE@
 TCL_LIB_FILE		= @TCL_LIB_FILE@
 DDE_DLL_FILE		= tcl9dde$(DDEVER)${DLLSUFFIX}
-DDE_DLL_FILE8		= tcldde$(DDEVER)${DLLSUFFIX}
 DDE_LIB_FILE		= @LIBPREFIX@tcldde$(DDEVER)${DLLSUFFIX}${LIBSUFFIX}
 REG_DLL_FILE		= tcl9registry$(REGVER)${DLLSUFFIX}
-REG_DLL_FILE8		= tclregistry$(REGVER)${DLLSUFFIX}
 REG_LIB_FILE		= @LIBPREFIX@tclregistry$(REGVER)${DLLSUFFIX}${LIBSUFFIX}
 TEST_DLL_FILE		= tcltest$(VER)${DLLSUFFIX}
 TEST_EXE_FILE		= tcltest${EXESUFFIX}
@@ -270,6 +263,7 @@ ${AC_FLAGS} ${COMPILE_DEBUG_FLAGS}
 TCLTEST_OBJS = \
 	tclTest.$(OBJEXT) \
 	tclTestObj.$(OBJEXT) \
+	tclTestObjInterface.$(OBJEXT) \
 	tclTestProcBodyObj.$(OBJEXT) \
 	tclThreadTest.$(OBJEXT) \
 	tclWinTest.$(OBJEXT)
@@ -519,7 +513,7 @@ tcltest: binaries $(TEST_EXE_FILE) $(TEST_DLL_FILE) $(CAT32) tcltest.cmd
 
 binaries: $(TCL_STUB_LIB_FILE) @LIBRARIES@ winextensions ${TCL_ZIP_FILE} $(TCLSH)
 
-winextensions: ${DDE_DLL_FILE} ${REG_DLL_FILE} ${DDE_DLL_FILE8} ${REG_DLL_FILE8}
+winextensions: ${DDE_DLL_FILE} ${REG_DLL_FILE}
 
 libraries:
 
@@ -593,14 +587,6 @@ ${REG_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${REG_OBJS}
 	@MAKE_DLL@ ${REG_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
 	$(COPY) tclsh.exe.manifest ${REG_DLL_FILE}.manifest
 
-${DDE_DLL_FILE8}: ${TCL_STUB_LIB_FILE} tcl8WinDde.$(OBJEXT)
-	@MAKE_DLL@ tcl8WinDde.$(OBJEXT) $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
-	$(COPY) tclsh.exe.manifest ${DDE_DLL_FILE8}.manifest
-
-${REG_DLL_FILE8}: ${TCL_STUB_LIB_FILE} tcl8WinReg.$(OBJEXT)
-	@MAKE_DLL@ -DTCL_MAJOR_VERSION=8 tcl8WinReg.$(OBJEXT) $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
-	$(COPY) tclsh.exe.manifest ${REG_DLL_FILE8}.manifest
-
 ${TEST_DLL_FILE}: ${TCL_STUB_LIB_FILE} ${TCLTEST_OBJS}
 	@$(RM) ${TEST_DLL_FILE} ${TEST_LIB_FILE}
 	@MAKE_DLL@ ${TCLTEST_OBJS} $(TCL_STUB_LIB_FILE) $(SHLIB_LD_LIBS)
@@ -653,15 +639,9 @@ tclWinPipe.${OBJEXT}: tclWinPipe.c
 tclWinReg.${OBJEXT}: tclWinReg.c
 	$(CC) -c $(CC_SWITCHES) $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)
 
-tcl8WinReg.${OBJEXT}: tclWinReg.c
-	$(CC)  -o $@ -c $(CC_SWITCHES) -DTCL_MAJOR_VERSION=8 $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)
-
 tclWinDde.${OBJEXT}: tclWinDde.c
 	$(CC) -c $(CC_SWITCHES) $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)
 
-tcl8WinDde.${OBJEXT}: tclWinDde.c
-	$(CC) -o $@ -c $(CC_SWITCHES) -DTCL_MAJOR_VERSION=8 $(EXTFLAGS) @DEPARG@ $(CC_OBJNAME)
-
 tclAppInit.${OBJEXT}: tclAppInit.c
 	$(CC) -c $(CC_SWITCHES) $(EXTFLAGS) -DUNICODE -D_UNICODE @DEPARG@ $(CC_OBJNAME)
 
@@ -860,10 +840,6 @@ install-binaries: binaries
 	    $(COPY) $(ROOT_DIR)/library/dde/pkgIndex.tcl \
 		"$(LIB_INSTALL_DIR)/dde${DDEDOTVER}"; \
 	    fi
-	@if [ -f $(DDE_DLL_FILE8) ]; then \
-	    echo Installing $(DDE_DLL_FILE8); \
-	    $(COPY) $(DDE_DLL_FILE8) "$(LIB_INSTALL_DIR)/dde${DDEDOTVER}"; \
-	    fi
 	@if [ -f $(DDE_LIB_FILE) ]; then \
 	    echo Installing $(DDE_LIB_FILE); \
 	    $(COPY) $(DDE_LIB_FILE) "$(LIB_INSTALL_DIR)/dde${DDEDOTVER}"; \
@@ -874,10 +850,6 @@ install-binaries: binaries
 	    $(COPY) $(ROOT_DIR)/library/registry/pkgIndex.tcl \
 		"$(LIB_INSTALL_DIR)/registry${REGDOTVER}"; \
 	    fi
-	@if [ -f $(REG_DLL_FILE8) ]; then \
-	    echo Installing $(REG_DLL_FILE8); \
-	    $(COPY) $(REG_DLL_FILE8) "$(LIB_INSTALL_DIR)/registry${REGDOTVER}"; \
-	    fi
 	@if [ -f $(REG_LIB_FILE) ]; then \
 	    echo Installing $(REG_LIB_FILE); \
 	    $(COPY) $(REG_LIB_FILE) "$(LIB_INSTALL_DIR)/registry${REGDOTVER}"; \

win/makefile.vc

@@ -222,6 +222,7 @@ TCLSHOBJS = \
 TCLTESTOBJS = \
 	$(TMP_DIR)\tclTest.obj \
 	$(TMP_DIR)\tclTestObj.obj \
+	$(TMP_DIR)\tclTestObjInterface.obj \
 	$(TMP_DIR)\tclTestProcBodyObj.obj \
 	$(TMP_DIR)\tclThreadTest.obj \
 	$(TMP_DIR)\tclWinTest.obj \

win/rules.vc

@@ -816,7 +816,6 @@ DOTSEPARATED=$(DOTSEPARATED:b=.)
 #           configuration (ignored for Tcl itself)
 # _USE_64BIT_TIME_T - forces a build using 64-bit time_t for 32-bit build
 #           (CRT library should support this, not needed for Tcl 9.x)
-# TCL_UTF_MAX=3 - forces a build using UTF-16 internally (not recommended).
 # Further, LINKERFLAGS are modified based on above.
 
 # Default values for all the above
@@ -860,9 +859,6 @@ MSVCRT		= 0
 !if [nmakehlp -f $(OPTS) "msvcrt"]
 !message *** Doing msvcrt
 !else
-!if $(TCL_MAJOR_VERSION) == 8 && $(TCL_MINOR_VERSION) < 7 && $(STATIC_BUILD)
-MSVCRT		= 0
-!endif
 !endif
 !endif # [nmakehlp -f $(OPTS) "nomsvcrt"]
 
@@ -877,23 +873,6 @@ TCL_THREADS = 0
 USE_THREAD_ALLOC= 0
 !endif
 
-!if [nmakehlp -f $(OPTS) "tcl8"]
-!message *** Build for Tcl8
-TCL_BUILD_FOR = 8
-!endif
-
-!if $(TCL_MAJOR_VERSION) == 8
-!if [nmakehlp -f $(OPTS) "time64bit"]
-!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
-
 # Yes, it's weird that the "symbols" option controls DEBUG and
 # the "pdbs" option controls SYMBOLS. That's historical.
 !if [nmakehlp -f $(OPTS) "symbols"]
@@ -1010,18 +989,13 @@ TCL_COMPILE_DEBUG   = 0
 # 9. Parse the CHECKS macro to configure additional compiler checks
 # The following macros are set by this section:
 # WARNINGS - compiler switches that control the warnings level
-# TCL_NO_DEPRECATED - 1 -> disable support for deprecated functions
-#                     0 -> enable deprecated functions
-
 # Defaults - Permit deprecated functions and warning level 3
-TCL_NO_DEPRECATED	    = 0
 WARNINGS		    = -W3
 
 !if "$(CHECKS)" != "" && ![nmakehlp -f "$(CHECKS)" "none"]
 
 !if [nmakehlp -f $(CHECKS) "nodep"]
 !message *** Doing nodep check
-TCL_NO_DEPRECATED	    = 1
 !endif
 
 !if [nmakehlp -f $(CHECKS) "fullwarn"]
@@ -1151,11 +1125,7 @@ TCLLIBNAME	= $(PROJECT)$(VERSION)$(SUFX).$(EXT)
 TCLLIB		= $(OUT_DIR)\$(TCLLIBNAME)
 TCLSCRIPTZIP    = $(OUT_DIR)\$(TCLSCRIPTZIPNAME)
 
-!if $(TCL_MAJOR_VERSION) == 8
-TCLSTUBLIBNAME	= $(STUBPREFIX)$(VERSION).lib
-!else
 TCLSTUBLIBNAME	= $(STUBPREFIX).lib
-!endif
 TCLSTUBLIB	= $(OUT_DIR)\$(TCLSTUBLIBNAME)
 TCL_INCLUDES    = -I"$(WIN_DIR)" -I"$(GENERICDIR)"
 
@@ -1171,11 +1141,7 @@ TCLSH		= $(_TCLDIR)\bin\tclsh$(TCL_VERSION)$(SUFX:t=).exe
 TCLSH           = $(_TCLDIR)\bin\tclsh$(TCL_VERSION)t$(SUFX:t=).exe
 !endif
 
-!if $(TCL_MAJOR_VERSION) == 8
-TCLSTUBLIB	= $(_TCLDIR)\lib\tclstub$(TCL_VERSION).lib
-!else
 TCLSTUBLIB	= $(_TCLDIR)\lib\tclstub.lib
-!endif
 TCLIMPLIB	= $(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX:t=).lib
 # When building extensions, may be linking against Tcl that does not add
 # "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility.
@@ -1195,11 +1161,7 @@ TCLSH		= $(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)$(SUFX:t=).exe
 !if !exist($(TCLSH))
 TCLSH		= $(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)t$(SUFX:t=).exe
 !endif
-!if $(TCL_MAJOR_VERSION) == 8
-TCLSTUBLIB	= $(_TCLDIR)\win\$(BUILDDIRTOP)\tclstub$(TCL_VERSION).lib
-!else
 TCLSTUBLIB	= $(_TCLDIR)\win\$(BUILDDIRTOP)\tclstub.lib
-!endif
 TCLIMPLIB	= $(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX:t=).lib
 # When building extensions, may be linking against Tcl that does not add
 # "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility.
@@ -1215,11 +1177,7 @@ TCL_INCLUDES	= -I"$(_TCLDIR)\generic" -I"$(_TCLDIR)\win"
 
 !endif # TCLINSTALL
 
-!if !$(STATIC_BUILD) && "$(TCL_BUILD_FOR)" == "8"
-tcllibs = "$(TCLSTUBLIB)"
-!else
 tcllibs = "$(TCLSTUBLIB)" "$(TCLIMPLIB)"
-!endif
 
 !endif # $(DOING_TCL)
 
@@ -1239,13 +1197,8 @@ WISHNAMEPREFIX = wish
 WISHNAME = $(WISHNAMEPREFIX)$(TK_VERSION)$(SUFX).exe
 TKLIBNAME8	= tk$(TK_VERSION)$(SUFX).$(EXT)
 TKLIBNAME9	= tcl9tk$(TK_VERSION)$(SUFX).$(EXT)
-!if $(TCL_MAJOR_VERSION) == 8 || "$(TCL_BUILD_FOR)" == "8"
-TKLIBNAME	= tk$(TK_VERSION)$(SUFX).$(EXT)
-TKIMPLIBNAME	= tk$(TK_VERSION)$(SUFX).lib
-!else
 TKLIBNAME	= tcl9tk$(TK_VERSION)$(SUFX).$(EXT)
 TKIMPLIBNAME	= tcl9tk$(TK_VERSION)$(SUFX).lib
-!endif
 TKSTUBLIBNAME	= tkstub$(TK_VERSION).lib
 
 !if $(DOING_TK)
@@ -1296,18 +1249,10 @@ tklibs = "$(TKSTUBLIB)" "$(TKIMPLIB)"
 PRJIMPLIB	= $(OUT_DIR)\$(PROJECT)$(VERSION)$(SUFX).lib
 PRJLIBNAME8	= $(PROJECT)$(VERSION)$(SUFX).$(EXT)
 PRJLIBNAME9	= tcl9$(PROJECT)$(VERSION)$(SUFX).$(EXT)
-!if $(TCL_MAJOR_VERSION) == 8 || "$(TCL_BUILD_FOR)" == "8"
-PRJLIBNAME	= $(PRJLIBNAME8)
-!else
 PRJLIBNAME	= $(PRJLIBNAME9)
-!endif
 PRJLIB		= $(OUT_DIR)\$(PRJLIBNAME)
 
-!if $(TCL_MAJOR_VERSION) == 8
-PRJSTUBLIBNAME	= $(STUBPREFIX)$(VERSION).lib
-!else
 PRJSTUBLIBNAME	= $(STUBPREFIX).lib
-!endif
 PRJSTUBLIB	= $(OUT_DIR)\$(PRJSTUBLIBNAME)
 
 # If extension parent makefile has not defined a resource definition file,
@@ -1412,9 +1357,7 @@ OPTDEFINES	= $(OPTDEFINES) /DTCL_WITH_EXTERNAL_TOMMATH
 OPTDEFINES	= $(OPTDEFINES) /DMP_64BIT
 !endif
 !endif
-!if $(TCL_NO_DEPRECATED)
-OPTDEFINES	= $(OPTDEFINES) /DTCL_NO_DEPRECATED
-!endif
+OPTDEFINES	= $(OPTDEFINES)
 
 !if $(USE_STUBS)
 # Note we do not define USE_TCL_STUBS even when building tk since some
@@ -1443,21 +1386,6 @@ OPTDEFINES	= $(OPTDEFINES) /DTCL_CFG_DO64BIT
 OPTDEFINES	= $(OPTDEFINES) /DNO_STRTOI64=1
 !endif
 
-!if $(TCL_MAJOR_VERSION) == 8
-!if "$(_USE_64BIT_TIME_T)" == "1"
-OPTDEFINES	= $(OPTDEFINES) /D_USE_64BIT_TIME_T=1
-!endif
-
-# _ATL_XP_TARGETING - Newer SDK's need this to build for XP
-COMPILERFLAGS  = /D_ATL_XP_TARGETING
-!endif
-!if "$(TCL_UTF_MAX)" == "3"
-OPTDEFINES	= $(OPTDEFINES) /DTCL_UTF_MAX=3
-!endif
-!if "$(TCL_BUILD_FOR)" == "8"
-OPTDEFINES	= $(OPTDEFINES) /DTCL_MAJOR_VERSION=8
-!endif
-
 # Like the TEA system only set this non empty for non-Tk extensions
 # Note: some extensions use PACKAGE_NAME and others use PACKAGE_TCLNAME
 # so we pass both

win/tclAppInit.c

@@ -15,15 +15,6 @@
  */
 
 #include "tcl.h"
-#if TCL_MAJOR_VERSION < 9
-#  if defined(USE_TCL_STUBS)
-#	error "Don't build with USE_TCL_STUBS!"
-#  endif
-#  if TCL_MINOR_VERSION < 7
-#   define Tcl_LibraryInitProc Tcl_PackageInitProc
-#   define Tcl_StaticLibrary Tcl_StaticPackage
-#  endif
-#endif
 
 #ifdef TCL_TEST
 extern Tcl_LibraryInitProc Tcltest_Init;
@@ -136,7 +127,7 @@ _tmain(
 
 #ifdef TCL_LOCAL_MAIN_HOOK
     TCL_LOCAL_MAIN_HOOK(&argc, &argv);
-#elif (TCL_MAJOR_VERSION > 8 || TCL_MINOR_VERSION > 6) && (!defined(_WIN32) || defined(UNICODE))
+#elif (!defined(_WIN32) || defined(UNICODE))
     /* New in Tcl 8.7. This doesn't work on Windows without UNICODE */
     TclZipfs_AppHook(&argc, &argv);
 #endif

win/tclWinDde.c

@@ -117,28 +117,11 @@ static int		DdeObjCmd(void *clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
 
-#if (TCL_MAJOR_VERSION < 9) && defined(TCL_MINOR_VERSION) && (TCL_MINOR_VERSION < 7)
-# if TCL_UTF_MAX > 3
-#   define Tcl_WCharToUtfDString(a,b,c) Tcl_WinTCharToUtf((TCHAR *)(a),(b)*sizeof(WCHAR),c)
-#   define Tcl_UtfToWCharDString(a,b,c) (WCHAR *)Tcl_WinUtfToTChar(a,b,c)
-# else
-#   define Tcl_WCharToUtfDString Tcl_UniCharToUtfDString
-#   define Tcl_UtfToWCharDString Tcl_UtfToUniCharDString
-# endif
-#define Tcl_Size int
-#define TCL_INDEX_NONE -1
-#endif
-
 #ifdef __cplusplus
 extern "C" {
 #endif
 DLLEXPORT int		Dde_Init(Tcl_Interp *interp);
 DLLEXPORT int		Dde_SafeInit(Tcl_Interp *interp);
-#if TCL_MAJOR_VERSION < 9
-/* With those additional entries, "load dde14.dll" works without 3th argument */
-DLLEXPORT int		Tcldde_Init(Tcl_Interp *interp);
-DLLEXPORT int		Tcldde_SafeInit(Tcl_Interp *interp);
-#endif
 #ifdef __cplusplus
 }
 #endif
@@ -171,14 +154,6 @@ Dde_Init(
     Tcl_CreateExitHandler(DdeExitProc, NULL);
     return Tcl_PkgProvideEx(interp, TCL_DDE_PACKAGE_NAME, TCL_DDE_VERSION, NULL);
 }
-#if TCL_MAJOR_VERSION < 9
-int
-Tcldde_Init(
-    Tcl_Interp *interp)
-{
-    return Dde_Init(interp);
-}
-#endif
 
 /*
  *----------------------------------------------------------------------
@@ -206,14 +181,6 @@ Dde_SafeInit(
     }
     return result;
 }
-#if TCL_MAJOR_VERSION < 9
-int
-Tcldde_SafeInit(
-    Tcl_Interp *interp)
-{
-    return Dde_SafeInit(interp);
-}
-#endif
 
 /*
  *----------------------------------------------------------------------

win/tclWinReg.c

@@ -124,28 +124,11 @@ static int		SetValue(Tcl_Interp *interp, Tcl_Obj *keyNameObj,
 			    Tcl_Obj *valueNameObj, Tcl_Obj *dataObj,
 			    Tcl_Obj *typeObj, REGSAM mode);
 
-#if (TCL_MAJOR_VERSION < 9) && defined(TCL_MINOR_VERSION) && (TCL_MINOR_VERSION < 7)
-# if TCL_UTF_MAX > 3
-#   define Tcl_WCharToUtfDString(a,b,c) Tcl_WinTCharToUtf((TCHAR *)(a),(b)*sizeof(WCHAR),c)
-#   define Tcl_UtfToWCharDString(a,b,c) (WCHAR *)Tcl_WinUtfToTChar(a,b,c)
-# else
-#   define Tcl_WCharToUtfDString Tcl_UniCharToUtfDString
-#   define Tcl_UtfToWCharDString Tcl_UtfToUniCharDString
-# endif
-#define Tcl_Size int
-#define TCL_INDEX_NONE -1
-#endif
-
 #ifdef __cplusplus
 extern "C" {
 #endif
 DLLEXPORT int		Registry_Init(Tcl_Interp *interp);
 DLLEXPORT int		Registry_Unload(Tcl_Interp *interp, int flags);
-#if TCL_MAJOR_VERSION < 9
-/* With those additional entries, "load registry13.dll" works without 3th argument */
-DLLEXPORT int		Tclregistry_Init(Tcl_Interp *interp);
-DLLEXPORT int		Tclregistry_Unload(Tcl_Interp *interp, int flags);
-#endif
 #ifdef __cplusplus
 }
 #endif
@@ -181,14 +164,6 @@ Registry_Init(
     Tcl_SetAssocData(interp, REGISTRY_ASSOC_KEY, NULL, cmd);
     return Tcl_PkgProvideEx(interp, "registry", "1.3.7", NULL);
 }
-#if TCL_MAJOR_VERSION < 9
-int
-Tclregistry_Init(
-    Tcl_Interp *interp)
-{
-    return Registry_Init(interp);
-}
-#endif
 
 /*
  *----------------------------------------------------------------------
@@ -235,15 +210,6 @@ Registry_Unload(
 
     return TCL_OK;
 }
-#if TCL_MAJOR_VERSION < 9
-int
-Tclregistry_Unload(
-    Tcl_Interp *interp,
-    int flags)
-{
-    return Registry_Unload(interp, flags);
-}
-#endif
 
 /*
  *----------------------------------------------------------------------