Merge main

After the presentation on Abstract Lists at the 2023 OpenACS/Tcl
Conference, there was a strong opinion that this function should be
renamed. The results of an informal poll had a tie between
Tcl_DoneWithObj() and Tcl_BounceRefCount(). Having seen a reference to
"Bounce" in a research paper on Ref Counting, I chose to use
Tcl_BounceRefCount().

.fossil-settings/ignore-glob

@@ -48,9 +48,11 @@ libtommath/*.tex
 macosx/configure
 unix/autoMkindex.tcl
 unix/dltest.marker
+unix/dltest/embtest
 unix/dltest/*.bundle
 unix/dltest/*.dll
 unix/dltest/*.dylib
+unix/dltest/*.exe
 unix/dltest/*.o
 unix/dltest/*.sl
 unix/dltest/*.so

.github/workflows/linux-build.yml

@@ -4,6 +4,7 @@ on:
     branches:
     - "main"
     - "core-8-branch"
+    - "core-8-6-branch"
     tags:
     - "core-**"
 permissions:
@@ -15,6 +16,8 @@ jobs:
       matrix:
         cfgopt:
           - ""
+          - "CFLAGS=-DTCL_UTF_MAX=3"
+          - "CFLAGS=-DTCL_NO_DEPRECATED=1"
           - "--disable-shared"
           - "--enable-symbols"
           - "--enable-symbols=mem"
@@ -26,6 +29,7 @@ jobs:
     steps:
       - name: Checkout
         uses: actions/checkout@v3
+        timeout-minutes: 5
       - name: Prepare
         run: |
           touch tclStubInit.c tclOOStubInit.c tclOOScript.h
@@ -36,23 +40,30 @@ jobs:
           ./configure ${CFGOPT} "--prefix=$HOME/install dir" || (cat config.log && exit 1)
         env:
           CFGOPT: ${{ matrix.cfgopt }}
+        timeout-minutes: 5
       - name: Build
         run: |
           make all
+        timeout-minutes: 5
       - name: Build Test Harness
         run: |
           make tcltest
+        timeout-minutes: 5
       - name: Run Tests
         run: |
           make test
         env:
           ERROR_ON_FAILURES: 1
+        timeout-minutes: 30
       - name: Test-Drive Installation
         run: |
           make install
+        timeout-minutes: 5
       - name: Create Distribution Package
         run: |
           make dist
+        timeout-minutes: 5
       - name: Convert Documentation to HTML
         run: |
           make html-tcl
+        timeout-minutes: 5

.github/workflows/mac-build.yml

@@ -4,6 +4,7 @@ on:
     branches:
     - "main"
     - "core-8-branch"
+    - "core-8-6-branch"
     tags:
     - "core-**"
 permissions:
@@ -18,6 +19,7 @@ jobs:
     steps:
       - name: Checkout
         uses: actions/checkout@v3
+        timeout-minutes: 5
       - name: Prepare
         run: |
           touch tclStubInit.c tclOOStubInit.c tclOOScript.h
@@ -26,11 +28,13 @@ jobs:
         run: make all
         env:
           CFLAGS: -arch x86_64 -arch arm64
+        timeout-minutes: 15
       - name: Run Tests
         run: make test styles=develop
         env:
           ERROR_ON_FAILURES: 1
           MAC_CI: 1
+        timeout-minutes: 15
   clang:
     runs-on: macos-11
     strategy:
@@ -48,6 +52,7 @@ jobs:
     steps:
       - name: Checkout
         uses: actions/checkout@v3
+        timeout-minutes: 5
       - name: Prepare
         run: |
           touch tclStubInit.c tclOOStubInit.c tclOOScript.h
@@ -59,14 +64,17 @@ jobs:
         env:
           CFLAGS: -arch x86_64 -arch arm64
           CFGOPT: ${{ matrix.cfgopt }}
+        timeout-minutes: 5
       - name: Build
         run: |
           make all tcltest
         env:
           CFLAGS: -arch x86_64 -arch arm64
+        timeout-minutes: 15
       - name: Run Tests
         run: |
           make test
         env:
           ERROR_ON_FAILURES: 1
           MAC_CI: 1
+        timeout-minutes: 15

.github/workflows/onefiledist.yml

@@ -15,6 +15,7 @@ jobs:
     defaults:
       run:
         shell: bash
+    timeout-minutes: 10
     steps:
       - name: Checkout
         uses: actions/checkout@v3
@@ -50,6 +51,7 @@ jobs:
     defaults:
       run:
         shell: bash
+    timeout-minutes: 10
     steps:
       - name: Checkout
         uses: actions/checkout@v3
@@ -112,6 +114,7 @@ jobs:
     defaults:
       run:
         shell: msys2 {0}
+    timeout-minutes: 10
     env:
       CC: gcc
       CFGOPT: --disable-symbols --disable-shared

.github/workflows/win-build.yml

@@ -4,6 +4,7 @@ on:
     branches:
     - "main"
     - "core-8-branch"
+    - "core-8-6-branch"
     tags:
     - "core-**"
 permissions:
@@ -30,26 +31,31 @@ jobs:
     steps:
       - name: Checkout
         uses: actions/checkout@v3
+        timeout-minutes: 5
       - name: Init MSVC
         uses: ilammy/msvc-dev-cmd@v1
+        timeout-minutes: 5
       - name: Build ${{ matrix.cfgopt }}
         run: |
           &nmake -f makefile.vc ${{ matrix.cfgopt }} all
           if ($lastexitcode -ne 0) {
              throw "nmake exit code: $lastexitcode"
           }
+        timeout-minutes: 5
       - name: Build Test Harness ${{ matrix.cfgopt }}
         run: |
           &nmake -f makefile.vc ${{ matrix.cfgopt }} tcltest
           if ($lastexitcode -ne 0) {
              throw "nmake exit code: $lastexitcode"
           }
+        timeout-minutes: 5
       - name: Run Tests ${{ matrix.cfgopt }}
         run: |
           &nmake -f makefile.vc ${{ matrix.cfgopt }} test
           if ($lastexitcode -ne 0) {
              throw "nmake exit code: $lastexitcode"
           }
+        timeout-minutes: 30
   gcc:
     runs-on: windows-2022
     defaults:
@@ -60,6 +66,8 @@ jobs:
       matrix:
         cfgopt:
           - ""
+          - "CFLAGS=-DTCL_UTF_MAX=3"
+          - "CFLAGS=-DTCL_NO_DEPRECATED=1"
           - "--disable-shared"
           - "--enable-symbols"
           - "--enable-symbols=mem"
@@ -71,8 +79,10 @@ jobs:
         with:
           msystem: MINGW64
           install: git mingw-w64-x86_64-toolchain make
+        timeout-minutes: 10
       - name: Checkout
         uses: actions/checkout@v3
+        timeout-minutes: 5
       - name: Prepare
         run: |
           touch tclStubInit.c tclOOStubInit.c tclOOScript.h
@@ -83,12 +93,16 @@ jobs:
           ./configure ${CFGOPT} "--prefix=$HOME/install dir" || (cat config.log && exit 1)
         env:
           CFGOPT: --enable-64bit ${{ matrix.cfgopt }}
+        timeout-minutes: 5
       - name: Build
         run: make all
+        timeout-minutes: 5
       - name: Build Test Harness
         run: make tcltest
+        timeout-minutes: 5
       - name: Run Tests
         run: make test
+        timeout-minutes: 30
 
 # If you add builds with Wine, be sure to define the environment variable
 # CI_USING_WINE when running them so that broken tests know not to run.

.gitignore

@@ -53,6 +53,7 @@ libtommath/*.tex
 macosx/configure
 unix/autoMkindex.tcl
 unix/dltest.marker
+unix/dltest/embtest
 unix/tcl.pc
 unix/tclIndex
 unix/pkgs/*

.travis.yml

@@ -20,12 +20,20 @@ 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
@@ -293,6 +301,20 @@ 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
@@ -321,6 +343,20 @@ 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

changes

@@ -8247,7 +8247,7 @@ Dropped support for OS X versions less than 10.4 (Tiger) (fellows)
 
 2013-06-05 (bug fix)[2835313] [while 1 {foo [continue]}] crash (fellows)
 
-2013-06-17 (bug fix)[a876646] [:cntrl:] includes \x00 to \x1f (nijtmans)
+2013-06-17 (bug fix)[a876646] [:cntrl:] includes \x00 to \x1F (nijtmans)
 
 2013-06-27 (bug fix)[983509] missing encodings for config values (nijtmans)
 

compat/dirent.h

@@ -1,21 +0,0 @@
-/*
- * dirent.h --
- *
- *	This file is a replacement for <dirent.h> in systems that
- *	support the old BSD-style <sys/dir.h> with a "struct direct".
- *
- * Copyright (c) 1991 The Regents of the University of California.
- * Copyright (c) 1994 Sun Microsystems, Inc.
- *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- */
-
-#ifndef _DIRENT
-#define _DIRENT
-
-#include <sys/dir.h>
-
-#define dirent direct
-
-#endif /* _DIRENT */

compat/dirent2.h

@@ -1,53 +0,0 @@
-/*
- * dirent.h --
- *
- *	Declarations of a library of directory-reading procedures
- *	in the POSIX style ("struct dirent").
- *
- * Copyright (c) 1991 The Regents of the University of California.
- * Copyright (c) 1994 Sun Microsystems, Inc.
- *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- */
-
-#ifndef _DIRENT
-#define _DIRENT
-
-/*
- * Dirent structure, which holds information about a single
- * directory entry.
- */
-
-#define MAXNAMLEN 255
-#define DIRBLKSIZ 512
-
-struct dirent {
-    long d_ino;			/* Inode number of entry */
-    short d_reclen;		/* Length of this record */
-    short d_namlen;		/* Length of string in d_name */
-    char d_name[MAXNAMLEN + 1];	/* Name must be no longer than this */
-};
-
-/*
- * State that keeps track of the reading of a directory (clients
- * should never look inside this structure;  the fields should
- * only be accessed by the library procedures).
- */
-
-typedef struct _dirdesc {
-    int dd_fd;
-    long dd_loc;
-    long dd_size;
-    char dd_buf[DIRBLKSIZ];
-} DIR;
-
-/*
- * Procedures defined for reading directories:
- */
-
-extern void		closedir (DIR *dirp);
-extern DIR *		opendir (char *name);
-extern struct dirent *	readdir (DIR *dirp);
-
-#endif /* _DIRENT */

compat/memcmp.c

@@ -1,64 +0,0 @@
-/*
- * memcmp.c --
- *
- *	Source code for the "memcmp" library routine.
- *
- * Copyright (c) 1998 Sun Microsystems, Inc.
- *
- * See the file "license.terms" for information on usage and redistribution of
- * this file, and for a DISCLAIMER OF ALL WARRANTIES.
- */
-
-#include "tclPort.h"
-
-/*
- * Here is the prototype just in case it is not included in tclPort.h.
- */
-
-int		memcmp(const void *s1, const void *s2, size_t n);
-
-/*
- *----------------------------------------------------------------------
- *
- * memcmp --
- *
- *	Compares two bytes sequences.
- *
- * Results:
- *	Compares its arguments, looking at the first n bytes (each interpreted
- *	as an unsigned char), and returns an integer less than, equal to, or
- *	greater than 0, according as s1 is less than, equal to, or greater
- *	than s2 when taken to be unsigned 8 bit numbers.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-memcmp(
-    const void *s1,		/* First string. */
-    const void *s2,		/* Second string. */
-    size_t n)			/* Length to compare. */
-{
-    const unsigned char *ptr1 = (const unsigned char *) s1;
-    const unsigned char *ptr2 = (const unsigned char *) s2;
-
-    for ( ; n-- ; ptr1++, ptr2++) {
-	unsigned char u1 = *ptr1, u2 = *ptr2;
-
-	if (u1 != u2) {
-	    return (u1-u2);
-	}
-    }
-    return 0;
-}
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */

compat/opendir.c

@@ -1,109 +0,0 @@
-/*
- * opendir.c --
- *
- *	This file provides dirent-style directory-reading procedures for V7
- *	Unix systems that don't have such procedures. The origin of this code
- *	is unclear, but it seems to have come originally from Larry Wall.
- */
-
-#include "tclInt.h"
-
-#undef DIRSIZ
-#define DIRSIZ(dp) \
-    ((sizeof(struct dirent) - (MAXNAMLEN+1)) + (((dp)->d_namlen+1 + 3) &~ 3))
-
-/*
- * open a directory.
- */
-
-DIR *
-opendir(
-    char *name)
-{
-    DIR *dirp;
-    int fd;
-    const char *myname;
-
-    myname = ((*name == '\0') ? "." : name);
-    if ((fd = open(myname, 0, 0)) == -1) {
-	return NULL;
-    }
-    dirp = (DIR *) Tcl_AttemptAlloc(sizeof(DIR));
-    if (dirp == NULL) {
-	close(fd);
-	return NULL;
-    }
-    dirp->dd_fd = fd;
-    dirp->dd_loc = 0;
-    return dirp;
-}
-
-/*
- * read an old style directory entry and present it as a new one
- */
-#ifndef pyr
-#define	ODIRSIZ	14
-
-struct olddirect {
-    ino_t od_ino;
-    char od_name[ODIRSIZ];
-};
-#else	/* a Pyramid in the ATT universe */
-#define	ODIRSIZ	248
-
-struct olddirect {
-    long od_ino;
-    short od_fill1, od_fill2;
-    char od_name[ODIRSIZ];
-};
-#endif
-
-/*
- * get next entry in a directory.
- */
-
-struct dirent *
-readdir(
-    DIR *dirp)
-{
-    struct olddirect *dp;
-    static struct dirent dir;
-
-    for (;;) {
-	if (dirp->dd_loc == 0) {
-	    dirp->dd_size = read(dirp->dd_fd, dirp->dd_buf, DIRBLKSIZ);
-	    if (dirp->dd_size <= 0) {
-		return NULL;
-	    }
-	}
-	if (dirp->dd_loc >= dirp->dd_size) {
-	    dirp->dd_loc = 0;
-	    continue;
-	}
-	dp = (struct olddirect *)(dirp->dd_buf + dirp->dd_loc);
-	dirp->dd_loc += sizeof(struct olddirect);
-	if (dp->od_ino == 0) {
-	    continue;
-	}
-	dir.d_ino = dp->od_ino;
-	strncpy(dir.d_name, dp->od_name, ODIRSIZ);
-	dir.d_name[ODIRSIZ] = '\0'; /* insure null termination */
-	dir.d_namlen = strlen(dir.d_name);
-	dir.d_reclen = DIRSIZ(&dir);
-	return &dir;
-    }
-}
-
-/*
- * close a directory.
- */
-
-void
-closedir(
-    DIR *dirp)
-{
-    close(dirp->dd_fd);
-    dirp->dd_fd = -1;
-    dirp->dd_loc = 0;
-    Tcl_Free(dirp);
-}

compat/stdint.h

@@ -1,919 +0,0 @@
-/*  A portable stdint.h
- ****************************************************************************
- *  BSD License:
- ****************************************************************************
- *
- *  Copyright (c) 2005-2016 Paul Hsieh
- *  All rights reserved.
- *
- *  Redistribution and use in source and binary forms, with or without
- *  modification, are permitted provided that the following conditions
- *  are met:
- *
- *  1. Redistributions of source code must retain the above copyright
- *     notice, this list of conditions and the following disclaimer.
- *  2. Redistributions in binary form must reproduce the above copyright
- *     notice, this list of conditions and the following disclaimer in the
- *     documentation and/or other materials provided with the distribution.
- *  3. The name of the author may not be used to endorse or promote products
- *     derived from this software without specific prior written permission.
- *
- *  THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
- *  IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
- *  OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
- *  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
- *  INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
- *  NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
- *  DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
- *  THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
- *  (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
- *  THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *
- ****************************************************************************
- *
- *  Version 0.1.16.0
- *
- *  The ANSI C standard committee, for the C99 standard, specified the
- *  inclusion of a new standard include file called stdint.h.  This is
- *  a very useful and long desired include file which contains several
- *  very precise definitions for integer scalar types that is critically
- *  important for making several classes of applications portable
- *  including cryptography, hashing, variable length integer libraries
- *  and so on.  But for most developers its likely useful just for
- *  programming sanity.
- *
- *  The problem is that some compiler vendors chose to ignore the C99
- *  standard and some older compilers have no opportunity to be updated.
- *  Because of this situation, simply including stdint.h in your code
- *  makes it unportable.
- *
- *  So that's what this file is all about.  It's an attempt to build a
- *  single universal include file that works on as many platforms as
- *  possible to deliver what stdint.h is supposed to.  Even compilers
- *  that already come with stdint.h can use this file instead without
- *  any loss of functionality.  A few things that should be noted about
- *  this file:
- *
- *    1) It is not guaranteed to be portable and/or present an identical
- *       interface on all platforms.  The extreme variability of the
- *       ANSI C standard makes this an impossibility right from the
- *       very get go. Its really only meant to be useful for the vast
- *       majority of platforms that possess the capability of
- *       implementing usefully and precisely defined, standard sized
- *       integer scalars.  Systems which are not intrinsically 2s
- *       complement may produce invalid constants.
- *
- *    2) There is an unavoidable use of non-reserved symbols.
- *
- *    3) Other standard include files are invoked.
- *
- *    4) This file may come in conflict with future platforms that do
- *       include stdint.h.  The hope is that one or the other can be
- *       used with no real difference.
- *
- *    5) In the current version, if your platform can't represent
- *       int32_t, int16_t and int8_t, it just dumps out with a compiler
- *       error.
- *
- *    6) 64 bit integers may or may not be defined.  Test for their
- *       presence with the test: #ifdef INT64_MAX or #ifdef UINT64_MAX.
- *       Note that this is different from the C99 specification which
- *       requires the existence of 64 bit support in the compiler.  If
- *       this is not defined for your platform, yet it is capable of
- *       dealing with 64 bits then it is because this file has not yet
- *       been extended to cover all of your system's capabilities.
- *
- *    7) (u)intptr_t may or may not be defined.  Test for its presence
- *       with the test: #ifdef PTRDIFF_MAX.  If this is not defined
- *       for your platform, then it is because this file has not yet
- *       been extended to cover all of your system's capabilities, not
- *       because its optional.
- *
- *    8) The following might not been defined even if your platform is
- *       capable of defining it:
- *
- *       WCHAR_MIN
- *       WCHAR_MAX
- *       (u)int64_t
- *       PTRDIFF_MIN
- *       PTRDIFF_MAX
- *       (u)intptr_t
- *
- *    9) The following have not been defined:
- *
- *       WINT_MIN
- *       WINT_MAX
- *
- *   10) The criteria for defining (u)int_least(*)_t isn't clear,
- *       except for systems which don't have a type that precisely
- *       defined 8, 16, or 32 bit types (which this include file does
- *       not support anyways). Default definitions have been given.
- *
- *   11) The criteria for defining (u)int_fast(*)_t isn't something I
- *       would trust to any particular compiler vendor or the ANSI C
- *       committee.  It is well known that "compatible systems" are
- *       commonly created that have very different performance
- *       characteristics from the systems they are compatible with,
- *       especially those whose vendors make both the compiler and the
- *       system.  Default definitions have been given, but its strongly
- *       recommended that users never use these definitions for any
- *       reason (they do *NOT* deliver any serious guarantee of
- *       improved performance -- not in this file, nor any vendor's
- *       stdint.h).
- *
- *   12) The following macros:
- *
- *       PRINTF_INTMAX_MODIFIER
- *       PRINTF_INT64_MODIFIER
- *       PRINTF_INT32_MODIFIER
- *       PRINTF_INT16_MODIFIER
- *       PRINTF_LEAST64_MODIFIER
- *       PRINTF_LEAST32_MODIFIER
- *       PRINTF_LEAST16_MODIFIER
- *       PRINTF_INTPTR_MODIFIER
- *
- *       are strings which have been defined as the modifiers required
- *       for the "d", "u" and "x" printf formats to correctly output
- *       (u)intmax_t, (u)int64_t, (u)int32_t, (u)int16_t, (u)least64_t,
- *       (u)least32_t, (u)least16_t and (u)intptr_t types respectively.
- *       PRINTF_INTPTR_MODIFIER is not defined for some systems which
- *       provide their own stdint.h.  PRINTF_INT64_MODIFIER is not
- *       defined if INT64_MAX is not defined.  These are an extension
- *       beyond what C99 specifies must be in stdint.h.
- *
- *       In addition, the following macros are defined:
- *
- *       PRINTF_INTMAX_HEX_WIDTH
- *       PRINTF_INT64_HEX_WIDTH
- *       PRINTF_INT32_HEX_WIDTH
- *       PRINTF_INT16_HEX_WIDTH
- *       PRINTF_INT8_HEX_WIDTH
- *       PRINTF_INTMAX_DEC_WIDTH
- *       PRINTF_INT64_DEC_WIDTH
- *       PRINTF_INT32_DEC_WIDTH
- *       PRINTF_INT16_DEC_WIDTH
- *       PRINTF_UINT8_DEC_WIDTH
- *       PRINTF_UINTMAX_DEC_WIDTH
- *       PRINTF_UINT64_DEC_WIDTH
- *       PRINTF_UINT32_DEC_WIDTH
- *       PRINTF_UINT16_DEC_WIDTH
- *       PRINTF_UINT8_DEC_WIDTH
- *
- *       Which specifies the maximum number of characters required to
- *       print the number of that type in either hexadecimal or decimal.
- *       These are an extension beyond what C99 specifies must be in
- *       stdint.h.
- *
- *  Compilers tested (all with 0 warnings at their highest respective
- *  settings): Borland Turbo C 2.0, WATCOM C/C++ 11.0 (16 bits and 32
- *  bits), Microsoft Visual C++ 6.0 (32 bit), Microsoft Visual Studio
- *  .net (VC7), Intel C++ 4.0, GNU gcc v3.3.3
- *
- *  This file should be considered a work in progress.  Suggestions for
- *  improvements, especially those which increase coverage are strongly
- *  encouraged.
- *
- *  Acknowledgements
- *
- *  The following people have made significant contributions to the
- *  development and testing of this file:
- *
- *  Chris Howie
- *  John Steele Scott
- *  Dave Thorup
- *  John Dill
- *  Florian Wobbe
- *  Christopher Sean Morrison
- *  Mikkel Fahnoe Jorgensen
- *
- */
-
-#include <stddef.h>
-#include <limits.h>
-#include <signal.h>
-
-/*
- *  For gcc with _STDINT_H, fill in the PRINTF_INT*_MODIFIER macros, and
- *  do nothing else.  On the Mac OS X version of gcc this is _STDINT_H_.
- */
-
-#if ((defined(__SUNPRO_C) && __SUNPRO_C >= 0x570) || (defined(_MSC_VER) && _MSC_VER >= 1600) || (defined(__STDC__) && __STDC__ && defined(__STDC_VERSION__) && __STDC_VERSION__ >= 199901L) || (defined (__WATCOMC__) && (defined (_STDINT_H_INCLUDED) || __WATCOMC__ >= 1250)) || (defined(__GNUC__) && (__GNUC__ > 3 || defined(_STDINT_H) || defined(_STDINT_H_) || defined (__UINT_FAST64_TYPE__)) )) && !defined (_PSTDINT_H_INCLUDED)
-#include <stdint.h>
-#define _PSTDINT_H_INCLUDED
-# if defined(__GNUC__) && (defined(__x86_64__) || defined(__ppc64__)) && !(defined(__APPLE__) && defined(__MACH__))
-#  ifndef PRINTF_INT64_MODIFIER
-#   define PRINTF_INT64_MODIFIER "l"
-#  endif
-#  ifndef PRINTF_INT32_MODIFIER
-#   define PRINTF_INT32_MODIFIER ""
-#  endif
-# else
-#  ifndef PRINTF_INT64_MODIFIER
-#   define PRINTF_INT64_MODIFIER "ll"
-#  endif
-#  ifndef PRINTF_INT32_MODIFIER
-#   if (UINT_MAX == UINT32_MAX)
-#    define PRINTF_INT32_MODIFIER ""
-#   else
-#    define PRINTF_INT32_MODIFIER "l"
-#   endif
-#  endif
-# endif
-# ifndef PRINTF_INT16_MODIFIER
-#  define PRINTF_INT16_MODIFIER "h"
-# endif
-# ifndef PRINTF_INTMAX_MODIFIER
-#  define PRINTF_INTMAX_MODIFIER PRINTF_INT64_MODIFIER
-# endif
-# ifndef PRINTF_INT64_HEX_WIDTH
-#  define PRINTF_INT64_HEX_WIDTH "16"
-# endif
-# ifndef PRINTF_UINT64_HEX_WIDTH
-#  define PRINTF_UINT64_HEX_WIDTH "16"
-# endif
-# ifndef PRINTF_INT32_HEX_WIDTH
-#  define PRINTF_INT32_HEX_WIDTH "8"
-# endif
-# ifndef PRINTF_UINT32_HEX_WIDTH
-#  define PRINTF_UINT32_HEX_WIDTH "8"
-# endif
-# ifndef PRINTF_INT16_HEX_WIDTH
-#  define PRINTF_INT16_HEX_WIDTH "4"
-# endif
-# ifndef PRINTF_UINT16_HEX_WIDTH
-#  define PRINTF_UINT16_HEX_WIDTH "4"
-# endif
-# ifndef PRINTF_INT8_HEX_WIDTH
-#  define PRINTF_INT8_HEX_WIDTH "2"
-# endif
-# ifndef PRINTF_UINT8_HEX_WIDTH
-#  define PRINTF_UINT8_HEX_WIDTH "2"
-# endif
-# ifndef PRINTF_INT64_DEC_WIDTH
-#  define PRINTF_INT64_DEC_WIDTH "19"
-# endif
-# ifndef PRINTF_UINT64_DEC_WIDTH
-#  define PRINTF_UINT64_DEC_WIDTH "20"
-# endif
-# ifndef PRINTF_INT32_DEC_WIDTH
-#  define PRINTF_INT32_DEC_WIDTH "10"
-# endif
-# ifndef PRINTF_UINT32_DEC_WIDTH
-#  define PRINTF_UINT32_DEC_WIDTH "10"
-# endif
-# ifndef PRINTF_INT16_DEC_WIDTH
-#  define PRINTF_INT16_DEC_WIDTH "5"
-# endif
-# ifndef PRINTF_UINT16_DEC_WIDTH
-#  define PRINTF_UINT16_DEC_WIDTH "5"
-# endif
-# ifndef PRINTF_INT8_DEC_WIDTH
-#  define PRINTF_INT8_DEC_WIDTH "3"
-# endif
-# ifndef PRINTF_UINT8_DEC_WIDTH
-#  define PRINTF_UINT8_DEC_WIDTH "3"
-# endif
-# ifndef PRINTF_INTMAX_HEX_WIDTH
-#  define PRINTF_INTMAX_HEX_WIDTH PRINTF_UINT64_HEX_WIDTH
-# endif
-# ifndef PRINTF_UINTMAX_HEX_WIDTH
-#  define PRINTF_UINTMAX_HEX_WIDTH PRINTF_UINT64_HEX_WIDTH
-# endif
-# ifndef PRINTF_INTMAX_DEC_WIDTH
-#  define PRINTF_INTMAX_DEC_WIDTH PRINTF_UINT64_DEC_WIDTH
-# endif
-# ifndef PRINTF_UINTMAX_DEC_WIDTH
-#  define PRINTF_UINTMAX_DEC_WIDTH PRINTF_UINT64_DEC_WIDTH
-# endif
-
-/*
- *  Something really weird is going on with Open Watcom.  Just pull some of
- *  these duplicated definitions from Open Watcom's stdint.h file for now.
- */
-
-# if defined (__WATCOMC__) && __WATCOMC__ >= 1250
-#  if !defined (INT64_C)
-#   define INT64_C(x)   (x + (INT64_MAX - INT64_MAX))
-#  endif
-#  if !defined (UINT64_C)
-#   define UINT64_C(x)  (x + (UINT64_MAX - UINT64_MAX))
-#  endif
-#  if !defined (INT32_C)
-#   define INT32_C(x)   (x + (INT32_MAX - INT32_MAX))
-#  endif
-#  if !defined (UINT32_C)
-#   define UINT32_C(x)  (x + (UINT32_MAX - UINT32_MAX))
-#  endif
-#  if !defined (INT16_C)
-#   define INT16_C(x)   (x)
-#  endif
-#  if !defined (UINT16_C)
-#   define UINT16_C(x)  (x)
-#  endif
-#  if !defined (INT8_C)
-#   define INT8_C(x)   (x)
-#  endif
-#  if !defined (UINT8_C)
-#   define UINT8_C(x)  (x)
-#  endif
-#  if !defined (UINT64_MAX)
-#   define UINT64_MAX  18446744073709551615ULL
-#  endif
-#  if !defined (INT64_MAX)
-#   define INT64_MAX  9223372036854775807LL
-#  endif
-#  if !defined (UINT32_MAX)
-#   define UINT32_MAX  4294967295UL
-#  endif
-#  if !defined (INT32_MAX)
-#   define INT32_MAX  2147483647L
-#  endif
-#  if !defined (INTMAX_MAX)
-#   define INTMAX_MAX INT64_MAX
-#  endif
-#  if !defined (INTMAX_MIN)
-#   define INTMAX_MIN INT64_MIN
-#  endif
-# endif
-#endif
-
-/*
- *  I have no idea what is the truly correct thing to do on older Solaris.
- *  From some online discussions, this seems to be what is being
- *  recommended.  For people who actually are developing on older Solaris,
- *  what I would like to know is, does this define all of the relevant
- *  macros of a complete stdint.h?  Remember, in pstdint.h 64 bit is
- *  considered optional.
- */
-
-#if (defined(__SUNPRO_C) && __SUNPRO_C >= 0x420) && !defined(_PSTDINT_H_INCLUDED)
-#include <sys/inttypes.h>
-#define _PSTDINT_H_INCLUDED
-#endif
-
-#ifndef _PSTDINT_H_INCLUDED
-#define _PSTDINT_H_INCLUDED
-
-#ifndef SIZE_MAX
-# define SIZE_MAX ((size_t)-1)
-#endif
-
-/*
- *  Deduce the type assignments from limits.h under the assumption that
- *  integer sizes in bits are powers of 2, and follow the ANSI
- *  definitions.
- */
-
-#ifndef UINT8_MAX
-# define UINT8_MAX 0xff
-#endif
-#if !defined(uint8_t) && !defined(_UINT8_T) && !defined(vxWorks)
-# if (UCHAR_MAX == UINT8_MAX) || defined (S_SPLINT_S)
-    typedef unsigned char uint8_t;
-#   define UINT8_C(v) ((uint8_t) v)
-# else
-#   error "Platform not supported"
-# endif
-#endif
-
-#ifndef INT8_MAX
-# define INT8_MAX 0x7f
-#endif
-#ifndef INT8_MIN
-# define INT8_MIN INT8_C(0x80)
-#endif
-#if !defined(int8_t) && !defined(_INT8_T) && !defined(vxWorks)
-# if (SCHAR_MAX == INT8_MAX) || defined (S_SPLINT_S)
-    typedef signed char int8_t;
-#   define INT8_C(v) ((int8_t) v)
-# else
-#   error "Platform not supported"
-# endif
-#endif
-
-#ifndef UINT16_MAX
-# define UINT16_MAX 0xffff
-#endif
-#if !defined(uint16_t) && !defined(_UINT16_T) && !defined(vxWorks)
-#if (UINT_MAX == UINT16_MAX) || defined (S_SPLINT_S)
-  typedef unsigned int uint16_t;
-# ifndef PRINTF_INT16_MODIFIER
-#  define PRINTF_INT16_MODIFIER ""
-# endif
-# define UINT16_C(v) ((uint16_t) (v))
-#elif (USHRT_MAX == UINT16_MAX)
-  typedef unsigned short uint16_t;
-# define UINT16_C(v) ((uint16_t) (v))
-# ifndef PRINTF_INT16_MODIFIER
-#  define PRINTF_INT16_MODIFIER "h"
-# endif
-#else
-#error "Platform not supported"
-#endif
-#endif
-
-#ifndef INT16_MAX
-# define INT16_MAX 0x7fff
-#endif
-#ifndef INT16_MIN
-# define INT16_MIN INT16_C(0x8000)
-#endif
-#if !defined(int16_t) && !defined(_INT16_T) && !defined(vxWorks)
-#if (INT_MAX == INT16_MAX) || defined (S_SPLINT_S)
-  typedef signed int int16_t;
-# define INT16_C(v) ((int16_t) (v))
-# ifndef PRINTF_INT16_MODIFIER
-#  define PRINTF_INT16_MODIFIER ""
-# endif
-#elif (SHRT_MAX == INT16_MAX)
-  typedef signed short int16_t;
-# define INT16_C(v) ((int16_t) (v))
-# ifndef PRINTF_INT16_MODIFIER
-#  define PRINTF_INT16_MODIFIER "h"
-# endif
-#else
-#error "Platform not supported"
-#endif
-#endif
-
-#ifndef UINT32_MAX
-# define UINT32_MAX (0xffffffffUL)
-#endif
-#if !defined(uint32_t) && !defined(_UINT32_T) && !defined(vxWorks)
-#if (ULONG_MAX == UINT32_MAX) || defined (S_SPLINT_S)
-  typedef unsigned long uint32_t;
-# define UINT32_C(v) v ## UL
-# ifndef PRINTF_INT32_MODIFIER
-#  define PRINTF_INT32_MODIFIER "l"
-# endif
-#elif (UINT_MAX == UINT32_MAX)
-  typedef unsigned int uint32_t;
-# ifndef PRINTF_INT32_MODIFIER
-#  define PRINTF_INT32_MODIFIER ""
-# endif
-# define UINT32_C(v) v ## U
-#elif (USHRT_MAX == UINT32_MAX)
-  typedef unsigned short uint32_t;
-# define UINT32_C(v) ((unsigned short) (v))
-# ifndef PRINTF_INT32_MODIFIER
-#  define PRINTF_INT32_MODIFIER ""
-# endif
-#else
-#error "Platform not supported"
-#endif
-#endif
-
-#ifndef INT32_MAX
-# define INT32_MAX (0x7fffffffL)
-#endif
-#ifndef INT32_MIN
-# define INT32_MIN INT32_C(0x80000000)
-#endif
-#if !defined(int32_t) && !defined(_INT32_T) && !defined(vxWorks)
-#if (LONG_MAX == INT32_MAX) || defined (S_SPLINT_S)
-  typedef signed long int32_t;
-# define INT32_C(v) v ## L
-# ifndef PRINTF_INT32_MODIFIER
-#  define PRINTF_INT32_MODIFIER "l"
-# endif
-#elif (INT_MAX == INT32_MAX)
-  typedef signed int int32_t;
-# define INT32_C(v) v
-# ifndef PRINTF_INT32_MODIFIER
-#  define PRINTF_INT32_MODIFIER ""
-# endif
-#elif (SHRT_MAX == INT32_MAX)
-  typedef signed short int32_t;
-# define INT32_C(v) ((short) (v))
-# ifndef PRINTF_INT32_MODIFIER
-#  define PRINTF_INT32_MODIFIER ""
-# endif
-#else
-#error "Platform not supported"
-#endif
-#endif
-
-/*
- *  The macro stdint_int64_defined is temporarily used to record
- *  whether or not 64 integer support is available.  It must be
- *  defined for any 64 integer extensions for new platforms that are
- *  added.
- */
-
-#undef stdint_int64_defined
-#if (defined(__STDC__) && defined(__STDC_VERSION__)) || defined (S_SPLINT_S)
-# if (__STDC__ && __STDC_VERSION__ >= 199901L) || defined (S_SPLINT_S)
-#  define stdint_int64_defined
-   typedef long long int64_t;
-   typedef unsigned long long uint64_t;
-#  define UINT64_C(v) v ## ULL
-#  define  INT64_C(v) v ## LL
-#  ifndef PRINTF_INT64_MODIFIER
-#   define PRINTF_INT64_MODIFIER "ll"
-#  endif
-# endif
-#endif
-
-#if !defined (stdint_int64_defined)
-# if defined(__GNUC__) && !defined(vxWorks)
-#  define stdint_int64_defined
-   __extension__ typedef long long int64_t;
-   __extension__ typedef unsigned long long uint64_t;
-#  define UINT64_C(v) v ## ULL
-#  define  INT64_C(v) v ## LL
-#  ifndef PRINTF_INT64_MODIFIER
-#   define PRINTF_INT64_MODIFIER "ll"
-#  endif
-# elif defined(__MWERKS__) || defined (__SUNPRO_C) || defined (__SUNPRO_CC) || defined (__APPLE_CC__) || defined (_LONG_LONG) || defined (_CRAYC) || defined (S_SPLINT_S)
-#  define stdint_int64_defined
-   typedef long long int64_t;
-   typedef unsigned long long uint64_t;
-#  define UINT64_C(v) v ## ULL
-#  define  INT64_C(v) v ## LL
-#  ifndef PRINTF_INT64_MODIFIER
-#   define PRINTF_INT64_MODIFIER "ll"
-#  endif
-# elif (defined(__WATCOMC__) && defined(__WATCOM_INT64__)) || (defined(_MSC_VER) && _INTEGRAL_MAX_BITS >= 64) || (defined (__BORLANDC__) && __BORLANDC__ > 0x460) || defined (__alpha) || defined (__DECC)
-#  define stdint_int64_defined
-   typedef __int64 int64_t;
-   typedef unsigned __int64 uint64_t;
-#  define UINT64_C(v) v ## UI64
-#  define  INT64_C(v) v ## I64
-#  ifndef PRINTF_INT64_MODIFIER
-#   define PRINTF_INT64_MODIFIER "I64"
-#  endif
-# endif
-#endif
-
-#if !defined (LONG_LONG_MAX) && defined (INT64_C)
-# define LONG_LONG_MAX INT64_C (9223372036854775807)
-#endif
-#ifndef ULONG_LONG_MAX
-# define ULONG_LONG_MAX UINT64_C (18446744073709551615)
-#endif
-
-#if !defined (INT64_MAX) && defined (INT64_C)
-# define INT64_MAX INT64_C (9223372036854775807)
-#endif
-#if !defined (INT64_MIN) && defined (INT64_C)
-# define INT64_MIN INT64_C (-9223372036854775808)
-#endif
-#if !defined (UINT64_MAX) && defined (INT64_C)
-# define UINT64_MAX UINT64_C (18446744073709551615)
-#endif
-
-/*
- *  Width of hexadecimal for number field.
- */
-
-#ifndef PRINTF_INT64_HEX_WIDTH
-# define PRINTF_INT64_HEX_WIDTH "16"
-#endif
-#ifndef PRINTF_INT32_HEX_WIDTH
-# define PRINTF_INT32_HEX_WIDTH "8"
-#endif
-#ifndef PRINTF_INT16_HEX_WIDTH
-# define PRINTF_INT16_HEX_WIDTH "4"
-#endif
-#ifndef PRINTF_INT8_HEX_WIDTH
-# define PRINTF_INT8_HEX_WIDTH "2"
-#endif
-#ifndef PRINTF_INT64_DEC_WIDTH
-# define PRINTF_INT64_DEC_WIDTH "19"
-#endif
-#ifndef PRINTF_INT32_DEC_WIDTH
-# define PRINTF_INT32_DEC_WIDTH "10"
-#endif
-#ifndef PRINTF_INT16_DEC_WIDTH
-# define PRINTF_INT16_DEC_WIDTH "5"
-#endif
-#ifndef PRINTF_INT8_DEC_WIDTH
-# define PRINTF_INT8_DEC_WIDTH "3"
-#endif
-#ifndef PRINTF_UINT64_DEC_WIDTH
-# define PRINTF_UINT64_DEC_WIDTH "20"
-#endif
-#ifndef PRINTF_UINT32_DEC_WIDTH
-# define PRINTF_UINT32_DEC_WIDTH "10"
-#endif
-#ifndef PRINTF_UINT16_DEC_WIDTH
-# define PRINTF_UINT16_DEC_WIDTH "5"
-#endif
-#ifndef PRINTF_UINT8_DEC_WIDTH
-# define PRINTF_UINT8_DEC_WIDTH "3"
-#endif
-
-/*
- *  Ok, lets not worry about 128 bit integers for now.  Moore's law says
- *  we don't need to worry about that until about 2040 at which point
- *  we'll have bigger things to worry about.
- */
-
-#ifdef stdint_int64_defined
-  typedef int64_t intmax_t;
-  typedef uint64_t uintmax_t;
-# define  INTMAX_MAX   INT64_MAX
-# define  INTMAX_MIN   INT64_MIN
-# define UINTMAX_MAX  UINT64_MAX
-# define UINTMAX_C(v) UINT64_C(v)
-# define  INTMAX_C(v)  INT64_C(v)
-# ifndef PRINTF_INTMAX_MODIFIER
-#   define PRINTF_INTMAX_MODIFIER PRINTF_INT64_MODIFIER
-# endif
-# ifndef PRINTF_INTMAX_HEX_WIDTH
-#  define PRINTF_INTMAX_HEX_WIDTH PRINTF_INT64_HEX_WIDTH
-# endif
-# ifndef PRINTF_INTMAX_DEC_WIDTH
-#  define PRINTF_INTMAX_DEC_WIDTH PRINTF_INT64_DEC_WIDTH
-# endif
-#else
-  typedef int32_t intmax_t;
-  typedef uint32_t uintmax_t;
-# define  INTMAX_MAX   INT32_MAX
-# define UINTMAX_MAX  UINT32_MAX
-# define UINTMAX_C(v) UINT32_C(v)
-# define  INTMAX_C(v)  INT32_C(v)
-# ifndef PRINTF_INTMAX_MODIFIER
-#   define PRINTF_INTMAX_MODIFIER PRINTF_INT32_MODIFIER
-# endif
-# ifndef PRINTF_INTMAX_HEX_WIDTH
-#  define PRINTF_INTMAX_HEX_WIDTH PRINTF_INT32_HEX_WIDTH
-# endif
-# ifndef PRINTF_INTMAX_DEC_WIDTH
-#  define PRINTF_INTMAX_DEC_WIDTH PRINTF_INT32_DEC_WIDTH
-# endif
-#endif
-
-/*
- *  Because this file currently only supports platforms which have
- *  precise powers of 2 as bit sizes for the default integers, the
- *  least definitions are all trivial.  Its possible that a future
- *  version of this file could have different definitions.
- */
-
-#ifndef stdint_least_defined
-  typedef   int8_t   int_least8_t;
-  typedef  uint8_t  uint_least8_t;
-  typedef  int16_t  int_least16_t;
-  typedef uint16_t uint_least16_t;
-  typedef  int32_t  int_least32_t;
-  typedef uint32_t uint_least32_t;
-# define PRINTF_LEAST32_MODIFIER PRINTF_INT32_MODIFIER
-# define PRINTF_LEAST16_MODIFIER PRINTF_INT16_MODIFIER
-# define  UINT_LEAST8_MAX  UINT8_MAX
-# define   INT_LEAST8_MAX   INT8_MAX
-# define UINT_LEAST16_MAX UINT16_MAX
-# define  INT_LEAST16_MAX  INT16_MAX
-# define UINT_LEAST32_MAX UINT32_MAX
-# define  INT_LEAST32_MAX  INT32_MAX
-# define   INT_LEAST8_MIN   INT8_MIN
-# define  INT_LEAST16_MIN  INT16_MIN
-# define  INT_LEAST32_MIN  INT32_MIN
-# ifdef stdint_int64_defined
-    typedef  int64_t  int_least64_t;
-    typedef uint64_t uint_least64_t;
-#   define PRINTF_LEAST64_MODIFIER PRINTF_INT64_MODIFIER
-#   define UINT_LEAST64_MAX UINT64_MAX
-#   define  INT_LEAST64_MAX  INT64_MAX
-#   define  INT_LEAST64_MIN  INT64_MIN
-# endif
-#endif
-#undef stdint_least_defined
-
-/*
- *  The ANSI C committee has defined *int*_fast*_t types as well.  This,
- *  of course, defies rationality -- you can't know what will be fast
- *  just from the type itself.  Even for a given architecture, compatible
- *  implementations might have different performance characteristics.
- *  Developers are warned to stay away from these types when using this
- *  or any other stdint.h.
- */
-
-typedef   int_least8_t   int_fast8_t;
-typedef  uint_least8_t  uint_fast8_t;
-typedef  int_least16_t  int_fast16_t;
-typedef uint_least16_t uint_fast16_t;
-typedef  int_least32_t  int_fast32_t;
-typedef uint_least32_t uint_fast32_t;
-#define  UINT_FAST8_MAX  UINT_LEAST8_MAX
-#define   INT_FAST8_MAX   INT_LEAST8_MAX
-#define UINT_FAST16_MAX UINT_LEAST16_MAX
-#define  INT_FAST16_MAX  INT_LEAST16_MAX
-#define UINT_FAST32_MAX UINT_LEAST32_MAX
-#define  INT_FAST32_MAX  INT_LEAST32_MAX
-#define   INT_FAST8_MIN   INT_LEAST8_MIN
-#define  INT_FAST16_MIN  INT_LEAST16_MIN
-#define  INT_FAST32_MIN  INT_LEAST32_MIN
-#ifdef stdint_int64_defined
-  typedef  int_least64_t  int_fast64_t;
-  typedef uint_least64_t uint_fast64_t;
-# define UINT_FAST64_MAX UINT_LEAST64_MAX
-# define  INT_FAST64_MAX  INT_LEAST64_MAX
-# define  INT_FAST64_MIN  INT_LEAST64_MIN
-#endif
-
-#undef stdint_int64_defined
-
-/*
- *  Whatever piecemeal, per compiler thing we can do about the wchar_t
- *  type limits.
- */
-
-#if defined(__WATCOMC__) || defined(_MSC_VER) || defined (__GNUC__) && !defined(vxWorks)
-# include <wchar.h>
-# ifndef WCHAR_MIN
-#  define WCHAR_MIN 0
-# endif
-# ifndef WCHAR_MAX
-#  define WCHAR_MAX ((wchar_t)-1)
-# endif
-#endif
-
-/*
- *  Whatever piecemeal, per compiler/platform thing we can do about the
- *  (u)intptr_t types and limits.
- */
-
-#if (defined (_MSC_VER) && defined (_UINTPTR_T_DEFINED)) || defined (_UINTPTR_T)
-# define STDINT_H_UINTPTR_T_DEFINED
-#endif
-
-#ifndef STDINT_H_UINTPTR_T_DEFINED
-# if defined (__alpha__) || defined (__ia64__) || defined (__x86_64__) || defined (_WIN64) || defined (__ppc64__)
-#  define stdint_intptr_bits 64
-# elif defined (__WATCOMC__) || defined (__TURBOC__)
-#  if defined(__TINY__) || defined(__SMALL__) || defined(__MEDIUM__)
-#    define stdint_intptr_bits 16
-#  else
-#    define stdint_intptr_bits 32
-#  endif
-# elif defined (__i386__) || defined (_WIN32) || defined (WIN32) || defined (__ppc64__)
-#  define stdint_intptr_bits 32
-# elif defined (__INTEL_COMPILER)
-/* TODO -- what did Intel do about x86-64? */
-# else
-/* #error "This platform might not be supported yet" */
-# endif
-
-# ifdef stdint_intptr_bits
-#  define stdint_intptr_glue3_i(a,b,c)  a##b##c
-#  define stdint_intptr_glue3(a,b,c)    stdint_intptr_glue3_i(a,b,c)
-#  ifndef PRINTF_INTPTR_MODIFIER
-#    define PRINTF_INTPTR_MODIFIER      stdint_intptr_glue3(PRINTF_INT,stdint_intptr_bits,_MODIFIER)
-#  endif
-#  ifndef PTRDIFF_MAX
-#    define PTRDIFF_MAX                 stdint_intptr_glue3(INT,stdint_intptr_bits,_MAX)
-#  endif
-#  ifndef PTRDIFF_MIN
-#    define PTRDIFF_MIN                 stdint_intptr_glue3(INT,stdint_intptr_bits,_MIN)
-#  endif
-#  ifndef UINTPTR_MAX
-#    define UINTPTR_MAX                 stdint_intptr_glue3(UINT,stdint_intptr_bits,_MAX)
-#  endif
-#  ifndef INTPTR_MAX
-#    define INTPTR_MAX                  stdint_intptr_glue3(INT,stdint_intptr_bits,_MAX)
-#  endif
-#  ifndef INTPTR_MIN
-#    define INTPTR_MIN                  stdint_intptr_glue3(INT,stdint_intptr_bits,_MIN)
-#  endif
-#  ifndef INTPTR_C
-#    define INTPTR_C(x)                 stdint_intptr_glue3(INT,stdint_intptr_bits,_C)(x)
-#  endif
-#  ifndef UINTPTR_C
-#    define UINTPTR_C(x)                stdint_intptr_glue3(UINT,stdint_intptr_bits,_C)(x)
-#  endif
-  typedef stdint_intptr_glue3(uint,stdint_intptr_bits,_t) uintptr_t;
-  typedef stdint_intptr_glue3( int,stdint_intptr_bits,_t)  intptr_t;
-# else
-/* TODO -- This following is likely wrong for some platforms, and does
-   nothing for the definition of uintptr_t. */
-  typedef ptrdiff_t intptr_t;
-# endif
-# define STDINT_H_UINTPTR_T_DEFINED
-#endif
-
-/*
- *  Assumes sig_atomic_t is signed and we have a 2s complement machine.
- */
-
-#ifndef SIG_ATOMIC_MAX
-# define SIG_ATOMIC_MAX ((((sig_atomic_t) 1) << (sizeof (sig_atomic_t)*CHAR_BIT-1)) - 1)
-#endif
-
-#endif
-
-#if defined (__TEST_PSTDINT_FOR_CORRECTNESS)
-
-/*
- *  Please compile with the maximum warning settings to make sure macros are
- *  not defined more than once.
- */
-
-#include <stdlib.h>
-#include <stdio.h>
-#include <string.h>
-
-#define glue3_aux(x,y,z) x ## y ## z
-#define glue3(x,y,z) glue3_aux(x,y,z)
-
-#define DECLU(bits) glue3(uint,bits,_t) glue3(u,bits,) = glue3(UINT,bits,_C) (0);
-#define DECLI(bits) glue3(int,bits,_t) glue3(i,bits,) = glue3(INT,bits,_C) (0);
-
-#define DECL(us,bits) glue3(DECL,us,) (bits)
-
-#define TESTUMAX(bits) glue3(u,bits,) = ~glue3(u,bits,); if (glue3(UINT,bits,_MAX) != glue3(u,bits,)) printf ("Something wrong with UINT%d_MAX\n", bits)
-
-#define REPORTERROR(msg) { err_n++; if (err_first <= 0) err_first = __LINE__; printf msg; }
-
-#define X_SIZE_MAX ((size_t)-1)
-
-int main () {
-	int err_n = 0;
-	int err_first = 0;
-	DECL(I,8)
-	DECL(U,8)
-	DECL(I,16)
-	DECL(U,16)
-	DECL(I,32)
-	DECL(U,32)
-#ifdef INT64_MAX
-	DECL(I,64)
-	DECL(U,64)
-#endif
-	intmax_t imax = INTMAX_C(0);
-	uintmax_t umax = UINTMAX_C(0);
-	char str0[256], str1[256];
-
-	sprintf (str0, "%" PRINTF_INT32_MODIFIER "d", INT32_C(2147483647));
-	if (0 != strcmp (str0, "2147483647")) REPORTERROR (("Something wrong with PRINTF_INT32_MODIFIER : %s\n", str0));
-	if (atoi(PRINTF_INT32_DEC_WIDTH) != (int) strlen(str0)) REPORTERROR (("Something wrong with PRINTF_INT32_DEC_WIDTH : %s\n", PRINTF_INT32_DEC_WIDTH));
-	sprintf (str0, "%" PRINTF_INT32_MODIFIER "u", UINT32_C(4294967295));
-	if (0 != strcmp (str0, "4294967295")) REPORTERROR (("Something wrong with PRINTF_INT32_MODIFIER : %s\n", str0));
-	if (atoi(PRINTF_UINT32_DEC_WIDTH) != (int) strlen(str0)) REPORTERROR (("Something wrong with PRINTF_UINT32_DEC_WIDTH : %s\n", PRINTF_UINT32_DEC_WIDTH));
-#ifdef INT64_MAX
-	sprintf (str1, "%" PRINTF_INT64_MODIFIER "d", INT64_C(9223372036854775807));
-	if (0 != strcmp (str1, "9223372036854775807")) REPORTERROR (("Something wrong with PRINTF_INT32_MODIFIER : %s\n", str1));
-	if (atoi(PRINTF_INT64_DEC_WIDTH) != (int) strlen(str1)) REPORTERROR (("Something wrong with PRINTF_INT64_DEC_WIDTH : %s, %d\n", PRINTF_INT64_DEC_WIDTH, (int) strlen(str1)));
-	sprintf (str1, "%" PRINTF_INT64_MODIFIER "u", UINT64_C(18446744073709550591));
-	if (0 != strcmp (str1, "18446744073709550591")) REPORTERROR (("Something wrong with PRINTF_INT32_MODIFIER : %s\n", str1));
-	if (atoi(PRINTF_UINT64_DEC_WIDTH) != (int) strlen(str1)) REPORTERROR (("Something wrong with PRINTF_UINT64_DEC_WIDTH : %s, %d\n", PRINTF_UINT64_DEC_WIDTH, (int) strlen(str1)));
-#endif
-
-	sprintf (str0, "%d %x\n", 0, ~0);
-
-	sprintf (str1, "%d %x\n",  i8, ~0);
-	if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with i8 : %s\n", str1));
-	sprintf (str1, "%u %x\n",  u8, ~0);
-	if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with u8 : %s\n", str1));
-	sprintf (str1, "%d %x\n",  i16, ~0);
-	if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with i16 : %s\n", str1));
-	sprintf (str1, "%u %x\n",  u16, ~0);
-	if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with u16 : %s\n", str1));
-	sprintf (str1, "%" PRINTF_INT32_MODIFIER "d %x\n",  i32, ~0);
-	if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with i32 : %s\n", str1));
-	sprintf (str1, "%" PRINTF_INT32_MODIFIER "u %x\n",  u32, ~0);
-	if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with u32 : %s\n", str1));
-#ifdef INT64_MAX
-	sprintf (str1, "%" PRINTF_INT64_MODIFIER "d %x\n",  i64, ~0);
-	if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with i64 : %s\n", str1));
-#endif
-	sprintf (str1, "%" PRINTF_INTMAX_MODIFIER "d %x\n",  imax, ~0);
-	if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with imax : %s\n", str1));
-	sprintf (str1, "%" PRINTF_INTMAX_MODIFIER "u %x\n",  umax, ~0);
-	if (0 != strcmp (str0, str1)) REPORTERROR (("Something wrong with umax : %s\n", str1));
-
-	TESTUMAX(8);
-	TESTUMAX(16);
-	TESTUMAX(32);
-#ifdef INT64_MAX
-	TESTUMAX(64);
-#endif
-
-#define STR(v) #v
-#define Q(v) printf ("sizeof " STR(v) " = %u\n", (unsigned) sizeof (v));
-	if (err_n) {
-		printf ("pstdint.h is not correct.  Please use sizes below to correct it:\n");
-	}
-
-	Q(int)
-	Q(unsigned)
-	Q(long int)
-	Q(short int)
-	Q(int8_t)
-	Q(int16_t)
-	Q(int32_t)
-#ifdef INT64_MAX
-	Q(int64_t)
-#endif
-
-#if UINT_MAX < X_SIZE_MAX
-	printf ("UINT_MAX < X_SIZE_MAX\n");
-#else
-	printf ("UINT_MAX >= X_SIZE_MAX\n");
-#endif
-	printf ("%" PRINTF_INT64_MODIFIER "u vs %" PRINTF_INT64_MODIFIER "u\n", UINT_MAX, X_SIZE_MAX);
-
-	return EXIT_SUCCESS;
-}
-
-#endif

compat/stdlib.h

@@ -1,39 +0,0 @@
-/*
- * stdlib.h --
- *
- *	Declares facilities exported by the "stdlib" portion of the C library.
- *	This file isn't complete in the ANSI-C sense; it only declares things
- *	that are needed by Tcl. This file is needed even on many systems with
- *	their own stdlib.h (e.g. SunOS) because not all stdlib.h files declare
- *	all the procedures needed here (such as strtol/strtoul).
- *
- * Copyright (c) 1991 The Regents of the University of California.
- * Copyright (c) 1994-1998 Sun Microsystems, Inc.
- *
- * See the file "license.terms" for information on usage and redistribution of
- * this file, and for a DISCLAIMER OF ALL WARRANTIES.
- */
-
-#ifndef _STDLIB
-#define _STDLIB
-
-extern void		abort(void);
-extern double		atof(const char *string);
-extern int		atoi(const char *string);
-extern long		atol(const char *string);
-extern void *		calloc(unsigned long numElements, unsigned long size);
-extern void		exit(int status);
-extern void		free(void *blockPtr);
-extern char *		getenv(const char *name);
-extern void *		malloc(unsigned long numBytes);
-extern void		qsort(void *base, unsigned long n, unsigned long size, int (*compar)(
-			    const void *element1, const void *element2));
-extern void *		realloc(void *ptr, unsigned long numBytes);
-extern char *		realpath(const char *path, char *resolved_path);
-extern int		mkstemps(char *templ, int suffixlen);
-extern int		mkstemp(char *templ);
-extern char *		mkdtemp(char *templ);
-extern long		strtol(const char *string, char **endPtr, int base);
-extern unsigned long	strtoul(const char *string, char **endPtr, int base);
-
-#endif /* _STDLIB */

compat/strstr.c

@@ -1,70 +0,0 @@
-/*
- * strstr.c --
- *
- *	Source code for the "strstr" library routine.
- *
- * Copyright (c) 1988-1993 The Regents of the University of California.
- * Copyright (c) 1994 Sun Microsystems, Inc.
- *
- * See the file "license.terms" for information on usage and redistribution of
- * this file, and for a DISCLAIMER OF ALL WARRANTIES.
- */
-
-#include "tcl.h"
-#ifndef NULL
-#define NULL 0
-#endif
-
-/*
- *----------------------------------------------------------------------
- *
- * strstr --
- *
- *	Locate the first instance of a substring in a string.
- *
- * Results:
- *	If string contains substring, the return value is the location of the
- *	first matching instance of substring in string. If string doesn't
- *	contain substring, the return value is 0. Matching is done on an exact
- *	character-for-character basis with no wildcards or special characters.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-char *
-strstr(
-    const char *string,		/* String to search. */
-    const char *substring)		/* Substring to try to find in string. */
-{
-    const char *a, *b;
-
-    /*
-     * First scan quickly through the two strings looking for a
-     * single-character match. When it's found, then compare the rest of the
-     * substring.
-     */
-
-    b = substring;
-    if (*b == 0) {
-	return (char *)string;
-    }
-    for ( ; *string != 0; string += 1) {
-	if (*string != *b) {
-	    continue;
-	}
-	a = string;
-	while (1) {
-	    if (*b == 0) {
-		return (char *)string;
-	    }
-	    if (*a++ != *b++) {
-		break;
-	    }
-	}
-	b = substring;
-    }
-    return NULL;
-}

compat/strtol.c

@@ -1,77 +0,0 @@
-/*
- * strtol.c --
- *
- *	Source code for the "strtol" library procedure.
- *
- * Copyright (c) 1988 The Regents of the University of California.
- * Copyright (c) 1994 Sun Microsystems, Inc.
- *
- * See the file "license.terms" for information on usage and redistribution of
- * this file, and for a DISCLAIMER OF ALL WARRANTIES.
- */
-
-#include "tclInt.h"
-
-/*
- *----------------------------------------------------------------------
- *
- * strtol --
- *
- *	Convert an ASCII string into an integer.
- *
- * Results:
- *	The return value is the integer equivalent of string. If endPtr is
- *	non-NULL, then *endPtr is filled in with the character after the last
- *	one that was part of the integer. If string doesn't contain a valid
- *	integer value, then zero is returned and *endPtr is set to string.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-long int
-strtol(
-    const char *string,		/* String of ASCII digits, possibly preceded
-				 * by white space. For bases greater than 10,
-				 * either lower- or upper-case digits may be
-				 * used. */
-    char **endPtr,		/* Where to store address of terminating
-				 * character, or NULL. */
-    int base)			/* Base for conversion. Must be less than 37.
-				 * If 0, then the base is chosen from the
-				 * leading characters of string: "0x" means
-				 * hex, "0" means octal, anything else means
-				 * decimal. */
-{
-    const char *p;
-    long result;
-
-    /*
-     * Skip any leading blanks.
-     */
-
-    p = string;
-    while (isspace(UCHAR(*p))) {
-	p += 1;
-    }
-
-    /*
-     * Check for a sign.
-     */
-
-    if (*p == '-') {
-	p += 1;
-	result = -(strtoul(p, endPtr, base));
-    } else {
-	if (*p == '+') {
-	    p += 1;
-	}
-	result = strtoul(p, endPtr, base);
-    }
-    if ((result == 0) && (endPtr != 0) && (*endPtr == p)) {
-	*endPtr = (char *) string;
-    }
-    return result;
-}

compat/strtoul.c

@@ -1,214 +0,0 @@
-/*
- * strtoul.c --
- *
- *	Source code for the "strtoul" library procedure.
- *
- * Copyright (c) 1988 The Regents of the University of California.
- * Copyright (c) 1994 Sun Microsystems, Inc.
- *
- * See the file "license.terms" for information on usage and redistribution of
- * this file, and for a DISCLAIMER OF ALL WARRANTIES.
- */
-
-#include "tclInt.h"
-
-/*
- * The table below is used to convert from ASCII digits to a numerical
- * equivalent. It maps from '0' through 'z' to integers (100 for non-digit
- * characters).
- */
-
-static const char cvtIn[] = {
-    0, 1, 2, 3, 4, 5, 6, 7, 8, 9,		/* '0' - '9' */
-    100, 100, 100, 100, 100, 100, 100,		/* punctuation */
-    10, 11, 12, 13, 14, 15, 16, 17, 18, 19,	/* 'A' - 'Z' */
-    20, 21, 22, 23, 24, 25, 26, 27, 28, 29,
-    30, 31, 32, 33, 34, 35,
-    100, 100, 100, 100, 100, 100,		/* punctuation */
-    10, 11, 12, 13, 14, 15, 16, 17, 18, 19,	/* 'a' - 'z' */
-    20, 21, 22, 23, 24, 25, 26, 27, 28, 29,
-    30, 31, 32, 33, 34, 35};
-
-/*
- *----------------------------------------------------------------------
- *
- * strtoul --
- *
- *	Convert an ASCII string into an integer.
- *
- * Results:
- *	The return value is the integer equivalent of string. If endPtr is
- *	non-NULL, then *endPtr is filled in with the character after the last
- *	one that was part of the integer. If string doesn't contain a valid
- *	integer value, then zero is returned and *endPtr is set to string.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-unsigned long int
-strtoul(
-    const char *string,		/* String of ASCII digits, possibly preceded
-				 * by white space. For bases greater than 10,
-				 * either lower- or upper-case digits may be
-				 * used. */
-    char **endPtr,		/* Where to store address of terminating
-				 * character, or NULL. */
-    int base)			/* Base for conversion.  Must be less than 37.
-				 * If 0, then the base is chosen from the
-				 * leading characters of string: "0x" means
-				 * hex, "0" means octal, anything else means
-				 * decimal. */
-{
-    const char *p;
-    unsigned long int result = 0;
-    unsigned digit;
-    int anyDigits = 0;
-    int negative=0;
-    int overflow=0;
-
-    /*
-     * Skip any leading blanks.
-     */
-
-    p = string;
-    while (isspace(UCHAR(*p))) {
-	p += 1;
-    }
-    if (*p == '-') {
-        negative = 1;
-        p += 1;
-    } else {
-        if (*p == '+') {
-            p += 1;
-        }
-    }
-
-    /*
-     * If no base was provided, pick one from the leading characters of the
-     * string.
-     */
-
-    if (base == 0) {
-	if (*p == '0') {
-	    p += 1;
-	    if ((*p == 'x') || (*p == 'X')) {
-		p += 1;
-		base = 16;
-	    } else {
-		/*
-		 * Must set anyDigits here, otherwise "0" produces a "no
-		 * digits" error.
-		 */
-
-		anyDigits = 1;
-		base = 8;
-	    }
-	} else {
-	    base = 10;
-	}
-    } else if (base == 16) {
-	/*
-	 * Skip a leading "0x" from hex numbers.
-	 */
-
-	if ((p[0] == '0') && ((p[1] == 'x') || (p[1] == 'X'))) {
-	    p += 2;
-	}
-    }
-
-    /*
-     * Sorry this code is so messy, but speed seems important. Do different
-     * things for base 8, 10, 16, and other.
-     */
-
-    if (base == 8) {
-	unsigned long maxres = ULONG_MAX >> 3;
-
-	for ( ; ; p += 1) {
-	    digit = *p - '0';
-	    if (digit > 7) {
-		break;
-	    }
-	    if (result > maxres) { overflow = 1; }
-	    result = (result << 3);
-	    if (digit > (ULONG_MAX - result)) { overflow = 1; }
-	    result += digit;
-	    anyDigits = 1;
-	}
-    } else if (base == 10) {
-	unsigned long maxres = ULONG_MAX / 10;
-
-	for ( ; ; p += 1) {
-	    digit = *p - '0';
-	    if (digit > 9) {
-		break;
-	    }
-	    if (result > maxres) { overflow = 1; }
-	    result *= 10;
-	    if (digit > (ULONG_MAX - result)) { overflow = 1; }
-	    result += digit;
-	    anyDigits = 1;
-	}
-    } else if (base == 16) {
-	unsigned long maxres = ULONG_MAX >> 4;
-
-	for ( ; ; p += 1) {
-	    digit = *p - '0';
-	    if (digit > ('z' - '0')) {
-		break;
-	    }
-	    digit = cvtIn[digit];
-	    if (digit > 15) {
-		break;
-	    }
-	    if (result > maxres) { overflow = 1; }
-	    result = (result << 4);
-	    if (digit > (ULONG_MAX - result)) { overflow = 1; }
-	    result += digit;
-	    anyDigits = 1;
-	}
-    } else if (base >= 2 && base <= 36) {
-	unsigned long maxres = ULONG_MAX / base;
-
-	for ( ; ; p += 1) {
-	    digit = *p - '0';
-	    if (digit > ('z' - '0')) {
-		break;
-	    }
-	    digit = cvtIn[digit];
-	    if (digit >= ( (unsigned) base )) {
-		break;
-	    }
-	    if (result > maxres) { overflow = 1; }
-	    result *= base;
-	    if (digit > (ULONG_MAX - result)) { overflow = 1; }
-	    result += digit;
-	    anyDigits = 1;
-	}
-    }
-
-    /*
-     * See if there were any digits at all.
-     */
-
-    if (!anyDigits) {
-	p = string;
-    }
-
-    if (endPtr != 0) {
-	/* unsafe, but required by the strtoul prototype */
-	*endPtr = (char *) p;
-    }
-
-    if (overflow) {
-	errno = ERANGE;
-	return ULONG_MAX;
-    }
-    if (negative) {
-	return -result;
-    }
-    return result;
-}

doc/Alloc.3

@@ -32,7 +32,7 @@ void
 \fBTcl_GetMemoryInfo\fR(\fIdsPtr\fR)
 .SH ARGUMENTS
 .AS char *size
-.AP "unsigned int" size in
+.AP "size_t" size in
 Size in bytes of the memory block to allocate.
 .AP char *ptr in
 Pointer to memory block to free or realloc.

doc/DString.3

@@ -9,7 +9,7 @@
 .so man.macros
 .BS
 .SH NAME
-Tcl_DStringInit, Tcl_DStringAppend, Tcl_DStringAppendElement, Tcl_DStringStartSublist, Tcl_DStringEndSublist, Tcl_DStringLength, Tcl_DStringValue, Tcl_DStringSetLength, Tcl_DStringFree, Tcl_DStringResult, Tcl_DStringGetResult \- manipulate dynamic strings
+Tcl_DStringInit, Tcl_DStringAppend, Tcl_DStringAppendElement, Tcl_DStringStartSublist, Tcl_DStringEndSublist, Tcl_DStringLength, Tcl_DStringValue, Tcl_DStringSetLength, Tcl_DStringFree, Tcl_DStringResult, Tcl_DStringGetResult, Tcl_DStringToObj \- manipulate dynamic strings
 .SH SYNOPSIS
 .nf
 \fB#include <tcl.h>\fR

doc/Encoding.3

@@ -218,17 +218,16 @@ used.  The return value is a pointer to the value stored in the DString.
 be used to specify the profile to be used for the transform. The
 \fBTCL_ENCODING_START\fR and \fBTCL_ENCODING_END\fR bits in \fBflags\fR are
 ignored as the function assumes the entire source string to be decoded is passed
-into the function. On success, the function returns \fBTCL_ERROR\fR with the
-converted string stored in \fB*dstPtr\fR. For errors other than conversion
-errors, such as invalid flags, the function returns \fBTCL_OK\fR with an error
+into the function. On success, the function returns \fBTCL_OK\fR with the
+converted string stored in \fB*dstPtr\fR. For errors \fIother than conversion
+errors\fR, such as invalid flags, the function returns \fBTCL_ERROR\fR with an error
 message in \fBinterp\fR if it is not NULL.
-.PP
 For conversion errors, \fBTcl_ExternalToUtfDStringEx\fR returns one
 of the \fBTCL_CONVERT_*\fR errors listed below for \fBTcl_ExternalToUtf\fR.
 When one of these conversion errors is returned, an error message is
 stored in \fBinterp\fR only if \fBerrorIdxPtr\fR is NULL. Otherwise, no error message
-is stored as the function expects the caller is interested whatever is
-decoded to that point and not treating this as an immediate error condition.
+is stored as the function expects the caller is interested the decoded data
+up to that point and not treating this as an immediate error condition.
 The index of the error location is stored in \fB*errorIdxPtr\fR.
 .PP
 The caller must call \fBTcl_DStringFree\fR to free up the \fB*dstPtr\fR resources
@@ -547,13 +546,13 @@ encoding:
 E
 init		{}
 final		{}
-iso8859-1	\ex1b(B
-jis0201		\ex1b(J
-jis0208		\ex1b$@
-jis0208		\ex1b$B
-jis0212		\ex1b$(D
-gb2312		\ex1b$A
-ksc5601		\ex1b$(C
+iso8859-1	\ex1B(B
+jis0201		\ex1B(J
+jis0208		\ex1B$@
+jis0208		\ex1B$B
+jis0212		\ex1B$(D
+gb2312		\ex1B$A
+ksc5601		\ex1B$(C
 .CE
 .PP
 In the file, the first column represents an option and the second column
@@ -565,7 +564,7 @@ marks that encoding.  Tcl syntax is used for the values; in the above
 example, for instance,
 .QW \fB{}\fR
 represents the empty string and
-.QW \fB\ex1b\fR
+.QW \fB\ex1B\fR
 represents character 27.
 .PP
 When \fBTcl_GetEncoding\fR encounters an encoding \fIname\fR that has not

doc/Object.3

@@ -23,6 +23,8 @@ Tcl_Obj *
 .sp
 \fBTcl_DecrRefCount\fR(\fIobjPtr\fR)
 .sp
+\fBTcl_BounceRefCount\fR(\fIobjPtr\fR)
+.sp
 int
 \fBTcl_IsShared\fR(\fIobjPtr\fR)
 .sp
@@ -278,26 +280,27 @@ The string representation is now \fB124\fR
 and both representations are again valid.
 .SH "STORAGE MANAGEMENT OF VALUES"
 .PP
-Tcl values are allocated on the heap and are shared as much as possible
-to reduce storage requirements.
-Reference counting is used to determine when a value is
-no longer needed and can safely be freed.
-A value just created by \fBTcl_NewObj\fR or \fBTcl_NewStringObj\fR
-has \fIrefCount\fR 0, meaning that the object can often be given to a function
-like \fBTcl_SetObjResult\fR, \fBTcl_ListObjAppendElement\fR, or
-\fBTcl_DictObjPut\fR (as a value) without explicit reference management, all
-of which are common use cases. (The latter two require that the the target
-list or dictionary be well-formed, but that is often easy to arrange when the
-value is being initially constructed.)
-The macro \fBTcl_IncrRefCount\fR increments the reference count
-when a new reference to the value is created.
-The macro \fBTcl_DecrRefCount\fR decrements the count
-when a reference is no longer needed and,
-if the value's reference count drops to zero, frees its storage.
+Tcl values are allocated on the heap and are shared as much as
+possible to reduce storage requirements.  Reference counting is used
+to determine when a value is no longer needed and can safely be freed.
+A value just created by \fBTcl_NewObj\fR, \fBTcl_NewStringObj\fR, or
+any Abstract List command or function, has \fIrefCount\fR 0, meaning
+that the object can often be given to a function like
+\fBTcl_SetObjResult\fR, \fBTcl_ListObjAppendElement\fR, or
+\fBTcl_DictObjPut\fR (as a value) without explicit reference
+management, all of which are common use cases. (The latter two require
+that the target list or dictionary be well-formed, but that is
+often easy to arrange when the value is being initially constructed.)
+The macro \fBTcl_IncrRefCount\fR increments the reference count when a
+new reference to the value is created.
+The macro \fBTcl_DecrRefCount\fR decrements the count when a reference is no longer needed.
+If the value's reference count drops to zero, frees
+its storage.
+The macro \fBTcl_BounceRefCount\fR will check if the value has no references (i.e. in a "new" state) and free the value.
 A value shared by different code or data structures has
-\fIrefCount\fR greater than 1.
-Incrementing a value's reference count ensures that
-it will not be freed too early or have its value change accidentally.
+\fIrefCount\fR greater than 1.  Incrementing a value's reference count
+ensures that it will not be freed too early or have its value change
+accidentally.
 .PP
 As an example, the bytecode interpreter shares argument values
 between calling and called Tcl procedures to avoid having to copy values.
@@ -311,12 +314,25 @@ the interpreter calls \fBTcl_DecrRefCount\fR to decrement
 each argument's reference count.
 When a value's reference count drops less than or equal to zero,
 \fBTcl_DecrRefCount\fR reclaims its storage.
-Most command procedures do not have to be concerned about
-reference counting since they use a value's value immediately
-and do not retain a pointer to the value after they return.
-However, if they do retain a pointer to a value in a data structure,
-they must be careful to increment its reference count
-since the retained pointer is a new reference.
+
+.PP
+Most command procedures have not been concerned about reference
+counting since they use a value's value immediately and do not retain
+a pointer to the value after they return.  However, there are some
+procedures that may return a new value, with a refCount of 0. In this
+situation, it is the caller's responsibility to free the value before
+the procedure returns.  One way to cover this is to always call
+\fBTcl_IncrRefCount\fR before using the value, then call
+\fBTcl_DecrRefCount\fR before returning. The other way is to use
+\fBTcl_BounceRefCount\fR after the value is no longer needed or
+referenced. This macro will free the value if there are no other
+references to the value. When retaining a pointer to a value in a data
+structure the procedure must be careful to increment its reference
+count since the retained pointer is a new reference. Examples of
+procedures that return new values are \fBTcl_NewIntObj\fR, and
+commands like \fBlseq\fR, which creates an Abstract List, and an
+lindex on this list may return a new Obj with a refCount of 0.
+
 .PP
 Command procedures that directly modify values
 such as those for \fBlappend\fR and \fBlinsert\fR must be careful to
@@ -350,6 +366,11 @@ must check whether the variable's value is shared before
 incrementing the integer in its internal representation.
 If it is shared, it needs to duplicate the value
 in order to avoid accidentally changing values in other data structures.
+.PP
+In cases where a value is obtained, used, and not retained, the value
+can be freed using \fBTcl_BounceRefCount\fR. This
+is functionally equivalent to calling \fBTcl_IncrRefCount\fR followed
+\fBTcl_DecrRefCount\fR.
 .SH "SEE ALSO"
 Tcl_ConvertToType(3), Tcl_GetIntFromObj(3), Tcl_ListObjAppendElement(3), Tcl_ListObjIndex(3), Tcl_ListObjReplace(3), Tcl_RegisterObjType(3)
 .SH KEYWORDS

doc/ObjectType.3

@@ -4,7 +4,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\"
-.TH Tcl_ObjType 3 8.0 Tcl "Tcl Library Procedures"
+.TH Tcl_ObjType 3 9.0 Tcl "Tcl Library Procedures"
 .so man.macros
 .BS
 .SH NAME
@@ -93,14 +93,13 @@ free to set the internal representation for \fIobjPtr\fR to make
 use of another related Tcl_ObjType, if it sees fit.
 .SH "THE TCL_OBJTYPE STRUCTURE"
 .PP
-Extension writers can define new value types by defining four
-procedures and
-initializing a Tcl_ObjType structure to describe the type.
-Extension writers may also pass a pointer to their Tcl_ObjType
-structure to \fBTcl_RegisterObjType\fR if they wish to permit
-other extensions to look up their Tcl_ObjType by name with
-the \fBTcl_GetObjType\fR routine.
-The \fBTcl_ObjType\fR structure is defined as follows:
+Extension writers can define new value types by defining four to eight
+procedures and initializing a Tcl_ObjType structure to describe the
+type.  Extension writers may also pass a pointer to their Tcl_ObjType
+structure to \fBTcl_RegisterObjType\fR if they wish to permit other
+extensions to look up their Tcl_ObjType by name with the
+\fBTcl_GetObjType\fR routine.  The \fBTcl_ObjType\fR structure is
+defined as follows:
 .PP
 .CS
 typedef struct Tcl_ObjType {
@@ -110,6 +109,16 @@ typedef struct Tcl_ObjType {
     Tcl_UpdateStringProc *\fIupdateStringProc\fR;
     Tcl_SetFromAnyProc *\fIsetFromAnyProc\fR;
     size_t \fIversion\fR;
+    /* List emulation functions - ObjType Version 1 & 2 */
+    Tcl_ObjTypeLengthProc *lengthProc;
+    /* List emulation functions - ObjType Version 2 */
+    Tcl_ObjTypeIndexProc *\fIindexProc\fR;
+    Tcl_ObjTypeSliceProc *\fIsliceProc\fR;
+    Tcl_ObjTypeReverseProc *\fIreverseProc\fR;
+    Tcl_ObjTypeGetElements *\fIgetElementsProc\fR;
+    Tcl_ObjTypeSetElement *\fIsetElementProc\fR;
+    Tcl_ObjTypeReplaceProc *\fIreplaceProc\fR;
+    Tcl_ObjTypeInOperatorProc *\fIinOperProc\fR;
 } \fBTcl_ObjType\fR;
 .CE
 .SS "THE NAME FIELD"
@@ -206,6 +215,7 @@ The \fIdupIntRepProc\fR member contains the address of a function
 called to copy an internal representation from one value to another.
 .PP
 .CS
+
 typedef void \fBTcl_DupInternalRepProc\fR(
         Tcl_Obj *\fIsrcPtr\fR,
         Tcl_Obj *\fIdupPtr\fR);
@@ -229,6 +239,7 @@ The \fIfreeIntRepProc\fR member contains the address of a function
 that is called when a value is freed.
 .PP
 .CS
+
 typedef void \fBTcl_FreeInternalRepProc\fR(
         Tcl_Obj *\fIobjPtr\fR);
 .CE
@@ -256,8 +267,149 @@ immediately, in order to limit stack usage. However, the value will be freed
 before the outermost current \fBTcl_DecrRefCount\fR returns.
 .SS "THE VERSION FIELD"
 .PP
-The \fIversion\fR member provides for future extensibility of the structure
-and should be set to \fITCL_OBJTYPE_V0\fR.
+The \fIversion\fR member provides for future extensibility of the
+structure and should be set to \fBTCL_OBJTYPE_V0\fR for compatability
+of ObjType definitions prior to version 9.0. Specifics about versions
+will be described further in the sections below.
+.SH "ABSTRACT LIST TYPES"
+.PP
+Additional fields in the Tcl_ObjType descriptor allow for control over
+how custom data values can be manipulated using Tcl's List commands
+without converting the value to a List type. This requires the custom
+type to provide functions that will perform the given operation on the
+custom data representation.  Not all functions are required. In the
+absence of a particular function (set to NULL), the fallback is to
+allow the internal List operation to perform the operation, most
+likely causing the value type to be converted to a traditional list.
+.SS "SCALAR VALUE TYPES"
+.PP
+For a custom value type that is scalar or atomic in nature, i.e., not
+a divisible collection, version \fBTCL_OBJTYPE_V1\fR is
+recommended. In this case, List commands will treat the scalar value
+as if it where a list of length 1, and not convert the value to a List
+type.
+.SS "VERSION 2: ABSTRACT LISTS"
+.PP
+Version 2, \fBTCL_OBJTYPE_V2\fR, allows full List support when the
+functions described below are provided.  This allows for script level
+use of the List commands without causing the type of the Tcl_Obj value
+to be converted to a list.
+.SS "THE LENGTHPROC FIELD"
+.PP
+The \fBLengthProc\fR function correlates with the \fBTcl_ListObjLength\fR
+C API. The function returns the number of elements in the list. It
+is used in every List operation and is required for all Abstract List
+implementations.
+.CS
+
+typedef Tcl_Size
+(Tcl_ObjTypeLengthProc) (Tcl_Obj *listPtr);
+.CE
+
+.PP
+.SS "THE INDEXPROC FIELD"
+.PP
+The \fBIndexProc\fR function correlates with with the
+\fBTcl_ListObjIndex\fR C API. The function returns a Tcl_Obj value for
+the element at the specified index.
+.CS
+
+typedef int
+(Tcl_ObjTypeIndexProc) (
+    Tcl_Interp *interp,
+    Tcl_Obj *listPtr,
+    Tcl_Size index,
+    Tcl_Obj** elemObj);
+.CE
+.SS "THE SLICEPROC FIELD"
+.PP
+The \fBSliceProc\fR correlates with the \fBlrange\fR command,
+returning a new List or Abstract List for the portion of the original
+list specifed.
+.CS
+
+typedef int
+(Tcl_ObjTypeSliceProc) (
+    Tcl_Interp *interp,
+    Tcl_Obj *listPtr,
+    Tcl_Size fromIdx,
+    Tcl_Size toIdx,
+    Tcl_Obj **newObjPtr);
+.CE
+.SS "THE REVERSEPROC FIELD"
+.PP
+The \fBReverseProc\fR correlates with the \fBlreverse\fR command,
+returning a List or Abstract List that has the same elements as the
+input Abstract List, with the elements in the reverse order.
+.CS
+
+typedef int
+(Tcl_ObjTypeReverseProc) (
+    Tcl_Interp *interp,
+    Tcl_Obj *listPtr,
+    Tcl_Obj **newObjPtr);
+.CE
+.SS "THE GETELEMENTS FIELD"
+.PP
+The \fBGetElements\fR function returns a count and a pointer to an
+array of Tcl_Obj values for the entire Abstract List. This is a
+correlary to the \fBTcl_ListObjGetElements\fR C API call.
+.CS
+
+typedef int
+(Tcl_ObjTypeGetElements) (
+    Tcl_Interp *interp,
+    Tcl_Obj *listPtr,
+    Tcl_Size *objcptr,
+    Tcl_Obj ***objvptr);
+.CE
+.SS "THE SETELEMENT FIELD"
+.PP
+The \fBSetElement\fR function replaces the element within the
+specified list at the give index. This function correlates to the
+\fBlset\fR command.
+.CS
+
+typedef Tcl_Obj*
+Tcl_ObjTypeSetElement) (
+    Tcl_Interp *interp,
+    Tcl_Obj *listPtr,
+    Tcl_Size indexCount,
+    Tcl_Obj *const indexArray[],
+    Tcl_Obj *valueObj);
+.CE
+.SS "REPLACEPROC FIELD"
+.PP
+The \fBReplaceProc\fR returns a new list after modfying the list
+replacing the elements to be deleted, and adding the elements to be
+inserted. This function correlates to the \fBTcl_ListObjReplace\fR C API.
+.CS
+
+typedef int
+(Tcl_ObjTypeReplaceProc) (
+    Tcl_Interp *interp,
+    Tcl_Obj *listObj,
+    Tcl_Size first,
+    Tcl_Size numToDelete,
+    Tcl_Size numToInsert,
+    Tcl_Obj *const insertObjs[]);
+.CE
+.SS "THE INOPERATORPROC FIELD"
+.PP
+The \fBInOperProc\fR function determines whether the value is present in the
+given list, according to equivalent string comparison of elements. The
+\fBboolResult\fR is set to 1 (true) if the value is present, and 0
+(false) if it is not present. This function implements the "in" and
+"ni" math operators for an abstract list.
+.CS
+
+typedef int
+(Tcl_ObjTypeInOperatorProc) (
+    Tcl_Interp *interp,
+    Tcl_Obj *valueObj,
+    Tcl_Obj *listObj,
+    int *boolResult);
+.CE
 .SH "REFERENCE COUNT MANAGEMENT"
 .PP
 The \fIobjPtr\fR argument to \fBTcl_AppendAllObjTypes\fR should be an unshared
@@ -276,6 +428,6 @@ modify the reference count of their arguments, but if the values contain
 subsidiary values (e.g., the elements of a list or the keys of a dictionary)
 then those subsidiary values may have their reference counts modified.
 .SH "SEE ALSO"
-Tcl_NewObj(3), Tcl_DecrRefCount(3), Tcl_IncrRefCount(3)
+Tcl_NewObj(3), Tcl_DecrRefCount(3), Tcl_IncrRefCount(3), Tcl_BounceRefCount(3)
 .SH KEYWORDS
 internal representation, value, value type, string representation, type conversion

doc/OpenFileChnl.3

@@ -47,10 +47,10 @@ int
 int
 \fBTcl_Close\fR(\fIinterp, channel\fR)
 .sp
-int
+Tcl_Size
 \fBTcl_ReadChars\fR(\fIchannel, readObjPtr, charsToRead, appendFlag\fR)
 .sp
-int
+Tcl_Size
 \fBTcl_Read\fR(\fIchannel, readBuf, bytesToRead\fR)
 .sp
 Tcl_Size

doc/Utf.3

@@ -8,7 +8,7 @@
 .so man.macros
 .BS
 .SH NAME
-Tcl_UniChar, Tcl_UniCharToUtf, Tcl_UtfToUniChar, Tcl_UtfToChar16, Tcl_UtfToWChar, Tcl_UniCharToUtfDString, Tcl_UtfToUniCharDString, Tcl_Char16ToUtfDString, Tcl_UtfToWCharDString, Tcl_UtfToChar16DString, Tcl_WCharLen, Tcl_Char16Len, Tcl_UniCharLen, Tcl_UniCharNcmp, Tcl_UniCharNcasecmp, Tcl_UniCharCaseMatch, Tcl_UtfNcmp, Tcl_UtfNcasecmp, Tcl_UtfCharComplete, Tcl_NumUtfChars, Tcl_UtfFindFirst, Tcl_UtfFindLast, Tcl_UtfNext, Tcl_UtfPrev, Tcl_UniCharAtIndex, Tcl_UtfAtIndex, Tcl_UtfBackslash \- routines for manipulating UTF-8 strings
+Tcl_UniChar, Tcl_UniCharToUtf, Tcl_UtfToUniChar, Tcl_UtfToChar16, Tcl_UtfToWChar, Tcl_UniCharToUtfDString, Tcl_UtfToUniCharDString, Tcl_Char16ToUtfDString, Tcl_UtfToWCharDString, Tcl_UtfToChar16DString, Tcl_WCharToUtfDString, Tcl_WCharLen, Tcl_Char16Len, Tcl_UniCharLen, Tcl_UniCharNcmp, Tcl_UniCharNcasecmp, Tcl_UniCharCaseMatch, Tcl_UtfNcmp, Tcl_UtfNcasecmp, Tcl_UtfCharComplete, Tcl_NumUtfChars, Tcl_UtfFindFirst, Tcl_UtfFindLast, Tcl_UtfNext, Tcl_UtfPrev, Tcl_UniCharAtIndex, Tcl_UtfAtIndex, Tcl_UtfBackslash \- routines for manipulating UTF-8 strings
 .SH SYNOPSIS
 .nf
 \fB#include <tcl.h>\fR
@@ -28,28 +28,28 @@ Tcl_Size
 \fBTcl_UtfToWChar\fR(\fIsrc, wPtr\fR)
 .sp
 char *
-\fBTcl_UniCharToUtfDString\fR(\fIuniStr, uniLength, dsPtr\fR)
+\fBTcl_UniCharToUtfDString\fR(\fIuniStr, numUniChars, dsPtr\fR)
 .sp
 char *
-\fBTcl_Char16ToUtfDString\fR(\fIuStr, uniLength, dsPtr\fR)
+\fBTcl_Char16ToUtfDString\fR(\fIutf16, numUtf16, dsPtr\fR)
 .sp
 char *
-\fBTcl_WCharToUtfDString\fR(\fIwStr, uniLength, dsPtr\fR)
+\fBTcl_WCharToUtfDString\fR(\fIwcharStr, numWChars, dsPtr\fR)
 .sp
 Tcl_UniChar *
-\fBTcl_UtfToUniCharDString\fR(\fIsrc, length, dsPtr\fR)
+\fBTcl_UtfToUniCharDString\fR(\fIsrc, numBytes, dsPtr\fR)
 .sp
 unsigned short *
-\fBTcl_UtfToChar16DString\fR(\fIsrc, length, dsPtr\fR)
+\fBTcl_UtfToChar16DString\fR(\fIsrc, numBytes, dsPtr\fR)
 .sp
 wchar_t *
-\fBTcl_UtfToWCharDString\fR(\fIsrc, length, dsPtr\fR)
+\fBTcl_UtfToWCharDString\fR(\fIsrc, numBytes, dsPtr\fR)
 .sp
 int
-\fBTcl_Char16Len\fR(\fIuniStr\fR)
+\fBTcl_Char16Len\fR(\fIutf16\fR)
 .sp
 int
-\fBTcl_WCharLen\fR(\fIuniStr\fR)
+\fBTcl_WCharLen\fR(\fIwcharStr\fR)
 .sp
 int
 \fBTcl_UniCharLen\fR(\fIuniStr\fR)
@@ -70,10 +70,10 @@ int
 \fBTcl_UtfNcasecmp\fR(\fIcs, ct, length\fR)
 .sp
 int
-\fBTcl_UtfCharComplete\fR(\fIsrc, length\fR)
+\fBTcl_UtfCharComplete\fR(\fIsrc, numBytes\fR)
 .sp
 int
-\fBTcl_NumUtfChars\fR(\fIsrc, length\fR)
+\fBTcl_NumUtfChars\fR(\fIsrc, numBytes\fR)
 .sp
 const char *
 \fBTcl_UtfFindFirst\fR(\fIsrc, ch\fR)
@@ -115,28 +115,32 @@ Pointer to a UTF-8 string.
 .AP "const char" *ct in
 Pointer to a UTF-8 string.
 .AP "const Tcl_UniChar" *uniStr in
-A null-terminated Unicode string.
+A sequence of \fBTcl_UniChar\fR units with null-termination optional
+depending on function.
 .AP "const Tcl_UniChar" *ucs in
-A null-terminated Unicode string.
+A null-terminated sequence of \fBTcl_UniChar\fR.
 .AP "const Tcl_UniChar" *uct in
-A null-terminated Unicode string.
+A null-terminated sequence of \fBTcl_UniChar\fR.
 .AP "const Tcl_UniChar" *uniPattern in
-A null-terminated Unicode string.
-.AP "const unsigned short" *uStr in
-A null-terminated UTF-16 string.
-.AP "const wchar_t" *wStr in
-A null-terminated wchar_t string.
-.AP "const unsigned short" *utf16s in
-A null-terminated utf-16 string.
-.AP "const unsigned short" *utf16t in
-A null-terminated utf-16 string.
-.AP "const unsigned short" *utf16Pattern in
-A null-terminated utf-16 string.
-.AP Tcl_Size length in
-The length of the UTF-8 string in bytes (not UTF-8 characters).  If
-negative, all bytes up to the first null byte are used.
-.AP Tcl_Size uniLength in
-The length of the Unicode string in characters.
+A null-terminated sequence of \fBTcl_UniChar\fR.
+.AP "const unsigned short" *utf16 in
+A sequence of UTF-16 units with null-termination optional
+depending on function.
+.AP "const wchar_t" *wcharStr in
+A sequence of \fBwchar_t\fR units with null-termination optional
+depending on function.
+.AP int numBytes in
+The length of the UTF-8 input in bytes.  If
+negative, the length includes all bytes until the first null byte.
+.AP int numUtf16 in
+The length of the input in UTF-16 units.
+If negative, the length includes all bytes until the first null.
+.AP int numUniChars in
+The length of the input in Tcl_UniChar units.
+If negative, the length includes all bytes until the first null.
+.AP int numWChars in
+The length of the input in wchar_t units.
+If negative, the length includes all bytes until the first null.
 .AP "Tcl_DString" *dsPtr in/out
 A pointer to a previously initialized \fBTcl_DString\fR.
 .AP "const char" *start in
@@ -186,30 +190,32 @@ not in proper UTF-8 format, \fBTcl_UtfToUniChar\fR will store the first
 byte of \fIsrc\fR in \fI*chPtr\fR as a Tcl_UniChar between 0x00A0 and
 0x00FF and return 1.
 .PP
-\fBTcl_UniCharToUtfDString\fR converts the given Unicode string
-to UTF-8, storing the result in a previously initialized \fBTcl_DString\fR.
-The return value is a pointer to the UTF-8 representation of the
-Unicode string.  Storage for the return value is appended to the
-end of the \fBTcl_DString\fR.
+\fBTcl_UniCharToUtfDString\fR converts the input in the form of a
+sequence of \fBTcl_UniChar\fR code points to UTF-8, appending the result to the
+previously initialized output \fBTcl_DString\fR. The return value is a pointer
+to the UTF-8 representation of the \fBappended\fR string.
 .PP
-\fBTcl_UtfToUniCharDString\fR converts the given UTF-8 string to Unicode,
-storing the result in the previously initialized \fBTcl_DString\fR.
-In the argument \fIlength\fR, you may either specify the length of
-the given UTF-8 string in bytes or
-.QW \-1 ,
-in which case \fBTcl_UtfToUniCharDString\fR uses \fBstrlen\fR to
-calculate the length.  The return value is a pointer to the Unicode
-representation of the UTF-8 string.  Storage for the return value
-is appended to the end of the \fBTcl_DString\fR.  The Unicode string
-is terminated with a Unicode null character.
+\fBTcl_UtfToUniCharDString\fR converts the input in the form of
+a UTF-8 encoded string to a \fBTcl_UniChar\fR sequence
+appending the result in the previously initialized \fBTcl_DString\fR.
+The return value is a pointer to the appended result which is also
+terminated with a \fBTcl_UniChar\fR null character.
+.PP
+\fBTcl_WCharToUtfDString\fR and \fBTcl_UtfToWCharDString\fR are similar to
+\fBTcl_UniCharToUtfDString\fR and \fBTcl_UtfToUniCharDString\fR except they
+operate on sequences of \fBwchar_t\fR instead of \fBTcl_UniChar\fR.
+.PP
+\fBTcl_Char16ToUtfDString\fR and \fBTcl_UtfToChar16DString\fR are similar to
+\fBTcl_UniCharToUtfDString\fR and \fBTcl_UtfToUniCharDString\fR except they
+operate on sequences of \fBUTF-16\fR units instead of \fBTcl_UniChar\fR.
 .PP
 \fBTcl_Char16Len\fR corresponds to \fBstrlen\fR for UTF-16
-characters.  It accepts a null-terminated Unicode string and returns
-the number of Unicode characters (not bytes) in that string.
+characters.  It accepts a null-terminated UTF-16 sequence and returns
+the number of UTF-16 units until the null.
 .PP
 \fBTcl_WCharLen\fR corresponds to \fBstrlen\fR for wchar_t
-characters.  It accepts a null-terminated Unicode string and returns
-the number of Unicode characters (not bytes) in that string.
+characters.  It accepts a null-terminated \fBwchar_t\fR sequence and returns
+the number of \fBwchar_t\fR units until the null.
 .PP
 \fBTcl_UniCharLen\fR corresponds to \fBstrlen\fR for Unicode
 characters.  It accepts a null-terminated Unicode string and returns
@@ -245,7 +251,7 @@ differences in case when comparing upper, lower or title case
 characters.
 .PP
 \fBTcl_UtfCharComplete\fR returns 1 if the source UTF-8 string \fIsrc\fR
-of \fIlength\fR bytes is long enough to be decoded by
+of \fInumBytes\fR bytes is long enough to be decoded by
 \fBTcl_UtfToUniChar\fR/\fBTcl_UtfNext\fR, or 0 otherwise.  This function
 does not guarantee that the UTF-8 string is properly formed.  This routine
 is used by procedures that are operating on a byte at a time and need to

doc/binary.n

@@ -241,7 +241,7 @@ which returns a binary string equivalent to:
 \fB\e254\fR
 .CE
 .PP
-(i.e. \fB\exac\fR) by
+(i.e. \fB\exAC\fR) by
 truncating the high-bits of the character, and which is probably not
 what is desired.
 .RE
@@ -299,7 +299,7 @@ high-to-low order within each byte.  For example,
 will return a binary string equivalent to:
 .PP
 .CS
-\fB\exe0\exe1\exa0\fR
+\fB\exE0\exE1\exA0\fR
 .CE
 .RE
 .IP \fBH\fR 5
@@ -326,7 +326,7 @@ remaining bits of the last byte will be zeros.  For example,
 will return a binary string equivalent to:
 .PP
 .CS
-\fB\exab\ex00\exde\exf0\ex98\fR
+\fB\exAB\ex00\exDE\exF0\ex98\fR
 .CE
 .RE
 .IP \fBh\fR 5
@@ -341,7 +341,7 @@ low-to-high order within each byte. This is seldom required. For example,
 will return a binary string equivalent to:
 .PP
 .CS
-\fB\exba\ex00\exed\ex0f\ex89\fR
+\fB\exBA\ex00\exED\ex0F\ex89\fR
 .CE
 .RE
 .IP \fBc\fR 5
@@ -363,7 +363,7 @@ than \fIcount\fR, then the extra elements are ignored.  For example,
 will return a binary string equivalent to:
 .PP
 .CS
-\fB\ex03\exfd\ex80\ex04\ex02\ex05\fR
+\fB\ex03\exFD\ex80\ex04\ex02\ex05\fR
 .CE
 .PP
 whereas:
@@ -389,7 +389,7 @@ example,
 will return a binary string equivalent to:
 .PP
 .CS
-\fB\ex03\ex00\exfd\exff\ex02\ex01\fR
+\fB\ex03\ex00\exFD\exFF\ex02\ex01\fR
 .CE
 .RE
 .IP \fBS\fR 5
@@ -405,7 +405,7 @@ example,
 will return a binary string equivalent to:
 .PP
 .CS
-\fB\ex00\ex03\exff\exfd\ex01\ex02\fR
+\fB\ex00\ex03\exFF\exFD\ex01\ex02\fR
 .CE
 .RE
 .IP \fBt\fR 5
@@ -429,7 +429,7 @@ example,
 will return a binary string equivalent to:
 .PP
 .CS
-\fB\ex03\ex00\ex00\ex00\exfd\exff\exff\exff\ex00\ex00\ex01\ex00\fR
+\fB\ex03\ex00\ex00\ex00\exFD\exFF\exFF\exFF\ex00\ex00\ex01\ex00\fR
 .CE
 .RE
 .IP \fBI\fR 5
@@ -445,7 +445,7 @@ For example,
 will return a binary string equivalent to:
 .PP
 .CS
-\fB\ex00\ex00\ex00\ex03\exff\exff\exff\exfd\ex00\ex01\ex00\ex00\fR
+\fB\ex00\ex00\ex00\ex03\exFF\exFF\exFF\exFD\ex00\ex01\ex00\ex00\fR
 .CE
 .RE
 .IP \fBn\fR 5
@@ -510,7 +510,7 @@ on a Windows system running on an Intel Pentium processor,
 will return a binary string equivalent to:
 .PP
 .CS
-\fB\excd\excc\excc\ex3f\ex9a\ex99\ex59\ex40\fR
+\fB\exCD\exCC\exCC\ex3F\ex9A\ex99\ex59\ex40\fR
 .CE
 .RE
 .IP \fBr\fR 5
@@ -536,7 +536,7 @@ Windows system running on an Intel Pentium processor,
 will return a binary string equivalent to:
 .PP
 .CS
-\fB\ex9a\ex99\ex99\ex99\ex99\ex99\exf9\ex3f\fR
+\fB\ex9A\ex99\ex99\ex99\ex99\ex99\exF9\ex3F\fR
 .CE
 .RE
 .IP \fBq\fR 5
@@ -788,7 +788,7 @@ scanned. For example,
 .RS
 .PP
 .CS
-\fBbinary scan\fR \ex07\exC6\ex05\ex1f\ex34 H3H* var1 var2
+\fBbinary scan\fR \ex07\exC6\ex05\ex1F\ex34 H3H* var1 var2
 .CE
 .PP
 will return \fB2\fR with \fB07c\fR stored in \fIvar1\fR and
@@ -839,7 +839,7 @@ example,
 .RS
 .PP
 .CS
-\fBbinary scan\fR \ex05\ex00\ex07\ex00\exf0\exff s2s* var1 var2
+\fBbinary scan\fR \ex05\ex00\ex07\ex00\exF0\exFF s2s* var1 var2
 .CE
 .PP
 will return \fB2\fR with \fB5 7\fR stored in \fIvar1\fR and \fB\-16\fR
@@ -853,7 +853,7 @@ order.  For example,
 .RS
 .PP
 .CS
-\fBbinary scan\fR \ex00\ex05\ex00\ex07\exff\exf0 S2S* var1 var2
+\fBbinary scan\fR \ex00\ex05\ex00\ex07\exFF\exF0 S2S* var1 var2
 .CE
 .PP
 will return \fB2\fR with \fB5 7\fR stored in \fIvar1\fR and \fB\-16\fR
@@ -878,7 +878,7 @@ example,
 .RS
 .PP
 .CS
-set str \ex05\ex00\ex00\ex00\ex07\ex00\ex00\ex00\exf0\exff\exff\exff
+set str \ex05\ex00\ex00\ex00\ex07\ex00\ex00\ex00\exF0\exFF\exFF\exFF
 \fBbinary scan\fR $str i2i* var1 var2
 .CE
 .PP
@@ -894,7 +894,7 @@ immediately after the \fBI\fR.  For example,
 .RS
 .PP
 .CS
-set str \ex00\ex00\ex00\ex05\ex00\ex00\ex00\ex07\exff\exff\exff\exf0
+set str \ex00\ex00\ex00\ex05\ex00\ex00\ex00\ex07\exFF\exFF\exFF\exF0
 \fBbinary scan\fR $str I2I* var1 var2
 .CE
 .PP
@@ -920,7 +920,7 @@ example,
 .RS
 .PP
 .CS
-set str \ex05\ex00\ex00\ex00\ex07\ex00\ex00\ex00\exf0\exff\exff\exff
+set str \ex05\ex00\ex00\ex00\ex07\ex00\ex00\ex00\exF0\exFF\exFF\exFF
 \fBbinary scan\fR $str wi* var1 var2
 .CE
 .PP
@@ -935,7 +935,7 @@ immediately after the \fBW\fR.  For example,
 .RS
 .PP
 .CS
-set str \ex00\ex00\ex00\ex05\ex00\ex00\ex00\ex07\exff\exff\exff\exf0
+set str \ex00\ex00\ex00\ex05\ex00\ex00\ex00\ex07\exFF\exFF\exFF\exF0
 \fBbinary scan\fR $str WI* var1 var2
 .CE
 .PP
@@ -966,7 +966,7 @@ Intel Pentium processor,
 .RS
 .PP
 .CS
-\fBbinary scan\fR \ex3f\excc\excc\excd f var1
+\fBbinary scan\fR \ex3F\exCC\exCC\exCD f var1
 .CE
 .PP
 will return \fB1\fR with \fB1.6000000238418579\fR stored in
@@ -990,7 +990,7 @@ running on an Intel Pentium processor,
 .RS
 .PP
 .CS
-\fBbinary scan\fR \ex9a\ex99\ex99\ex99\ex99\ex99\exf9\ex3f d var1
+\fBbinary scan\fR \ex9A\ex99\ex99\ex99\ex99\ex99\exF9\ex3F d var1
 .CE
 .PP
 will return \fB1\fR with \fB1.6000000000000001\fR

doc/chan.n

@@ -152,7 +152,7 @@ If \fIchar\fR is the empty string, there is no special character that marks
 the end of the data.
 
 The default value is the empty string.  The acceptable range is \ex01 -
-\ex7f.  A value outside this range results in an error.
+\ex7F.  A value outside this range results in an error.
 .VS "TCL8.7 TIP656"
 .TP
 \fB\-profile\fR \fIprofile\fR
@@ -245,10 +245,10 @@ files to slow destinations like network sockets.
 .PP
 \fB\-size\fR limits the number of characters copied.
 .PP
-If \fB\-command\fR is gviven, \fBchan copy\fR returns immediately, works in the
+If \fB\-command\fR is given, \fBchan copy\fR returns immediately, works in the
 background, and calls \fIcallback\fR when the copy completes, providing as an
 additional argument the number of characters written to \fIoutputChan\fR.  If
-an error occurres during the background copy, another argument provides message
+an error occurs during the background copy, another argument provides message
 for the error.  \fIinputChan\fR and \fIoutputChan\fR are automatically
 configured for non-blocking mode if needed.  Background copying only works
 correctly if events are being processed, e.g. via \fBvwait\fR or Tk.

doc/filename.n

@@ -119,6 +119,22 @@ Volume-relative path to a file \fBfoo\fR in the root directory of the current
 volume.  This is not a valid UNC path, so the assumption is that the
 extra backslashes are superfluous.
 .RE
+.SH "TILDE SUBSTITUTION"
+.PP
+Unlike earlier versions of Tcl, Tcl 9 does not do implicit tilde substitution
+on file paths with the exception noted below. The commands \fBfile home\fR and
+\fBfile tildeexpand\fR may be used to explicitly accomplish the same.
+.PP
+The exception to the above is initialization of the \fBauto_path\fR variable
+and the Tcl module search paths as documented in the manpages for
+\fBtclvars\fR and \fBtm\fR. When any path in an environment variable used to
+initialize these starts with a tilde, it will be interpreted as if the first
+element is replaced with the location of the home directory for the given
+user. If the tilde is followed immediately by a separator, the
+\fB$HOME\fR environment variable is substituted. Otherwise the characters
+between the tilde and the next separator are taken as a user name, which is
+used to retrieve the user's home directory for substitution. This works on
+POSIX, MacOS X and Windows platforms.
 .SH "PORTABILITY ISSUES"
 .PP
 Not all file systems are case sensitive, so scripts should avoid code

doc/library.n

@@ -248,6 +248,9 @@ For example, to print the contents of the \fBtcl_platform\fR array, do:
 \fBparray\fR tcl_platform
 .CE
 .RE
+.SS "WORD BOUNDARY HELPERS"
+.PP
+These procedures are mainly used internally by Tk.
 .TP
 \fBtcl_endOfWord \fIstr start\fR
 .

doc/lseq.n

@@ -20,18 +20,47 @@ lseq \- Build a numeric sequence returned as a list
 .SH DESCRIPTION
 .PP
 The \fBlseq\fR command creates a sequence of numeric values using the given
-parameters \fIstart\fR, \fIend\fR, and \fIstep\fR.
-The \fIoperation\fR argument
-.QW \fB..\fR
-or
-.QW \fBto\fR
-defines an inclusive range; if it is omitted, the range is exclusive.
-The \fBcount\fR option is used to define a count of the number of elements in
-the list.
-The \fIstep\fR (which may be preceded by \fBby\fR) is 1 if not provided.
-The short form with a
-single \fIcount\fR value will create a range from 0 to \fIcount\fR-1 (i.e.,
-\fIcount\fR values).
+parameters \fIstart\fR, \fIend\fR, and \fIstep\fR. The \fIoperation\fR
+argument "\fB..\fR" or "\fBto\fR" defines the range. The "\fBcount\fR" option
+is used to define a count of the number of elements in the list. A short form
+use of the command, with a single count value, will create a range from 0 to
+count-1.
+
+The \fBlseq\fR command can produce both increasing and decreasing
+sequences. When both \fIstart\fR and \fIend\fR are provided without a
+\fIstep\fR value, then if \fIstart\fR <= \fIend\fR, the sequence will be
+increasing and if \fIstart\fR > \fIend\fR it will be decreasing. If a
+\fIstep\fR vale is included, it's sign should agree with the direction of the
+sequence (descending -> negative and ascending -> positive), otherwise an
+empty list is returned.  For example:
+
+.CS \"
+% \fBlseq\fR 1 to 5    ;# increasing
+\fI\(-> 1 2 3 4 5
+
+% \fBlseq\fR 5 to 1    ;# decreasing
+\fI\(-> 5 4 3 2 1
+
+% \fBlseq\fR 6 to 1 by 2   ;# decreasing, step wrong sign, empty list
+
+% \fBlseq\fR 1 to 5 by 0   ;# all step sizes of 0 produce an empty list
+.\"
+.CE
+
+The numeric arguments, \fIstart\fR, \fIend\fR, \fIstep\fR, and \fIcount\fR,
+may also be a valid expression. The expression will be evaluated and the
+numeric result will be used.  An expression that does not evaluate to a number
+will produce an invalid argument error.
+.PP
+\fIStart\fR defines the initial value and \fIend\fR defines the limit, not
+necessarily the last value. \fBlseq\fR produces a list with \fIcount\fR
+elements, and if \fIcount\fR is not supplied, it is computed as
+
+.CS \"
+    \fIcount\fR = int( (\fIend\fR - \fIstart\fR + \fIstep\fR) / \fIstep\fR )
+.\"
+.CE
+
 .PP
 The numeric arguments, \fIstart\fR, \fIend\fR, \fIstep\fR, and \fIcount\fR,
 can also be a valid expression. the \fBlseq\fR command will evaluate the
@@ -43,53 +72,53 @@ value; a non-numeric expression result will result in an error.
 .CS
 .\"
 \fBlseq\fR 3
-         \fI\(-> 0 1 2\fR
+\fI\(-> 0 1 2\fR
 
 \fBlseq\fR 3 0
-         \fI\(-> 3 2 1 0\fR
+\fI\(-> 3 2 1 0\fR
 
 \fBlseq\fR 10 .. 1 by -2
-         \fI\(-> 10 8 6 4 2\fR
+\fI\(-> 10 8 6 4 2\fR
 
 set l [\fBlseq\fR 0 -5]
-         \fI\(-> 0 -1 -2 -3 -4 -5\fR
+\fI\(-> 0 -1 -2 -3 -4 -5\fR
 
 foreach i [\fBlseq\fR [llength $l]] {
     puts l($i)=[lindex $l $i]
 }
-        \fI\(-> l(0)=0\fR
-        \fI\(-> l(1)=-1\fR
-        \fI\(-> l(2)=-2\fR
-        \fI\(-> l(3)=-3\fR
-        \fI\(-> l(4)=-4\fR
-        \fI\(-> l(5)=-5\fR
+\fI\(-> l(0)=0\fR
+\fI\(-> l(1)=-1\fR
+\fI\(-> l(2)=-2\fR
+\fI\(-> l(3)=-3\fR
+\fI\(-> l(4)=-4\fR
+\fI\(-> l(5)=-5\fR
 
 foreach i [\fBlseq\fR {[llength $l]-1} 0] {
     puts l($i)=[lindex $l $i]
 }
-        \fI\(-> l(5)=-5\fR
-        \fI\(-> l(4)=-4\fR
-        \fI\(-> l(3)=-3\fR
-        \fI\(-> l(2)=-2\fR
-        \fI\(-> l(1)=-1\fR
-        \fI\(-> l(0)=0\fR
+\fI\(-> l(5)=-5\fR
+\fI\(-> l(4)=-4\fR
+\fI\(-> l(3)=-3\fR
+\fI\(-> l(2)=-2\fR
+\fI\(-> l(1)=-1\fR
+\fI\(-> l(0)=0\fR
 
 set i 17
          \fI\(-> 17\fR
-if {$i in [\fBlseq\fR 0 50]} { # equivalent to: (0 <= $i && $i < 50)
+if {$i in [\fBlseq\fR 0 50]} { # equivalent to: (0 <= $i && $i <= 50)
     puts "Ok"
 } else {
     puts "outside :("
 }
-        \fI\(-> Ok\fR
+\fI\(-> Ok\fR
 
 set sqrs [lmap i [\fBlseq\fR 1 10] { expr {$i*$i} }]
-        \fI\(-> 1 4 9 16 25 36 49 64 81 100\fR
+\fI\(-> 1 4 9 16 25 36 49 64 81 100\fR
 .\"
 .CE
 .SH "SEE ALSO"
-foreach(n), list(n), lappend(n), lassign(n), ledit(n), lindex(n), linsert(n),
-llength(n), lmap(n), lpop(n), lrange(n), lremove(n), lreplace(n),
+foreach(n), list(n), lappend(n), lassign(n), lindex(n), linsert(n), llength(n),
+lmap(n), lpop(n), lrange(n), lremove(n), lreplace(n),
 lreverse(n), lsearch(n), lset(n), lsort(n)
 .SH KEYWORDS
 element, index, list

doc/tclvars.n

@@ -30,6 +30,10 @@ the parent directory of \fBtcl_library\fR,
 the directories listed in the \fBtcl_pkgPath\fR variable.
 Additional locations to look for files and package indices should
 normally be added to this variable using \fBlappend\fR.
+Initialization of auto_path from the TCLLIBPATH environment
+variable undergoes tilde substitution (see \fBfilename\fR) on each
+path. Any tilde substitution that fails because the user is unknown
+will be omitted from auto_path.
 .RS
 .PP
 Additional variables relating to package management exist. More

doc/tm.n

@@ -295,6 +295,10 @@ environment variables:
 \fB$::env(TCL8.1_TM_PATH)\fR  \fB$::env(TCL8_1_TM_PATH)\fR
 \fB$::env(TCL8.0_TM_PATH)\fR  \fB$::env(TCL8_0_TM_PATH)\fR
 .CE
+.PP
+Paths initialized from the environment variables undergo tilde
+substitution (see \fBfilename\fR). Any path whose tilde substitution
+fails because the user is unknown will be omitted from search paths.
 .SH "SEE ALSO"
 package(n), Tcl Improvement Proposal #189
 .QW "\fITcl Modules\fR"

doc/trace.n

@@ -231,7 +231,7 @@ When the trace triggers, three arguments are appended to
 .PP
 \fIName1\fR gives the name for the variable being accessed.
 This is not necessarily the same as the name used in the
-\fBtrace variable\fR command:  the \fBupvar\fR command allows a
+\fBtrace add variable\fR command:  the \fBupvar\fR command allows a
 procedure to reference a variable under a different name.
 If the trace was originally set on an array or array element,
 \fIname2\fR provides which index into the array was affected.

doc/upvar.n

@@ -94,7 +94,7 @@ proc \fIsetByUpvar\fR { name value } {
     set localVar $value
 }
 set originalVar 1
-trace variable originalVar w \fItraceproc\fR
+trace add variable originalVar write \fItraceproc\fR
 \fIsetByUpvar\fR originalVar 2
 .CE
 .PP

generic/regcustom.h

@@ -84,9 +84,15 @@ 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,7 +9,6 @@
  * 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.
@@ -106,9 +105,6 @@ 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)))
@@ -212,6 +208,10 @@ extern "C" {
 #   endif
 #endif
 
+#if !defined(CONST86) && !defined(TCL_NO_DEPRECATED)
+#      define CONST86 const
+#endif
+
 /*
  * Make sure EXTERN isn't defined elsewhere.
  */
@@ -321,12 +321,24 @@ typedef unsigned TCL_WIDE_INT_TYPE	Tcl_WideUInt;
 #define Tcl_WideAsDouble(val)	((double)((Tcl_WideInt)(val)))
 #define Tcl_DoubleAsWide(val)	((Tcl_WideInt)((double)(val)))
 
-typedef ptrdiff_t Tcl_Size;
-#define TCL_SIZE_MAX PTRDIFF_MAX
-#define TCL_SIZE_MODIFIER TCL_T_MODIFIER
+#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 */
 
 #ifdef _WIN32
-typedef struct __stat64 Tcl_StatBuf;
+#   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
 #elif defined(__CYGWIN__)
     typedef struct {
 	unsigned st_dev;
@@ -343,8 +355,6 @@ typedef struct __stat64 Tcl_StatBuf;
 	struct {long tv_sec;} st_mtim;
 	struct {long tv_sec;} st_ctim;
     } Tcl_StatBuf;
-#elif defined(HAVE_STRUCT_STAT64) && !defined(__APPLE__)
-    typedef struct stat64 Tcl_StatBuf;
 #else
     typedef struct stat Tcl_StatBuf;
 #endif
@@ -453,18 +463,28 @@ 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;
 
 /*
@@ -586,6 +606,32 @@ typedef void *(Tcl_InitNotifierProc) (void);
 typedef void (Tcl_FinalizeNotifierProc) (void *clientData);
 typedef void (Tcl_MainLoopProc) (void);
 
+/* Abstract List functions */
+typedef	      Tcl_Size	(Tcl_ObjTypeLengthProc)  (struct Tcl_Obj *listPtr);
+typedef		   int	(Tcl_ObjTypeIndexProc)   (Tcl_Interp *interp, struct Tcl_Obj *listPtr,
+                                             Tcl_Size index, struct Tcl_Obj** elemObj);
+typedef		   int	(Tcl_ObjTypeSliceProc)   (Tcl_Interp *interp, struct Tcl_Obj *listPtr,
+                                             Tcl_Size fromIdx, Tcl_Size toIdx,
+                                             struct Tcl_Obj **newObjPtr);
+typedef		   int	(Tcl_ObjTypeReverseProc) (Tcl_Interp *interp, struct Tcl_Obj *listPtr,
+					     struct Tcl_Obj **newObjPtr);
+typedef		   int	(Tcl_ObjTypeGetElements) (Tcl_Interp *interp, struct Tcl_Obj *listPtr,
+					     Tcl_Size *objcptr, struct Tcl_Obj ***objvptr);
+typedef	struct Tcl_Obj*	(Tcl_ObjTypeSetElement)  (Tcl_Interp *interp, struct Tcl_Obj *listPtr,
+                                             Tcl_Size indexCount,
+                                             struct Tcl_Obj *const indexArray[],
+                                             struct Tcl_Obj *valueObj);
+typedef            int  (Tcl_ObjTypeReplaceProc) (Tcl_Interp *interp, struct Tcl_Obj *listObj,
+                                             Tcl_Size first, Tcl_Size numToDelete,
+                                             Tcl_Size numToInsert,
+                                             struct Tcl_Obj *const insertObjs[]);
+typedef            int (Tcl_ObjTypeInOperatorProc) (Tcl_Interp *interp, struct Tcl_Obj *valueObj,
+                                             struct Tcl_Obj *listObj, int *boolResult);
+
+#ifndef TCL_NO_DEPRECATED
+#   define Tcl_PackageInitProc Tcl_LibraryInitProc
+#   define Tcl_PackageUnloadProc Tcl_LibraryUnloadProc
+#endif
 
 /*
  *----------------------------------------------------------------------------
@@ -594,10 +640,6 @@ 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;
@@ -614,12 +656,40 @@ typedef struct Tcl_ObjType {
 				/* Called to convert the object's internal rep
 				 * to this type. Frees the internal rep of the
 				 * old type. Returns TCL_ERROR on failure. */
+#if TCL_MAJOR_VERSION > 8
     size_t version;
+
+    /* List emulation functions - ObjType Version 1 */
+    Tcl_ObjTypeLengthProc *lengthProc;	     /* Return the [llength] of the
+					     ** AbstractList */
+    Tcl_ObjTypeIndexProc *indexProc;	     /* Return a value (Tcl_Obj) for
+					     ** [lindex $al $index] */
+    Tcl_ObjTypeSliceProc *sliceProc;	     /* Return an AbstractList for
+					     ** [lrange $al $start $end] */
+    Tcl_ObjTypeReverseProc *reverseProc;     /* Return an AbstractList for
+					     ** [lreverse $al] */
+    Tcl_ObjTypeGetElements *getElementsProc; /* Return an objv[] of all elements in
+					     ** the list */
+    Tcl_ObjTypeSetElement *setElementProc;   /* Replace the element at the indicie
+					     ** with the given valueObj. */
+    Tcl_ObjTypeReplaceProc *replaceProc;     /* Replace subset with subset */
+    Tcl_ObjTypeInOperatorProc *inOperProc;   /* "in" and "ni" expr list
+                                             ** operation Determine if the given
+                                             ** string value matches an element in
+                                             ** the list */
+#endif
 } Tcl_ObjType;
-#define TCL_OBJTYPE_V0 0 /* Pre-Tcl 9. Set to 0 so compiler will auto-init
-			  * when existing code that does not init this
-			  * field is compiled with Tcl9 headers */
-#define TCL_OBJTYPE_CURRENT TCL_OBJTYPE_V0
+
+#if TCL_MAJOR_VERSION > 8
+#   define TCL_OBJTYPE_V0 0, \
+	   0,0,0,0,0,0,0,0 /* Pre-Tcl 9 */
+#   define TCL_OBJTYPE_V1(a) offsetof(Tcl_ObjType, indexProc), \
+	   a,0,0,0,0,0,0,0 /* Tcl 9 Version 1 */
+#   define TCL_OBJTYPE_V2(a,b,c,d,e,f,g,h) sizeof(Tcl_ObjType),  \
+	   a,b,c,d,e,f,g,h /* Tcl 9 - AbstractLists */
+#else
+#   define TCL_OBJTYPE_V0 /* just empty */
+#endif
 
 /*
  * The following structure stores an internal representation (internalrep) for
@@ -650,7 +720,7 @@ typedef union Tcl_ObjInternalRep {	/* The internal representation: */
  * or both.
  */
 
-struct Tcl_Obj {
+typedef 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
@@ -670,9 +740,8 @@ struct Tcl_Obj {
 				 * internal rep. NULL indicates the object has
 				 * no internal rep (has no type). */
     Tcl_ObjInternalRep internalRep;	/* The internal representation: */
-};
+} Tcl_Obj;
 
-
 /*
  *----------------------------------------------------------------------------
  * The following definitions support Tcl's namespace facility. Note: the first
@@ -861,7 +930,11 @@ typedef struct Tcl_DString {
  * TCL_COMBINE Combine surrogates
  */
 
-#define TCL_COMBINE		0x1000000
+#if TCL_MAJOR_VERSION > 8
+#    define TCL_COMBINE		0x1000000
+#else
+#    define TCL_COMBINE		0
+#endif
 /*
  *----------------------------------------------------------------------------
  * Flag values passed to Tcl_RecordAndEval, Tcl_EvalObj, Tcl_EvalObjv.
@@ -975,7 +1048,11 @@ typedef struct Tcl_DString {
  */
 
 #ifndef TCL_HASH_TYPE
-#define TCL_HASH_TYPE size_t
+#if TCL_MAJOR_VERSION > 8
+#  define TCL_HASH_TYPE size_t
+#else
+#  define TCL_HASH_TYPE unsigned
+#endif
 #endif
 
 typedef struct Tcl_HashKeyType Tcl_HashKeyType;
@@ -1092,10 +1169,15 @@ 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
@@ -1261,7 +1343,11 @@ typedef void (Tcl_ScaleTimeProc) (Tcl_Time *timebuf, void *clientData);
  * interface.
  */
 
-#define TCL_CLOSE2PROC		NULL
+#if TCL_MAJOR_VERSION > 8
+#   define TCL_CLOSE2PROC		NULL
+#else
+#   define TCL_CLOSE2PROC		((void *) 1)
+#endif
 
 /*
  * Channel version tag. This was introduced in 8.3.2/8.4.
@@ -1811,10 +1897,12 @@ 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.
@@ -1833,6 +1921,9 @@ 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
@@ -1889,7 +1980,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 -	Obsolete.
+ * TCL_ENCODING_STOPONERROR -	Not used any more.
  * 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
@@ -1914,7 +2005,11 @@ typedef struct Tcl_EncodingType {
 
 #define TCL_ENCODING_START		0x01
 #define TCL_ENCODING_END		0x02
-#define TCL_ENCODING_STOPONERROR	0x0 /* Not used any more */
+#if TCL_MAJOR_VERSION > 8
+#   define TCL_ENCODING_STOPONERROR	0x0 /* Not used any more */
+#else
+#   define TCL_ENCODING_STOPONERROR	0x04
+#endif
 #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 */
@@ -1927,7 +2022,11 @@ typedef struct Tcl_EncodingType {
 #define TCL_ENCODING_PROFILE_TCL8     0x01000000
 #define TCL_ENCODING_PROFILE_STRICT   0x02000000
 #define TCL_ENCODING_PROFILE_REPLACE  0x03000000
-#define TCL_ENCODING_PROFILE_DEFAULT  TCL_ENCODING_PROFILE_STRICT
+#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
 
 /*
  * The following definitions are the error codes returned by the conversion
@@ -1961,15 +2060,18 @@ typedef struct Tcl_EncodingType {
 
 /*
  * The maximum number of bytes that are necessary to represent a single
- * Unicode character in UTF-8. The valid values are 3 and 4
- * (or perhaps 1 if we want to support a non-unicode enabled core). If > 3,
+ * Unicode character in UTF-8. The valid values are 3 and 4. If > 3,
  * then Tcl_UniChar must be 4-bytes in size (UCS-4) (the default). If == 3,
  * then Tcl_UniChar must be 2-bytes in size (UTF-16). Since Tcl 9.0, UCS-4
  * mode is the default and recommended mode.
  */
 
 #ifndef TCL_UTF_MAX
+#   if TCL_MAJOR_VERSION > 8
 #	define TCL_UTF_MAX		4
+#   else
+#	define TCL_UTF_MAX		3
+#   endif
 #endif
 
 /*
@@ -1977,12 +2079,16 @@ typedef struct Tcl_EncodingType {
  * reflected 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.
- */
+#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.
+     */
 typedef int Tcl_UniChar;
+#else
+typedef unsigned short Tcl_UniChar;
+#endif
 
 /*
  *----------------------------------------------------------------------------
@@ -2154,7 +2260,6 @@ 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)
 
 /*
  *----------------------------------------------------------------------------
@@ -2170,7 +2275,11 @@ typedef int (Tcl_NRPostProc) (void *data[], Tcl_Interp *interp,
  * stubs tables.
  */
 
-#define TCL_STUB_MAGIC		((int) 0xFCA3BACB + (int) sizeof(void *))
+#if TCL_MAJOR_VERSION > 8
+#   define TCL_STUB_MAGIC		((int) 0xFCA3BACB + (int) sizeof(void *))
+#else
+#   define TCL_STUB_MAGIC		((int) 0xFCA3BACF)
+#endif
 
 /*
  * The following function is required to be defined in all stubs aware
@@ -2192,7 +2301,19 @@ void *			TclStubCall(void *arg);
 #endif
 
 #ifdef USE_TCL_STUBS
-#if TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE
+#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
 #   define Tcl_InitStubs(interp, version, exact) \
 	(Tcl_InitStubs)(interp, version, \
 	    (exact)|(TCL_MAJOR_VERSION<<8)|(TCL_MINOR_VERSION<<16), \
@@ -2204,7 +2325,9 @@ void *			TclStubCall(void *arg);
 	    TCL_STUB_MAGIC)
 #endif
 #else
-#if TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE
+#if TCL_MAJOR_VERSION < 9
+#   error "Please define -DUSE_TCL_STUBS"
+#elif 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))
@@ -2236,6 +2359,9 @@ 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);
@@ -2250,7 +2376,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)
+#if defined(USE_TCL_STUBS) && (TCL_MAJOR_VERSION > 8)
 #define Tcl_SetPanicProc(panicProc) \
     TclInitStubTable(((const char *(*)(Tcl_PanicProc *))TclStubCall((void *)panicProc))(panicProc))
 #define Tcl_InitSubsystems() \
@@ -2347,6 +2473,25 @@ EXTERN const char *TclZipfs_AppHook(int *argc, char ***argv);
 #   undef Tcl_IsShared
 #   define Tcl_IsShared(objPtr) \
 	Tcl_DbIsShared(objPtr, __FILE__, __LINE__)
+/*
+ * Free the Obj by effectively doing:
+ *
+ *   Tcl_IncrRefCount(objPtr);
+ *   Tcl_DecrRefCount(objPtr);
+ *
+ * This will free the obj if there are no references to the obj.
+ */
+#   define Tcl_BounceRefCount(objPtr) \
+    TclBounceRefCount(objPtr, __FILE__, __LINE__)
+
+static inline void TclBounceRefCount(Tcl_Obj* objPtr, const char* fn, int line)
+{
+    if (objPtr) {
+        if ((objPtr)->refCount == 0) {
+            Tcl_DbDecrRefCount(objPtr, fn, line);
+	}
+    }
+}
 #else
 #   undef Tcl_IncrRefCount
 #   define Tcl_IncrRefCount(objPtr) \
@@ -2366,6 +2511,24 @@ EXTERN const char *TclZipfs_AppHook(int *argc, char ***argv);
 #   undef Tcl_IsShared
 #   define Tcl_IsShared(objPtr) \
 	((objPtr)->refCount > 1)
+
+/*
+ * Declare that obj will no longer be used or referenced.
+ * This will release the obj if there is no referece count,
+ * otherwise let it be.
+ */
+#   define Tcl_BounceRefCount(objPtr)     \
+    TclBounceRefCount(objPtr);
+
+static inline void TclBounceRefCount(Tcl_Obj* objPtr)
+{
+    if (objPtr) {
+        if ((objPtr)->refCount == 0) {
+            Tcl_DecrRefCount(objPtr);
+	}
+    }
+}
+
 #endif
 
 /*

generic/tclArithSeries.h

@@ -1,48 +0,0 @@
-/*
- * tclArithSeries.h --
- *
- *     This file contains the ArithSeries concrete abstract list
- *     implementation. It implements the inner workings of the lseq command.
- *
- * Copyright © 2022 Brian S. Griffin.
- *
- * See the file "license.terms" for information on usage and redistribution of
- * this file, and for a DISCLAIMER OF ALL WARRANTIES.
- */
-
-/*
- * The structure used for the ArithSeries internal representation.
- * Note that the len can in theory be always computed by start,end,step
- * but it's faster to cache it inside the internal representation.
- */
-typedef struct {
-    Tcl_WideInt len;
-    Tcl_Obj **elements;
-    int isDouble;
-    Tcl_WideInt start;
-    Tcl_WideInt end;
-    Tcl_WideInt step;
-} ArithSeries;
-typedef struct {
-    Tcl_WideInt len;
-    Tcl_Obj **elements;
-    int isDouble;
-    double start;
-    double end;
-    double step;
-    int precision;
-} ArithSeriesDbl;
-
-
-MODULE_SCOPE int 	TclNewArithSeriesObj(Tcl_Interp *interp,
-			    Tcl_Obj **arithSeriesObj, int useDoubles,
-			    Tcl_Obj *startObj, Tcl_Obj *endObj,
-			    Tcl_Obj *stepObj, Tcl_Obj *lenObj);
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */

generic/tclAssembly.c

@@ -224,7 +224,7 @@ typedef struct AssemblyEnv {
 				 * offsets of the labels. */
     Tcl_Size cmdLine;	/* Current line number within the assembly
 				 * code */
-    int* clNext;		/* Invisible continuation line for
+    Tcl_Size* clNext;	/* Invisible continuation line for
 				 * [info frame] */
     BasicBlock* head_bb;	/* First basic block in the code */
     BasicBlock* curr_bb;	/* Current basic block */

generic/tclBasic.c

@@ -5147,7 +5147,7 @@ TclEvalEx(
 				 * evaluation of the script. Only
 				 * TCL_EVAL_GLOBAL is currently supported. */
     Tcl_Size line,		/* The line the script starts on. */
-    int *clNextOuter,		/* Information about an outer context for */
+    Tcl_Size *clNextOuter,		/* Information about an outer context for */
     const char *outerScript)	/* continuation line data. This is set only in
 				 * TclSubstTokens(), to properly handle
 				 * [...]-nested commands. The 'outerScript'
@@ -5169,7 +5169,8 @@ TclEvalEx(
     const char *p, *next;
     const int minObjs = 20;
     Tcl_Obj **objv, **objvSpace;
-    int *expand, *lines, *lineSpace;
+    int *expand;
+    Tcl_Size *lines, *lineSpace;
     Tcl_Token *tokenPtr;
     int expandRequested, code = TCL_OK;
     Tcl_Size bytesLeft, commandLength;
@@ -5187,10 +5188,10 @@ TclEvalEx(
     Tcl_Obj **stackObjArray = (Tcl_Obj **)
 	    TclStackAlloc(interp, minObjs * sizeof(Tcl_Obj *));
     int *expandStack = (int *)TclStackAlloc(interp, minObjs * sizeof(int));
-    int *linesStack = (int *)TclStackAlloc(interp, minObjs * sizeof(int));
+    Tcl_Size *linesStack = (Tcl_Size *)TclStackAlloc(interp, minObjs * sizeof(Tcl_Size));
 				/* TIP #280 Structures for tracking of command
 				 * locations. */
-    int *clNext = NULL;		/* Pointer for the tracking of invisible
+    Tcl_Size *clNext = NULL;		/* Pointer for the tracking of invisible
 				 * continuation lines. Initialized only if the
 				 * caller gave us a table of locations to
 				 * track, via scriptCLLocPtr. It always refers
@@ -5314,7 +5315,7 @@ TclEvalEx(
 
 	    Tcl_Size wordLine = line;
 	    const char *wordStart = parsePtr->commandStart;
-	    int *wordCLNext = clNext;
+	    Tcl_Size *wordCLNext = clNext;
 	    Tcl_Size objectsNeeded = 0;
 	    Tcl_Size numWords = parsePtr->numWords;
 
@@ -5325,7 +5326,7 @@ TclEvalEx(
 	    if (numWords > minObjs) {
 		expand =    (int *)Tcl_Alloc(numWords * sizeof(int));
 		objvSpace = (Tcl_Obj **)Tcl_Alloc(numWords * sizeof(Tcl_Obj *));
-		lineSpace = (int *)Tcl_Alloc(numWords * sizeof(int));
+		lineSpace = (Tcl_Size *)Tcl_Alloc(numWords * sizeof(Tcl_Size));
 	    }
 	    expandRequested = 0;
 	    objv = objvSpace;
@@ -5351,7 +5352,7 @@ TclEvalEx(
 		wordStart = tokenPtr->start;
 
 		lines[objectsUsed] = TclWordKnownAtCompileTime(tokenPtr, NULL)
-			? (int)wordLine : -1;
+			? wordLine : -1;
 
 		if (eeFramePtr->type == TCL_LOCATION_SOURCE) {
 		    iPtr->evalFlags |= TCL_EVAL_FILE;
@@ -5417,14 +5418,14 @@ TclEvalEx(
 		 */
 
 		Tcl_Obj **copy = objvSpace;
-		int *lcopy = lineSpace;
-		int wordIdx = numWords;
-		int objIdx = objectsNeeded - 1;
+		Tcl_Size *lcopy = lineSpace;
+		Tcl_Size wordIdx = numWords;
+		Tcl_Size objIdx = objectsNeeded - 1;
 
 		if ((numWords > minObjs) || (objectsNeeded > minObjs)) {
 		    objv = objvSpace =
 			    (Tcl_Obj **)Tcl_Alloc(objectsNeeded * sizeof(Tcl_Obj *));
-		    lines = lineSpace = (int *)Tcl_Alloc(objectsNeeded * sizeof(int));
+		    lines = lineSpace = (Tcl_Size *)Tcl_Alloc(objectsNeeded * sizeof(Tcl_Size));
 		}
 
 		objectsUsed = 0;
@@ -5659,7 +5660,7 @@ TclAdvanceLines(
 void
 TclAdvanceContinuations(
     Tcl_Size *line,
-    int **clNextPtrPtr,
+    Tcl_Size **clNextPtrPtr,
     int loc)
 {
     /*
@@ -5837,7 +5838,7 @@ TclArgumentBCEnter(
     int objc,
     void *codePtr,
     CmdFrame *cfPtr,
-    int cmd,
+    Tcl_Size cmd,
     Tcl_Size pc)
 {
     ExtCmdLoc *eclPtr;
@@ -6152,11 +6153,7 @@ TclNREvalObjEx(
 	 */
 
 	Tcl_IncrRefCount(objPtr);
-	listPtr = TclDuplicatePureObj(interp, objPtr, tclListType);
-	if (!listPtr) {
-	    Tcl_DecrRefCount(objPtr);
-	    return TCL_ERROR;
-	}
+	listPtr = TclListObjCopy(interp, objPtr);
 	Tcl_IncrRefCount(listPtr);
 
 	if (word != INT_MIN) {
@@ -7050,7 +7047,7 @@ ExprCeilFunc(
     code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
 #ifdef ACCEPT_NAN
     if (code != TCL_OK) {
-	const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], tclDoubleType);
+	const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType);
 
 	if (irPtr) {
 	    Tcl_SetObjResult(interp, objv[1]);
@@ -7090,7 +7087,7 @@ ExprFloorFunc(
     code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
 #ifdef ACCEPT_NAN
     if (code != TCL_OK) {
-	const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], tclDoubleType);
+	const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType);
 
 	if (irPtr) {
 	    Tcl_SetObjResult(interp, objv[1]);
@@ -7236,7 +7233,7 @@ ExprSqrtFunc(
     code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
 #ifdef ACCEPT_NAN
     if (code != TCL_OK) {
-	const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], tclDoubleType);
+	const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType);
 
 	if (irPtr) {
 	    Tcl_SetObjResult(interp, objv[1]);
@@ -7290,7 +7287,7 @@ ExprUnaryFunc(
     code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
 #ifdef ACCEPT_NAN
     if (code != TCL_OK) {
-	const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], tclDoubleType);
+	const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType);
 
 	if (irPtr) {
 	    d = irPtr->doubleValue;
@@ -7354,7 +7351,7 @@ ExprBinaryFunc(
     code = Tcl_GetDoubleFromObj(interp, objv[1], &d1);
 #ifdef ACCEPT_NAN
     if (code != TCL_OK) {
-	const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], tclDoubleType);
+	const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType);
 
 	if (irPtr) {
 	    d1 = irPtr->doubleValue;
@@ -7369,7 +7366,7 @@ ExprBinaryFunc(
     code = Tcl_GetDoubleFromObj(interp, objv[2], &d2);
 #ifdef ACCEPT_NAN
     if (code != TCL_OK) {
-	const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], tclDoubleType);
+	const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objv[1], &tclDoubleType);
 
 	if (irPtr) {
 	    d2 = irPtr->doubleValue;
@@ -7530,7 +7527,7 @@ ExprDoubleFunc(
     }
     if (Tcl_GetDoubleFromObj(interp, objv[1], &dResult) != TCL_OK) {
 #ifdef ACCEPT_NAN
-	if (TclHasInternalRep(objv[1], tclDoubleType)) {
+	if (TclHasInternalRep(objv[1], &tclDoubleType)) {
 	    Tcl_SetObjResult(interp, objv[1]);
 	    return TCL_OK;
 	}

generic/tclBinary.c

@@ -381,6 +381,35 @@ 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
 
 /*
  *----------------------------------------------------------------------
@@ -480,7 +509,7 @@ MakeByteArray(
 
     for (; src < srcEnd && dst < dstEnd; ) {
 	int ch;
-	int count = Tcl_UtfToUniChar(src, &ch);
+	int count = TclUtfToUCS4(src, &ch);
 
 	if (ch > 255) {
 	    proper = 0;
@@ -1972,7 +2001,7 @@ FormatNumber(
 	 */
 
 	if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) {
-	    const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(src, tclDoubleType);
+	    const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(src, &tclDoubleType);
 	    if (irPtr == NULL) {
 		return TCL_ERROR;
 	    }
@@ -1992,7 +2021,7 @@ FormatNumber(
 	 */
 
 	if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) {
-	    const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(src, tclDoubleType);
+	    const Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(src, &tclDoubleType);
 
 	    if (irPtr == NULL) {
 		return TCL_ERROR;
@@ -2532,7 +2561,7 @@ BinaryDecodeHex(
     if (pure) {
 	ucs4 = c;
     } else {
-	Tcl_UtfToUniChar((const char *)(data - 1), &ucs4);
+	TclUtfToUCS4((const char *)(data - 1), &ucs4);
     }
     TclDecrRefCount(resultObj);
     Tcl_SetObjResult(interp, Tcl_ObjPrintf(
@@ -2600,7 +2629,7 @@ BinaryEncode64(
 	}
 	switch (index) {
 	case OPT_MAXLEN:
-	    if (Tcl_GetSizeIntFromObj(interp, objv[i + 1], &maxlen) != TCL_OK) {
+	    if (TclGetSizeIntFromObj(interp, objv[i + 1], &maxlen) != TCL_OK) {
 		return TCL_ERROR;
 	    }
 	    if (maxlen < 0) {
@@ -2997,7 +3026,7 @@ BinaryDecodeUu(
     if (pure) {
 	ucs4 = c;
     } else {
-	Tcl_UtfToUniChar((const char *)(data - 1), &ucs4);
+	TclUtfToUCS4((const char *)(data - 1), &ucs4);
     }
     Tcl_SetObjResult(interp, Tcl_ObjPrintf(
 	    "invalid uuencode character \"%c\" (U+%06X) at position %"
@@ -3172,7 +3201,7 @@ BinaryDecode64(
 	 * of a multi-byte character. */
 
 	/* Safe because we know data is NUL-terminated */
-	Tcl_UtfToUniChar((const char *)(data - 1), &ucs4);
+	TclUtfToUCS4((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)) {
+    if (TclHasInternalRep(objv[1], &tclBignumType)) {
 	Tcl_SetObjResult(interp, lit[LIT_INTEGER_VALUE_TOO_LARGE]);
 	return TCL_ERROR;
     }

generic/tclCmdAH.c

@@ -434,7 +434,7 @@ EncodingConvertParseOptions (
     Tcl_Encoding encoding;
     Tcl_Obj *dataObj;
     Tcl_Obj *failVarObj;
-    int profile = TCL_ENCODING_PROFILE_STRICT;
+    int profile = TCL_ENCODING_PROFILE_TCL8;
 
     /*
      * Possible combinations:
@@ -551,11 +551,11 @@ EncodingConvertfromObjCmd(
     /* NOTE: ds must be freed beyond this point even on error */
     switch (result) {
     case TCL_OK:
-        errorLocation = TCL_INDEX_NONE;
-        break;
+	errorLocation = TCL_INDEX_NONE;
+	break;
     case TCL_ERROR:
 	/* Error in parameters. Should not happen. interp will have error */
-        Tcl_DStringFree(&ds);
+	Tcl_DStringFree(&ds);
 	return TCL_ERROR;
     default:
 	/*
@@ -565,10 +565,10 @@ EncodingConvertfromObjCmd(
 	 * what could be decoded and the returned error location.
 	 */
 	if (failVarObj == NULL) {
-            Tcl_DStringFree(&ds);
+	    Tcl_DStringFree(&ds);
 	    return TCL_ERROR;
 	}
-        break;
+	break;
     }
 
     /*
@@ -653,7 +653,7 @@ EncodingConverttoObjCmd(
 	break;
     case TCL_ERROR:
 	/* Error in parameters. Should not happen. interp will have error */
-        Tcl_DStringFree(&ds);
+	Tcl_DStringFree(&ds);
 	return TCL_ERROR;
     default:
 	/*
@@ -663,10 +663,10 @@ EncodingConverttoObjCmd(
 	 * what could be decoded and the returned error location.
 	 */
 	if (failVarObj == NULL) {
-            Tcl_DStringFree(&ds);
+	    Tcl_DStringFree(&ds);
 	    return TCL_ERROR;
 	}
-        break;
+	break;
     }
     /*
      * TCL_OK or a TCL_CONVERT_* error where the caller wants back as much
@@ -1199,10 +1199,10 @@ FileAttrAccessTimeCmd(
 #if defined(_WIN32)
     /* We use a value of 0 to indicate the access time not available */
     if (Tcl_GetAccessTimeFromStat(&buf) == 0) {
-        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-                             "could not get access time for file \"%s\"",
-                             TclGetString(objv[1])));
-        return TCL_ERROR;
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			     "could not get access time for file \"%s\"",
+			     TclGetString(objv[1])));
+	return TCL_ERROR;
     }
 #endif
 
@@ -1281,10 +1281,10 @@ FileAttrModifyTimeCmd(
 #if defined(_WIN32)
     /* We use a value of 0 to indicate the modification time not available */
     if (Tcl_GetModificationTimeFromStat(&buf) == 0) {
-        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-                             "could not get modification time for file \"%s\"",
-                             TclGetString(objv[1])));
-        return TCL_ERROR;
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			     "could not get modification time for file \"%s\"",
+			     TclGetString(objv[1])));
+	return TCL_ERROR;
     }
 #endif
     if (objc == 3) {
@@ -2324,34 +2324,34 @@ StoreStatData(
     unsigned short mode;
 
     if (varName == NULL) {
-        TclNewObj(result);
-        Tcl_IncrRefCount(result);
+	TclNewObj(result);
+	Tcl_IncrRefCount(result);
 #define DOBJPUT(key, objValue)                  \
         Tcl_DictObjPut(NULL, result,            \
             Tcl_NewStringObj((key), -1),        \
             (objValue));
-        DOBJPUT("dev",	Tcl_NewWideIntObj((long)statPtr->st_dev));
-        DOBJPUT("ino",	Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_ino));
-        DOBJPUT("nlink",	Tcl_NewWideIntObj((long)statPtr->st_nlink));
-        DOBJPUT("uid",	Tcl_NewWideIntObj((long)statPtr->st_uid));
-        DOBJPUT("gid",	Tcl_NewWideIntObj((long)statPtr->st_gid));
-        DOBJPUT("size",	Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_size));
+	DOBJPUT("dev",	Tcl_NewWideIntObj((long)statPtr->st_dev));
+	DOBJPUT("ino",	Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_ino));
+	DOBJPUT("nlink",	Tcl_NewWideIntObj((long)statPtr->st_nlink));
+	DOBJPUT("uid",	Tcl_NewWideIntObj((long)statPtr->st_uid));
+	DOBJPUT("gid",	Tcl_NewWideIntObj((long)statPtr->st_gid));
+	DOBJPUT("size",	Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_size));
 #ifdef HAVE_STRUCT_STAT_ST_BLOCKS
-        DOBJPUT("blocks",	Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_blocks));
+	DOBJPUT("blocks",	Tcl_NewWideIntObj((Tcl_WideInt)statPtr->st_blocks));
 #endif
 #ifdef HAVE_STRUCT_STAT_ST_BLKSIZE
-        DOBJPUT("blksize", Tcl_NewWideIntObj((long)statPtr->st_blksize));
+	DOBJPUT("blksize", Tcl_NewWideIntObj((long)statPtr->st_blksize));
 #endif
-        DOBJPUT("atime",	Tcl_NewWideIntObj(Tcl_GetAccessTimeFromStat(statPtr)));
-        DOBJPUT("mtime",	Tcl_NewWideIntObj(Tcl_GetModificationTimeFromStat(statPtr)));
-        DOBJPUT("ctime",	Tcl_NewWideIntObj(Tcl_GetChangeTimeFromStat(statPtr)));
-        mode = (unsigned short) statPtr->st_mode;
-        DOBJPUT("mode",	Tcl_NewWideIntObj(mode));
-        DOBJPUT("type",	Tcl_NewStringObj(GetTypeFromMode(mode), -1));
+	DOBJPUT("atime",	Tcl_NewWideIntObj(Tcl_GetAccessTimeFromStat(statPtr)));
+	DOBJPUT("mtime",	Tcl_NewWideIntObj(Tcl_GetModificationTimeFromStat(statPtr)));
+	DOBJPUT("ctime",	Tcl_NewWideIntObj(Tcl_GetChangeTimeFromStat(statPtr)));
+	mode = (unsigned short) statPtr->st_mode;
+	DOBJPUT("mode",	Tcl_NewWideIntObj(mode));
+	DOBJPUT("type",	Tcl_NewStringObj(GetTypeFromMode(mode), -1));
 #undef DOBJPUT
-        Tcl_SetObjResult(interp, result);
-        Tcl_DecrRefCount(result);
-        return TCL_OK;
+	Tcl_SetObjResult(interp, result);
+	Tcl_DecrRefCount(result);
+	return TCL_OK;
     }
 
     /*
@@ -2787,9 +2787,8 @@ EachloopCmd(
     for (i=0 ; i<numLists ; i++) {
 	/* List */
 	/* Variables */
-	statePtr->vCopyList[i] = TclDuplicatePureObj(
-	    interp, objv[1+i*2], tclListType);
-	if (!statePtr->vCopyList[i]) {
+	statePtr->vCopyList[i] = TclListObjCopy(interp, objv[1+i*2]);
+	if (statePtr->vCopyList[i] == NULL) {
 	    result = TCL_ERROR;
 	    goto done;
 	}
@@ -2813,26 +2812,19 @@ EachloopCmd(
 	    &statePtr->varcList[i], &statePtr->varvList[i]);
 
 	/* Values */
-	if (TclObjectHasInterface(objv[2+i*2], list, length)) {
-	    int status;
+	if (TclObjTypeHasProc(objv[2+i*2],indexProc)) {
+	    /* Special case for AbstractList */
 	    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 */
-	    TclObjectDispatchNoDefault(interp, status, statePtr->aCopyList[i], list,
-		length, interp, statePtr->aCopyList[i], &statePtr->argcList[i]);
-	    if (status != TCL_OK) {
-		result = TCL_ERROR;
-		goto done;
-	    }
+	    statePtr->argcList[i] = TclObjTypeLength(statePtr->aCopyList[i]);
 	} else {
 	    /* List values */
-	    statePtr->aCopyList[i] = TclDuplicatePureObj(
-		interp, objv[2+i*2], tclListType);
-	    if (!statePtr->aCopyList[i]) {
+	    statePtr->aCopyList[i] = TclListObjCopy(interp, objv[2+i*2]);
+	    if (statePtr->aCopyList[i] == NULL) {
 		result = TCL_ERROR;
 		goto done;
 	    }
@@ -2969,20 +2961,18 @@ ForeachAssignments(
     Tcl_Obj *valuePtr, *varValuePtr;
 
     for (i=0 ; i<statePtr->numLists ; i++) {
-	TCL_UNUSEDVAR(int status);
-	int hasindexinterface = TclObjectHasInterface(
-	    statePtr->aCopyList[i], list, index);
+	int isAbstractList =
+		TclObjTypeHasProc(statePtr->aCopyList[i],indexProc) != NULL;
+
 	for (v=0 ; v<statePtr->varcList[i] ; v++) {
 	    k = statePtr->index[i]++;
 	    if (k < statePtr->argcList[i]) {
-		if (hasindexinterface) {
-		    TclObjectDispatchNoDefault(interp, status, statePtr->aCopyList[i], list,
-			index, interp, statePtr->aCopyList[i], k, &valuePtr);
-		    if (valuePtr == NULL) {
+		if (isAbstractList) {
+		    if (TclObjTypeIndex(interp, statePtr->aCopyList[i], k, &valuePtr) != TCL_OK) {
 			Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
-			"\n    (setting %s loop variable \"%s\")",
-			(statePtr->resultList != NULL ? "lmap" : "foreach"),
-			TclGetString(statePtr->varvList[i][v])));
+				"\n    (setting %s loop variable \"%s\")",
+				(statePtr->resultList != NULL ? "lmap" : "foreach"),
+				TclGetString(statePtr->varvList[i][v])));
 			return TCL_ERROR;
 		    }
 		} else {

generic/tclCmdMZ.c

@@ -24,7 +24,6 @@
 
 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;
@@ -1193,6 +1192,11 @@ Tcl_SplitObjCmd(
 	return TCL_ERROR;
     }
 
+    if (splitCharLen == 0) {
+	Tcl_SetObjResult(interp, TclNewStringListObj(interp, objv[1]));
+	return TCL_OK;
+    }
+
     stringPtr = Tcl_GetStringFromObj(objv[1], &stringLen);
     end = stringPtr + stringLen;
     TclNewObj(listPtr);
@@ -1201,40 +1205,6 @@ Tcl_SplitObjCmd(
 	/*
 	 * Do nothing.
 	 */
-    } else if (splitCharLen == 0) {
-	Tcl_HashTable charReuseTable;
-	Tcl_HashEntry *hPtr;
-	int isNew;
-
-	/*
-	 * Handle the special case of splitting on every character.
-	 *
-	 * Uses a hash table to ensure that each kind of character has only
-	 * one Tcl_Obj instance (multiply-referenced) in the final list. This
-	 * is a *major* win when splitting on a long string (especially in the
-	 * megabyte range!) - DKF
-	 */
-
-	Tcl_InitHashTable(&charReuseTable, TCL_ONE_WORD_KEYS);
-
-	for ( ; stringPtr < end; stringPtr += len) {
-	    len = Tcl_UtfToUniChar(stringPtr, &ch);
-	    hPtr = Tcl_CreateHashEntry(&charReuseTable, INT2PTR(ch), &isNew);
-	    if (isNew) {
-		TclNewStringObj(objPtr, stringPtr, len);
-
-		/*
-		 * Don't need to fiddle with refcount...
-		 */
-
-		Tcl_SetHashValue(hPtr, objPtr);
-	    } else {
-		objPtr = (Tcl_Obj *)Tcl_GetHashValue(hPtr);
-	    }
-	    Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
-	}
-	Tcl_DeleteHashTable(&charReuseTable);
-
     } else if (splitCharLen == 1) {
 	const char *p;
 
@@ -1264,9 +1234,9 @@ Tcl_SplitObjCmd(
 	splitEnd = splitChars + splitCharLen;
 
 	for (element = stringPtr; stringPtr < end; stringPtr += len) {
-	    len = Tcl_UtfToUniChar(stringPtr, &ch);
+	    len = TclUtfToUCS4(stringPtr, &ch);
 	    for (p = splitChars; p < splitEnd; p += splitLen) {
-		splitLen = Tcl_UtfToUniChar(p, &splitChar);
+		splitLen = TclUtfToUCS4(p, &splitChar);
 		if (ch == splitChar) {
 		    TclNewStringObj(objPtr, element, stringPtr - element);
 		    Tcl_ListObjAppendElement(NULL, listPtr, objPtr);
@@ -1312,7 +1282,7 @@ StringFirstCmd(
 
     if (objc < 3 || objc > 4) {
 	Tcl_WrongNumArgs(interp, 1, objv,
-	    "needleString haystackString ?startIndex?");
+		"needleString haystackString ?startIndex?");
 	return TCL_ERROR;
     }
 
@@ -1403,51 +1373,44 @@ StringIndexCmd(
 	return TCL_ERROR;
     }
 
-    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);
+    /*
+     * 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) {
 	    return TCL_OK;
 	}
-    } else {
+
 	/*
-	 * Get the char length to calculate what 'end' means.
+	 * If we have a ByteArray object, we're careful to generate a new
+	 * bytearray for a result.
 	 */
 
-	end = Tcl_GetCharLength(objv[1]) - 1;
-	if (TclGetIntForIndexM(interp, objv[2], end, &index) != TCL_OK) {
-	    return TCL_ERROR;
-	}
+	if (TclIsPureByteArray(objv[1])) {
+	    unsigned char uch = UCHAR(ch);
 
-	if ((index >= 0) && (index <= end)) {
-	    int ch = Tcl_GetUniChar(objv[1], index);
+	    Tcl_SetObjResult(interp, Tcl_NewByteArrayObj(&uch, 1));
+	} else {
+	    char buf[4] = "";
 
-	    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));
+	    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));
 	}
-	return TCL_OK;
     }
+    return TCL_OK;
 }
 
 /*
@@ -1620,7 +1583,7 @@ StringIsCmd(
     case STR_IS_BOOL:
     case STR_IS_TRUE:
     case STR_IS_FALSE:
-	if (!TclHasInternalRep(objPtr, tclBooleanType)
+	if (!TclHasInternalRep(objPtr, &tclBooleanType)
 		&& (TCL_OK != TclSetBooleanFromAny(NULL, objPtr))) {
 	    if (strict) {
 		result = 0;
@@ -1689,9 +1652,9 @@ StringIsCmd(
 	chcomp = Tcl_UniCharIsDigit;
 	break;
     case STR_IS_DOUBLE: {
-	if (TclHasInternalRep(objPtr, tclDoubleType) ||
-		TclHasInternalRep(objPtr, tclIntType) ||
-		TclHasInternalRep(objPtr, tclBignumType)) {
+	if (TclHasInternalRep(objPtr, &tclDoubleType) ||
+		TclHasInternalRep(objPtr, &tclIntType) ||
+		TclHasInternalRep(objPtr, &tclBignumType)) {
 	    break;
 	}
 	string1 = Tcl_GetStringFromObj(objPtr, &length1);
@@ -1720,8 +1683,8 @@ StringIsCmd(
 	break;
     case STR_IS_INT:
     case STR_IS_ENTIER:
-	if (TclHasInternalRep(objPtr, tclIntType) ||
-		TclHasInternalRep(objPtr, tclBignumType)) {
+	if (TclHasInternalRep(objPtr, &tclIntType) ||
+		TclHasInternalRep(objPtr, &tclBignumType)) {
 	    break;
 	}
 	string1 = Tcl_GetStringFromObj(objPtr, &length1);
@@ -1904,7 +1867,7 @@ StringIsCmd(
 	for (; string1 < end; string1 += length2, failat++) {
 	    int ucs4;
 
-	    length2 = Tcl_UtfToUniChar(string1, &ucs4);
+	    length2 = TclUtfToUCS4(string1, &ucs4);
 	    if (!chcomp(ucs4)) {
 		result = 0;
 		break;
@@ -2532,7 +2495,7 @@ StringStartCmd(
     if (index > 0) {
 	p = &string[index];
 
-	ch = *p;
+	(void)TclUniCharToUCS4(p, &ch);
 	for (cur = index; cur != TCL_INDEX_NONE; cur--) {
 	    int delta = 0;
 	    const Tcl_UniChar *next;
@@ -2541,11 +2504,10 @@ StringStartCmd(
 		break;
 	    }
 
-		next = p > string ? p - 1 : p;
+	    next = TclUCS4Prev(p, string);
 	    do {
 		next += delta;
-		delta = 1;
-		ch = *next;
+		delta = TclUniCharToUCS4(next, &ch);
 	    } while (next + delta < p);
 	    p = next;
 	}
@@ -2603,7 +2565,7 @@ StringEndCmd(
 	p = &string[index];
 	end = string+length;
 	for (cur = index; p < end; cur++) {
-	    ch = *p++;
+	    p += TclUniCharToUCS4(p, &ch);
 	    if (!Tcl_UniCharIsWordChar(ch)) {
 		break;
 	    }
@@ -3857,7 +3819,7 @@ TclNRSwitchObjCmd(
 	if (ctxPtr->type == TCL_LOCATION_SOURCE && ctxPtr->line[bidx] >= 0) {
 	    int bline = ctxPtr->line[bidx];
 
-	    ctxPtr->line = (int *)Tcl_Alloc(objc * sizeof(int));
+	    ctxPtr->line = (Tcl_Size *)Tcl_Alloc(objc * sizeof(Tcl_Size));
 	    ctxPtr->nline = objc;
 	    TclListLines(blist, bline, objc, ctxPtr->line, objv);
 	} else {
@@ -3871,7 +3833,7 @@ TclNRSwitchObjCmd(
 
 	    int k;
 
-	    ctxPtr->line = (int *)Tcl_Alloc(objc * sizeof(int));
+	    ctxPtr->line = (Tcl_Size *)Tcl_Alloc(objc * sizeof(Tcl_Size));
 	    ctxPtr->nline = objc;
 	    for (k=0; k < objc; k++) {
 		ctxPtr->line[k] = -1;
@@ -5311,17 +5273,17 @@ TclListLines(
 				 * structure. Assumed to be valid. Assumed to
 				 * contain n elements. */
     Tcl_Size line,		/* Line the list as a whole starts on. */
-    int n,			/* #elements in lines */
-    int *lines,			/* Array of line numbers, to fill. */
+    Tcl_Size n,			/* #elements in lines */
+    Tcl_Size *lines,		/* Array of line numbers, to fill. */
     Tcl_Obj *const *elems)      /* The list elems as Tcl_Obj*, in need of
 				 * derived continuation data */
 {
     const char *listStr = TclGetString(listObj);
     const char *listHead = listStr;
-    int i, length = strlen(listStr);
+    Tcl_Size i, length = strlen(listStr);
     const char *element = NULL, *next = NULL;
     ContLineLoc *clLocPtr = TclContinuationsGet(listObj);
-    int *clNext = (clLocPtr ? &clLocPtr->loc[0] : NULL);
+    Tcl_Size *clNext = (clLocPtr ? &clLocPtr->loc[0] : NULL);
 
     for (i = 0; i < n; i++) {
 	TclFindElement(NULL, listStr, length, &element, &next, NULL, NULL);

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 *indexPtr.
+ *	to *index.
  *
  *----------------------------------------------------------------------
  */
@@ -1411,13 +1411,6 @@ 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/tclCompCmdsSZ.c

@@ -41,12 +41,12 @@ static int		CompileUnaryOpCmd(Tcl_Interp *interp,
 			    CompileEnv *envPtr);
 static void		IssueSwitchChainedTests(Tcl_Interp *interp,
 			    CompileEnv *envPtr, int mode, int noCase,
-			    int numWords, Tcl_Token **bodyToken,
-				int *bodyLines, int **bodyNext);
+			    Tcl_Size numWords, Tcl_Token **bodyToken,
+				Tcl_Size *bodyLines, Tcl_Size **bodyNext);
 static void		IssueSwitchJumpTable(Tcl_Interp *interp,
 			    CompileEnv *envPtr, int numWords,
-				Tcl_Token **bodyToken, int *bodyLines,
-				int **bodyContLines);
+				Tcl_Token **bodyToken, Tcl_Size *bodyLines,
+				Tcl_Size **bodyContLines);
 static int		IssueTryClausesInstructions(Tcl_Interp *interp,
 			    CompileEnv *envPtr, Tcl_Token *bodyToken,
 			    int numHandlers, int *matchCodes,
@@ -1800,14 +1800,14 @@ TclCompileSwitchCmd(
 
     Tcl_Token *bodyTokenArray;	/* Array of real pattern list items. */
     Tcl_Token **bodyToken;	/* Array of pointers to pattern list items. */
-    int *bodyLines;		/* Array of line numbers for body list
+    Tcl_Size *bodyLines;	/* Array of line numbers for body list
 				 * items. */
-    int **bodyContLines;	/* Array of continuation line info. */
+    Tcl_Size **bodyContLines;	/* Array of continuation line info. */
     int noCase;			/* Has the -nocase flag been given? */
     int foundMode = 0;		/* Have we seen a mode flag yet? */
     int i, valueIndex;
     int result = TCL_ERROR;
-    int *clNext = envPtr->clNext;
+    Tcl_Size *clNext = envPtr->clNext;
 
     /*
      * Only handle the following versions:
@@ -1964,8 +1964,8 @@ TclCompileSwitchCmd(
 	}
 	bodyTokenArray = (Tcl_Token *)Tcl_Alloc(sizeof(Tcl_Token) * maxLen);
 	bodyToken = (Tcl_Token **)Tcl_Alloc(sizeof(Tcl_Token *) * maxLen);
-	bodyLines = (int *)Tcl_Alloc(sizeof(int) * maxLen);
-	bodyContLines = (int **)Tcl_Alloc(sizeof(int*) * maxLen);
+	bodyLines = (Tcl_Size *)Tcl_Alloc(sizeof(Tcl_Size) * maxLen);
+	bodyContLines = (Tcl_Size **)Tcl_Alloc(sizeof(Tcl_Size*) * maxLen);
 
 	bline = mapPtr->loc[eclIndex].line[valueIndex+1];
 	numWords = 0;
@@ -2025,8 +2025,8 @@ TclCompileSwitchCmd(
 	 */
 
 	bodyToken = (Tcl_Token **)Tcl_Alloc(sizeof(Tcl_Token *) * numWords);
-	bodyLines = (int *)Tcl_Alloc(sizeof(int) * numWords);
-	bodyContLines = (int **)Tcl_Alloc(sizeof(int*) * numWords);
+	bodyLines = (Tcl_Size *)Tcl_Alloc(sizeof(Tcl_Size) * numWords);
+	bodyContLines = (Tcl_Size **)Tcl_Alloc(sizeof(Tcl_Size*) * numWords);
 	bodyTokenArray = NULL;
 	for (i=0 ; i<numWords ; i++) {
 	    /*
@@ -2116,13 +2116,13 @@ IssueSwitchChainedTests(
     CompileEnv *envPtr,		/* Holds resulting instructions. */
     int mode,			/* Exact, Glob or Regexp */
     int noCase,			/* Case-insensitivity flag. */
-    int numBodyTokens,		/* Number of tokens describing things the
+    Tcl_Size numBodyTokens,	/* Number of tokens describing things the
 				 * switch can match against and bodies to
 				 * execute when the match succeeds. */
     Tcl_Token **bodyToken,	/* Array of pointers to pattern list items. */
-    int *bodyLines,		/* Array of line numbers for body list
+    Tcl_Size *bodyLines,		/* Array of line numbers for body list
 				 * items. */
-    int **bodyContLines)	/* Array of continuation line info. */
+    Tcl_Size **bodyContLines)	/* Array of continuation line info. */
 {
     enum {Switch_Exact, Switch_Glob, Switch_Regexp};
     int foundDefault;		/* Flag to indicate whether a "default" clause
@@ -2368,9 +2368,9 @@ IssueSwitchJumpTable(
 				 * switch can match against and bodies to
 				 * execute when the match succeeds. */
     Tcl_Token **bodyToken,	/* Array of pointers to pattern list items. */
-    int *bodyLines,		/* Array of line numbers for body list
+    Tcl_Size *bodyLines,		/* Array of line numbers for body list
 				 * items. */
-    int **bodyContLines)	/* Array of continuation line info. */
+    Tcl_Size **bodyContLines)	/* Array of continuation line info. */
 {
     JumptableInfo *jtPtr;
     int infoIndex, isNew, *finalFixups, numRealBodies = 0, jumpLocation;

generic/tclCompExpr.c

@@ -2111,7 +2111,7 @@ ParseLexeme(
 	     * Example: Inf + luence + () becomes a valid function call.
 	     * [Bug 3401704]
 	     */
-	    if (TclHasInternalRep(literal, tclDoubleType)) {
+	    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 = Tcl_UtfToUniChar(start, &ch);
+	    scanned = TclUtfToUCS4(start, &ch);
 	} else {
 	    char utfBytes[8];
 
 	    memcpy(utfBytes, start, numBytes);
 	    utfBytes[numBytes] = '\0';
-	    scanned = Tcl_UtfToUniChar(utfBytes, &ch);
+	    scanned = TclUtfToUCS4(utfBytes, &ch);
 	}
 	*lexemePtr = INVALID;
 	Tcl_DecrRefCount(literal);

generic/tclCompile.c

@@ -701,7 +701,8 @@ static void		StartExpanding(CompileEnv *envPtr);
  */
 static void		EnterCmdWordData(ExtCmdLoc *eclPtr, Tcl_Size srcOffset,
 			    Tcl_Token *tokenPtr, const char *cmd,
-			    Tcl_Size numWords, Tcl_Size line, int *clNext, int **lines,
+			    Tcl_Size numWords, Tcl_Size line,
+			    Tcl_Size *clNext, Tcl_Size **lines,
 			    CompileEnv *envPtr);
 static void		ReleaseCmdWordData(ExtCmdLoc *eclPtr);
 
@@ -1953,7 +1954,8 @@ CompileCmdCompileProc(
     CompileEnv *envPtr)
 {
     DefineLineInformation;
-    int unwind = 0, incrOffset = -1;
+    int unwind = 0;
+    Tcl_Size incrOffset = -1;
     int depth = TclGetStackDepth(envPtr);
 
     /*
@@ -2040,11 +2042,11 @@ CompileCommandTokens(
     Command *cmdPtr = NULL;
     int code = TCL_ERROR;
     int cmdKnown, expand = -1;
-    int *wlines, wlineat;
-    int cmdLine = envPtr->line;
-    int *clNext = envPtr->clNext;
-    int cmdIdx = envPtr->numCommands;
-    int startCodeOffset = envPtr->codeNext - envPtr->codeStart;
+    Tcl_Size *wlines, wlineat;
+    Tcl_Size cmdLine = envPtr->line;
+    Tcl_Size *clNext = envPtr->clNext;
+    Tcl_Size cmdIdx = envPtr->numCommands;
+    Tcl_Size startCodeOffset = envPtr->codeNext - envPtr->codeStart;
     int depth = TclGetStackDepth(envPtr);
 
     assert ((int)parsePtr->numWords > 0);
@@ -2194,7 +2196,7 @@ TclCompileScript(
 	Tcl_SetObjResult(interp,
 	  Tcl_ObjPrintf("Script length %" TCL_SIZE_MODIFIER
 			   "d exceeds max permitted length %d.",
-			   numBytes, (int)INT_MAX-1));
+			   numBytes, INT_MAX-1));
 	    Tcl_SetErrorCode(interp, "TCL", "LIMIT", "SCRIPTLENGTH", NULL);
 	    TclCompileSyntaxError(interp, envPtr);
 	    return;
@@ -2421,19 +2423,20 @@ TclCompileTokens(
     Tcl_Interp *interp,		/* Used for error and status reporting. */
     Tcl_Token *tokenPtr,	/* Pointer to first in an array of tokens to
 				 * compile. */
-    size_t count1,			/* Number of tokens to consider at tokenPtr.
+    size_t count1,		/* Number of tokens to consider at tokenPtr.
 				 * Must be at least 1. */
     CompileEnv *envPtr)		/* Holds the resulting instructions. */
 {
     Tcl_DString textBuffer;	/* Holds concatenated chars from adjacent
 				 * TCL_TOKEN_TEXT, TCL_TOKEN_BS tokens. */
     char buffer[4] = "";
-    int i, numObjsToConcat, adjust;
+    Tcl_Size i, numObjsToConcat, adjust;
     size_t length;
     unsigned char *entryCodeNext = envPtr->codeNext;
 #define NUM_STATIC_POS 20
-    int isLiteral, maxNumCL, numCL;
-    int *clPosition = NULL;
+    int isLiteral;
+    Tcl_Size maxNumCL, numCL;
+    Tcl_Size *clPosition = NULL;
     int depth = TclGetStackDepth(envPtr);
     int count = count1;
 
@@ -2463,7 +2466,7 @@ TclCompileTokens(
 
     if (isLiteral) {
 	maxNumCL = NUM_STATIC_POS;
-	clPosition = (int *)Tcl_Alloc(maxNumCL * sizeof(int));
+	clPosition = (Tcl_Size *)Tcl_Alloc(maxNumCL * sizeof(Tcl_Size));
     }
 
     adjust = 0;
@@ -2503,8 +2506,8 @@ TclCompileTokens(
 
 		    if (numCL >= maxNumCL) {
 			maxNumCL *= 2;
-			clPosition = (int *)Tcl_Realloc(clPosition,
-                                maxNumCL * sizeof(int));
+			clPosition = (Tcl_Size *)Tcl_Realloc(clPosition,
+                                maxNumCL * sizeof(Tcl_Size));
 		    }
 		    clPosition[numCL] = clPos;
 		    numCL ++;
@@ -3330,14 +3333,14 @@ EnterCmdWordData(
     const char *cmd,
     Tcl_Size numWords,
     Tcl_Size line,
-    int *clNext,
-    int **wlines,
+    Tcl_Size *clNext,
+    Tcl_Size **wlines,
     CompileEnv *envPtr)
 {
     ECL *ePtr;
     const char *last;
     Tcl_Size wordIdx, wordLine;
-    int *wwlines, *wordNext;
+    Tcl_Size *wwlines, *wordNext;
 
     if (eclPtr->nuloc >= eclPtr->nloc) {
 	/*
@@ -3356,10 +3359,10 @@ EnterCmdWordData(
 
     ePtr = &eclPtr->loc[eclPtr->nuloc];
     ePtr->srcOffset = srcOffset;
-    ePtr->line = (int *)Tcl_Alloc(numWords * sizeof(int));
-    ePtr->next = (int **)Tcl_Alloc(numWords * sizeof(int *));
+    ePtr->line = (Tcl_Size *)Tcl_Alloc(numWords * sizeof(Tcl_Size));
+    ePtr->next = (Tcl_Size **)Tcl_Alloc(numWords * sizeof(Tcl_Size *));
     ePtr->nline = numWords;
-    wwlines = (int *)Tcl_Alloc(numWords * sizeof(int));
+    wwlines = (Tcl_Size *)Tcl_Alloc(numWords * sizeof(Tcl_Size));
 
     last = cmd;
     wordLine = line;
@@ -3372,7 +3375,7 @@ EnterCmdWordData(
 	/* See Ticket 4b61afd660 */
 	wwlines[wordIdx] =
 		((wordIdx == 0) || TclWordKnownAtCompileTime(tokenPtr, NULL))
-		? (int)wordLine : -1;
+		? wordLine : -1;
 	ePtr->line[wordIdx] = wordLine;
 	ePtr->next[wordIdx] = wordNext;
 	last = tokenPtr->start;

generic/tclCompile.h

@@ -183,16 +183,16 @@ typedef struct {
 typedef struct {
     Tcl_Size srcOffset;		/* Command location to find the entry. */
     Tcl_Size nline;			/* Number of words in the command */
-    int *line;			/* Line information for all words in the
+    Tcl_Size *line;			/* Line information for all words in the
 				 * command. */
-    int **next;			/* Transient information used by the compiler
+    Tcl_Size **next;			/* Transient information used by the compiler
 				 * for tracking of hidden continuation
 				 * lines. */
 } ECL;
 
 typedef struct {
     int type;			/* Context type. */
-    int start;			/* Starting line for compiled script. Needed
+    Tcl_Size start;		/* Starting line for compiled script. Needed
 				 * for the extended recompile check in
 				 * tclCompileObj. */
     Tcl_Obj *path;		/* Path of the sourced file the command is
@@ -316,8 +316,10 @@ 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. */
@@ -333,6 +335,9 @@ 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
@@ -345,14 +350,19 @@ 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];
@@ -382,7 +392,7 @@ typedef struct CompileEnv {
 				 * encountered that have not yet been paired
 				 * with a corresponding
 				 * INST_INVOKE_EXPANDED. */
-    int *clNext;		/* If not NULL, it refers to the next slot in
+    Tcl_Size *clNext;	/* If not NULL, it refers to the next slot in
 				 * clLoc to check for an invisible
 				 * continuation line. */
 } CompileEnv;
@@ -1054,6 +1064,7 @@ typedef struct {
  *----------------------------------------------------------------
  */
 
+#if TCL_MAJOR_VERSION > 8
 MODULE_SCOPE Tcl_ObjCmdProc	TclNRInterpCoroutine;
 
 /*
@@ -1192,6 +1203,7 @@ 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,8 +27,10 @@
 
 #if !defined(BUILD_tcl)
 # define TCL_DEPRECATED(msg) EXTERN TCL_DEPRECATED_API(msg)
-#else
+#elif defined(TCL_NO_DEPRECATED)
 # define TCL_DEPRECATED(msg) MODULE_SCOPE
+#else
+# define TCL_DEPRECATED(msg) EXTERN
 #endif
 
 
@@ -4025,29 +4027,82 @@ 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)
-#define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg,\
-	flags, indexPtr) \
-	(tclStubsPtr->tcl_GetIndexFromObjStruct(\
-	    (interp), (objPtr), (tablePtr), (offset), (msg), \
+#   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), \
 		(flags)|(int)(sizeof(*(indexPtr))<<1), (indexPtr)))
 #define Tcl_GetBooleanFromObj(interp, objPtr, boolPtr) \
-	(Tcl_GetBoolFromObj(interp, objPtr,\
-	     (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(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)))
 #define Tcl_GetBoolean(interp, src, boolPtr) \
-	(Tcl_GetBool(interp, src, (TCL_NULL_OK-2)&(int)sizeof(\
-	    (*(boolPtr))), (char *)(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
 #define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \
-	(tclStubsPtr->tcl_GetBytesFromObj(\
-	    NULL, objPtr, (Tcl_Size *)(void *)(sizePtr)))
+	(sizeof(*(sizePtr)) <= sizeof(int) ? \
+		tclStubsPtr->tclGetBytesFromObj(NULL, objPtr, (sizePtr)) : \
+		tclStubsPtr->tcl_GetBytesFromObj(NULL, objPtr, (Tcl_Size *)(void *)(sizePtr)))
 #else
+#define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \
+	(sizeof(*(sizePtr)) <= sizeof(int) ? \
+		tclStubsPtr->tclGetByteArrayFromObj(objPtr, (sizePtr)) : \
+		tclStubsPtr->tcl_GetByteArrayFromObj(objPtr, (Tcl_Size *)(void *)(sizePtr)))
+#endif
+#else
+#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)))
+#if defined(TCL_NO_DEPRECATED)
 #define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \
 	(Tcl_GetBytesFromObj)(NULL, objPtr, (Tcl_Size *)(void *)(sizePtr))
+#else
+#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)))
+#define Tcl_GetStringFromObj(objPtr, sizePtr) \
+	(sizeof(*(sizePtr)) <= sizeof(int) ? \
+		TclGetStringFromObj(objPtr, (sizePtr)) : \
+		(Tcl_GetStringFromObj)(objPtr, (Tcl_Size *)(void *)(sizePtr)))
+#define Tcl_GetBytesFromObj(interp, objPtr, sizePtr) \
+	(sizeof(*(sizePtr)) <= sizeof(int) ? \
+		TclGetBytesFromObj(interp, objPtr, (sizePtr)) : \
+		(Tcl_GetBytesFromObj)(interp, objPtr, (Tcl_Size *)(void *)(sizePtr)))
+#endif
 #endif
 
 #ifdef TCL_MEM_DEBUG
@@ -4076,6 +4131,36 @@ 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 \
@@ -4089,6 +4174,36 @@ extern const TclStubs *tclStubsPtr;
 #   define Tcl_WCharLen (sizeof(wchar_t) != sizeof(short) \
 		? (Tcl_Size (*)(wchar_t *))tclStubsPtr->tcl_UniCharLen \
 		: (Tcl_Size (*)(wchar_t *))Tcl_Char16Len)
+#if TCL_MAJOR_VERSION < 9 || !defined(TCL_NO_DEPRECATED)
+#   undef Tcl_ListObjGetElements
+#   define Tcl_ListObjGetElements(interp, listPtr, objcPtr, objvPtr) (sizeof(*(objcPtr)) == sizeof(int) \
+		? tclStubsPtr->tclListObjGetElements((interp), (listPtr), (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 \
@@ -4102,6 +4217,29 @@ 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
 
 /*
@@ -4113,11 +4251,24 @@ extern const TclStubs *tclStubsPtr;
 #define Tcl_GlobalEvalObj(interp, objPtr) \
     Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL)
 
-# undef Tcl_Close
-# define Tcl_Close(interp, chan) Tcl_CloseEx(interp, chan, 0)
+#if TCL_MAJOR_VERSION > 8
+#   undef Tcl_Close
+#   define Tcl_Close(interp, chan) Tcl_CloseEx(interp, chan, 0)
+#endif
 
 #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

@@ -61,6 +61,8 @@ static Tcl_ObjCmdProc		DictForNRCmd;
 static Tcl_ObjCmdProc		DictMapNRCmd;
 static Tcl_NRPostProc		DictForLoopCallback;
 static Tcl_NRPostProc		DictMapLoopCallback;
+static Tcl_ObjTypeLengthProc    DictAsListLength;
+/* static Tcl_ObjTypeIndexProc     DictAsListIndex; Needs rewrite */
 
 /*
  * Table of dict subcommand names and implementations.
@@ -143,14 +145,25 @@ typedef struct Dict {
 
 const Tcl_ObjType tclDictType = {
     "dict",
-    FreeDictInternalRep,		/* freeIntRepProc */
-    DupDictInternalRep,			/* dupIntRepProc */
-    UpdateStringOfDict,			/* updateStringProc */
-    SetDictFromAny,			/* setFromAnyProc */
-    TCL_OBJTYPE_V0
+    FreeDictInternalRep,	/* freeIntRepProc */
+    DupDictInternalRep,		/* dupIntRepProc */
+    UpdateStringOfDict,		/* updateStringProc */
+    SetDictFromAny,		/* setFromAnyProc */
+    TCL_OBJTYPE_V2(		/* Extended type for AbstractLists */
+    DictAsListLength,		/* return "list" length of dict value w/o
+				 * shimmering */
+    NULL,			/* return key or value at "list" index
+				 * location.  (keysare at even indicies,
+				 * values at odd indicies) */
+    NULL,
+    NULL,
+    NULL,
+    NULL,
+    NULL,
+    NULL)
 };
 
-#define DictSetIntRep(objPtr, dictRepPtr)				\
+#define DictSetInternalRep(objPtr, dictRepPtr)				\
     do {                                                                \
         Tcl_ObjInternalRep ir;                                               \
         ir.twoPtrValue.ptr1 = (dictRepPtr);                             \
@@ -396,7 +409,7 @@ DupDictInternalRep(
      * Store in the object.
      */
 
-    DictSetIntRep(copyPtr, newDict);
+    DictSetInternalRep(copyPtr, newDict);
 }
 
 /*
@@ -603,7 +616,7 @@ SetDictFromAny(
      * the conversion from lists to dictionaries.
      */
 
-    if (TclHasInternalRep(objPtr, tclListType)) {
+    if (TclHasInternalRep(objPtr, &tclListType)) {
 	Tcl_Size objc, i;
 	Tcl_Obj **objv;
 
@@ -711,7 +724,7 @@ SetDictFromAny(
     dict->epoch = 1;
     dict->chain = NULL;
     dict->refCount = 1;
-    DictSetIntRep(objPtr, dict);
+    DictSetInternalRep(objPtr, dict);
     return TCL_OK;
 
   missingValue:
@@ -890,7 +903,7 @@ InvalidateDictChain(
 	dict->refCount++;
 	TclInvalidateStringRep(dictObj);
 	TclFreeInternalRep(dictObj);
-	DictSetIntRep(dictObj, dict);
+	DictSetInternalRep(dictObj, dict);
 
 	dict->epoch++;
 	dictObj = dict->chain;
@@ -945,7 +958,7 @@ Tcl_DictObjPut(
     hPtr = CreateChainEntry(dict, keyPtr, &isNew);
     dict->refCount++;
     TclFreeInternalRep(dictPtr)
-    DictSetIntRep(dictPtr, dict);
+    DictSetInternalRep(dictPtr, dict);
     Tcl_IncrRefCount(valuePtr);
     if (!isNew) {
 	Tcl_Obj *oldValuePtr = (Tcl_Obj *)Tcl_GetHashValue(hPtr);
@@ -1426,7 +1439,7 @@ Tcl_NewDictObj(void)
     dict->epoch = 1;
     dict->chain = NULL;
     dict->refCount = 1;
-    DictSetIntRep(dictPtr, dict);
+    DictSetInternalRep(dictPtr, dict);
     return dictPtr;
 #endif
 }
@@ -1474,7 +1487,7 @@ Tcl_DbNewDictObj(
     dict->epoch = 1;
     dict->chain = NULL;
     dict->refCount = 1;
-    DictSetIntRep(dictPtr, dict);
+    DictSetInternalRep(dictPtr, dict);
     return dictPtr;
 }
 #else /* !TCL_MEM_DEBUG */
@@ -1509,7 +1522,7 @@ Tcl_DbNewDictObj(
 
 static int
 DictCreateCmd(
-    TCL_UNUSED(ClientData),
+    TCL_UNUSED(void *),
     Tcl_Interp *interp,
     int objc,
     Tcl_Obj *const *objv)
@@ -1559,7 +1572,7 @@ DictCreateCmd(
 
 static int
 DictGetCmd(
-    TCL_UNUSED(ClientData),
+    TCL_UNUSED(void *),
     Tcl_Interp *interp,
     int objc,
     Tcl_Obj *const *objv)
@@ -1652,7 +1665,7 @@ DictGetCmd(
 
 static int
 DictGetDefCmd(
-    TCL_UNUSED(ClientData),
+    TCL_UNUSED(void *),
     Tcl_Interp *interp,
     int objc,
     Tcl_Obj *const *objv)
@@ -1717,7 +1730,7 @@ DictGetDefCmd(
 
 static int
 DictReplaceCmd(
-    TCL_UNUSED(ClientData),
+    TCL_UNUSED(void *),
     Tcl_Interp *interp,
     int objc,
     Tcl_Obj *const *objv)
@@ -1765,7 +1778,7 @@ DictReplaceCmd(
 
 static int
 DictRemoveCmd(
-    TCL_UNUSED(ClientData),
+    TCL_UNUSED(void *),
     Tcl_Interp *interp,
     int objc,
     Tcl_Obj *const *objv)
@@ -1813,7 +1826,7 @@ DictRemoveCmd(
 
 static int
 DictMergeCmd(
-    TCL_UNUSED(ClientData),
+    TCL_UNUSED(void *),
     Tcl_Interp *interp,
     int objc,
     Tcl_Obj *const *objv)
@@ -1900,7 +1913,7 @@ DictMergeCmd(
 
 static int
 DictKeysCmd(
-    TCL_UNUSED(ClientData),
+    TCL_UNUSED(void *),
     Tcl_Interp *interp,
     int objc,
     Tcl_Obj *const *objv)
@@ -1979,7 +1992,7 @@ DictKeysCmd(
 
 static int
 DictValuesCmd(
-    TCL_UNUSED(ClientData),
+    TCL_UNUSED(void *),
     Tcl_Interp *interp,
     int objc,
     Tcl_Obj *const *objv)
@@ -2039,7 +2052,7 @@ DictValuesCmd(
 
 static int
 DictSizeCmd(
-    TCL_UNUSED(ClientData),
+    TCL_UNUSED(void *),
     Tcl_Interp *interp,
     int objc,
     Tcl_Obj *const *objv)
@@ -2078,7 +2091,7 @@ DictSizeCmd(
 
 static int
 DictExistsCmd(
-    TCL_UNUSED(ClientData),
+    TCL_UNUSED(void *),
     Tcl_Interp *interp,
     int objc,
     Tcl_Obj *const *objv)
@@ -2120,7 +2133,7 @@ DictExistsCmd(
 
 static int
 DictInfoCmd(
-    TCL_UNUSED(ClientData),
+    TCL_UNUSED(void *),
     Tcl_Interp *interp,
     int objc,
     Tcl_Obj *const *objv)
@@ -2164,7 +2177,7 @@ DictInfoCmd(
 
 static int
 DictIncrCmd(
-    TCL_UNUSED(ClientData),
+    TCL_UNUSED(void *),
     Tcl_Interp *interp,
     int objc,
     Tcl_Obj *const *objv)
@@ -2285,7 +2298,7 @@ DictIncrCmd(
 
 static int
 DictLappendCmd(
-    TCL_UNUSED(ClientData),
+    TCL_UNUSED(void *),
     Tcl_Interp *interp,
     int objc,
     Tcl_Obj *const *objv)
@@ -2372,7 +2385,7 @@ DictLappendCmd(
 
 static int
 DictAppendCmd(
-    TCL_UNUSED(ClientData),
+    TCL_UNUSED(void *),
     Tcl_Interp *interp,
     int objc,
     Tcl_Obj *const *objv)
@@ -2474,7 +2487,7 @@ DictAppendCmd(
 
 static int
 DictForNRCmd(
-    TCL_UNUSED(ClientData),
+    TCL_UNUSED(void *),
     Tcl_Interp *interp,
     int objc,
     Tcl_Obj *const *objv)
@@ -2670,7 +2683,7 @@ DictForLoopCallback(
 
 static int
 DictMapNRCmd(
-    TCL_UNUSED(ClientData),
+    TCL_UNUSED(void *),
     Tcl_Interp *interp,
     int objc,
     Tcl_Obj *const *objv)
@@ -2883,7 +2896,7 @@ DictMapLoopCallback(
 
 static int
 DictSetCmd(
-    TCL_UNUSED(ClientData),
+    TCL_UNUSED(void *),
     Tcl_Interp *interp,
     int objc,
     Tcl_Obj *const *objv)
@@ -2943,7 +2956,7 @@ DictSetCmd(
 
 static int
 DictUnsetCmd(
-    TCL_UNUSED(ClientData),
+    TCL_UNUSED(void *),
     Tcl_Interp *interp,
     int objc,
     Tcl_Obj *const *objv)
@@ -3002,7 +3015,7 @@ DictUnsetCmd(
 
 static int
 DictFilterCmd(
-    TCL_UNUSED(ClientData),
+    TCL_UNUSED(void *),
     Tcl_Interp *interp,
     int objc,
     Tcl_Obj *const *objv)
@@ -3288,7 +3301,7 @@ DictFilterCmd(
 
 static int
 DictUpdateCmd(
-    TCL_UNUSED(ClientData),
+    TCL_UNUSED(void *),
     Tcl_Interp *interp,
     int objc,
     Tcl_Obj *const *objv)
@@ -3447,7 +3460,7 @@ FinalizeDictUpdate(
 
 static int
 DictWithCmd(
-    TCL_UNUSED(ClientData),
+    TCL_UNUSED(void *),
     Tcl_Interp *interp,
     int objc,
     Tcl_Obj *const *objv)
@@ -3788,6 +3801,159 @@ TclInitDictCmd(
     return TclMakeEnsemble(interp, "dict", implementationMap);
 }
 
+/*
+ *----------------------------------------------------------------------
+ *
+ * DictAsListLength --
+ *
+ *   Compute the length of a list as if the dict value were converted to a
+ *   list.
+ *
+ *   Note: the list length may not match the dict size * 2.  This occurs when
+ *   there are duplicate keys in the original string representation.
+ *
+ * Side Effects --
+ *
+ *   The intent is to have no side effects.
+ */
+
+static Tcl_Size
+DictAsListLength(
+    Tcl_Obj *objPtr)
+{
+    Tcl_Size estCount, length, llen;
+    const char *limit, *nextElem = Tcl_GetStringFromObj(objPtr, &length);
+    Tcl_Obj *elemPtr;
+
+    /*
+     * Allocate enough space to hold a (Tcl_Obj *) for each
+     * (possible) list element.
+     */
+
+    estCount = TclMaxListLength(nextElem, length, &limit);
+    estCount += (estCount == 0); /* Smallest list struct holds 1
+				  * element. */
+    elemPtr = Tcl_NewObj();
+
+    llen = 0;
+
+    while (nextElem < limit) {
+	const char *elemStart;
+	char *check;
+	Tcl_Size elemSize;
+	int literal;
+
+	if (TCL_OK != TclFindElement(NULL, nextElem, limit - nextElem,
+		          &elemStart, &nextElem, &elemSize, &literal)) {
+	    Tcl_DecrRefCount(elemPtr);
+	    return 0;
+	}
+	if (elemStart == limit) {
+	    break;
+	}
+
+	TclInvalidateStringRep(elemPtr);
+	check = Tcl_InitStringRep(elemPtr, literal ? elemStart : NULL,
+				  elemSize);
+	if (elemSize && check == NULL) {
+	    Tcl_DecrRefCount(elemPtr);
+	    return 0;
+	}
+	if (!literal) {
+	    Tcl_InitStringRep(elemPtr, NULL,
+			      TclCopyAndCollapse(elemSize, elemStart, check));
+	}
+	llen++;
+    }
+    Tcl_DecrRefCount(elemPtr);
+    return llen;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DictAsListIndex --
+ *
+ *   Return the key or value at the given "list" index, i.e., as if the string
+ *   value where treated as a list. The intent is to support this list
+ *   operation w/o causing the Obj value to shimmer into a List.
+ *
+ * Side Effects --
+ *
+ *   The intent is to have no side effects.
+ *
+ */
+#if 0 /* Needs rewrite */
+static int
+DictAsListIndex(
+    Tcl_Interp *interp,
+    struct Tcl_Obj *objPtr,
+    Tcl_Size index,
+    Tcl_Obj** elemObjPtr)
+{
+    Tcl_Size /*estCount,*/ length, llen;
+    const char *limit, *nextElem = Tcl_GetStringFromObj(objPtr, &length);
+    Tcl_Obj *elemPtr;
+
+    /*
+     * Compute limit of the list string
+     */
+
+    TclMaxListLength(nextElem, length, &limit);
+    elemPtr = Tcl_NewObj();
+
+    llen = 0;
+
+    /*
+     * parse out each element until reaching the "index"th element.
+     * Sure this is slow, but shimmering is slower.
+     */
+    while (nextElem < limit) {
+	const char *elemStart;
+	char *check;
+	Tcl_Size elemSize;
+	int literal;
+
+	if (TCL_OK != TclFindElement(NULL, nextElem, limit - nextElem,
+		          &elemStart, &nextElem, &elemSize, &literal)) {
+	    Tcl_DecrRefCount(elemPtr);
+	    return 0;
+	}
+	if (elemStart == limit) {
+	    break;
+	}
+
+	TclInvalidateStringRep(elemPtr);
+	check = Tcl_InitStringRep(elemPtr, literal ? elemStart : NULL,
+				  elemSize);
+	if (elemSize && check == NULL) {
+	    Tcl_DecrRefCount(elemPtr);
+	    if (interp) {
+		// Need error message here
+	    }
+	    return TCL_ERROR;
+	}
+	if (!literal) {
+	    Tcl_InitStringRep(elemPtr, NULL,
+			      TclCopyAndCollapse(elemSize, elemStart, check));
+	}
+	if (llen == index) {
+	    *elemObjPtr = elemPtr;
+	    return TCL_OK;
+	}
+	llen++;
+    }
+
+    /*
+     * Index is beyond end of list - return empty
+     */
+    Tcl_InitStringRep(elemPtr, NULL, 0);
+    *elemObjPtr = elemPtr;
+    return TCL_OK;
+}
+#endif
+
 /*
  * Local Variables:
  * mode: c

generic/tclDisassemble.c

@@ -256,7 +256,8 @@ DisassembleByteCodeObj(
     unsigned char *codeStart, *codeLimit, *pc;
     unsigned char *codeDeltaNext, *codeLengthNext;
     unsigned char *srcDeltaNext, *srcLengthNext;
-    int codeOffset, codeLen, srcOffset, srcLen, numCmds, delta, i, line;
+    int codeOffset, codeLen, srcOffset, srcLen, numCmds, delta, line;
+    Tcl_Size i;
     Interp *iPtr;
     Tcl_Obj *bufferObj, *fileObj;
 
@@ -278,7 +279,7 @@ DisassembleByteCodeObj(
      */
 
     Tcl_AppendPrintfToObj(bufferObj,
-	    "ByteCode %p, refCt %" TCL_Z_MODIFIER "u, epoch %" TCL_Z_MODIFIER "u, interp %p (epoch %" TCL_Z_MODIFIER "u)\n",
+	    "ByteCode %p, refCt %" TCL_SIZE_MODIFIER "u, epoch %" TCL_SIZE_MODIFIER "u, interp %p (epoch %" TCL_SIZE_MODIFIER "u)\n",
 	    codePtr, codePtr->refCount, codePtr->compileEpoch, iPtr, iPtr->compileEpoch);
     Tcl_AppendToObj(bufferObj, "  Source ", -1);
     PrintSourceToObj(bufferObj, codePtr->source,
@@ -289,7 +290,7 @@ DisassembleByteCodeObj(
 		TclGetString(fileObj), line);
     }
     Tcl_AppendPrintfToObj(bufferObj,
-	    "\n  Cmds %d, src %" TCL_Z_MODIFIER "u, inst %" TCL_Z_MODIFIER "u, litObjs %" TCL_Z_MODIFIER "u, aux %" TCL_Z_MODIFIER "u, stkDepth %" TCL_Z_MODIFIER "u, code/src %.2f\n",
+	    "\n  Cmds %d, src %" TCL_SIZE_MODIFIER "u, inst %" TCL_SIZE_MODIFIER "u, litObjs %" TCL_SIZE_MODIFIER "u, aux %" TCL_SIZE_MODIFIER "u, stkDepth %" TCL_SIZE_MODIFIER "u, code/src %.2f\n",
 	    numCmds, codePtr->numSrcBytes, codePtr->numCodeBytes,
 	    codePtr->numLitObjects, codePtr->numAuxDataItems,
 	    codePtr->maxStackDepth,
@@ -301,8 +302,8 @@ DisassembleByteCodeObj(
 
 #ifdef TCL_COMPILE_STATS
     Tcl_AppendPrintfToObj(bufferObj,
-	    "  Code %" TCL_Z_MODIFIER "u = header %" TCL_Z_MODIFIER "u+inst %" TCL_Z_MODIFIER "u+litObj %"
-	    TCL_Z_MODIFIER "u+exc %" TCL_Z_MODIFIER "u+aux %" TCL_Z_MODIFIER "u+cmdMap %" TCL_Z_MODIFIER "u\n",
+	    "  Code %" TCL_Z_MODIFIER "u = header %" TCL_Z_MODIFIER "u+inst %" TCL_SIZE_MODIFIER "u+litObj %"
+	    TCL_Z_MODIFIER "u+exc %" TCL_Z_MODIFIER "u+aux %" TCL_Z_MODIFIER "u+cmdMap %" TCL_SIZE_MODIFIER "u\n",
 	    codePtr->structureSize,
 	    offsetof(ByteCode, localCachePtr),
 	    codePtr->numCodeBytes,
@@ -320,10 +321,10 @@ DisassembleByteCodeObj(
 
     if (codePtr->procPtr != NULL) {
 	Proc *procPtr = codePtr->procPtr;
-	int numCompiledLocals = procPtr->numCompiledLocals;
+	Tcl_Size numCompiledLocals = procPtr->numCompiledLocals;
 
 	Tcl_AppendPrintfToObj(bufferObj,
-		"  Proc %p, refCt %" TCL_Z_MODIFIER "u, args %" TCL_Z_MODIFIER "u, compiled locals %d\n",
+		"  Proc %p, refCt %" TCL_SIZE_MODIFIER "u, args %" TCL_SIZE_MODIFIER "u, compiled locals %" TCL_SIZE_MODIFIER "u\n",
 		procPtr, procPtr->refCount, procPtr->numArgs,
 		numCompiledLocals);
 	if (numCompiledLocals > 0) {
@@ -331,7 +332,7 @@ DisassembleByteCodeObj(
 
 	    for (i = 0;  i < numCompiledLocals;  i++) {
 		Tcl_AppendPrintfToObj(bufferObj,
-			"      slot %d%s%s%s%s%s%s", i,
+			"      slot %" TCL_SIZE_MODIFIER "u%s%s%s%s%s%s", i,
 			(localPtr->flags & (VAR_ARRAY|VAR_LINK)) ? "" : ", scalar",
 			(localPtr->flags & VAR_ARRAY) ? ", array" : "",
 			(localPtr->flags & VAR_LINK) ? ", link" : "",
@@ -354,24 +355,24 @@ DisassembleByteCodeObj(
      */
 
     if ((int)codePtr->numExceptRanges > 0) {
-	Tcl_AppendPrintfToObj(bufferObj, "  Exception ranges %" TCL_Z_MODIFIER "u, depth %" TCL_Z_MODIFIER "u:\n",
+	Tcl_AppendPrintfToObj(bufferObj, "  Exception ranges %" TCL_SIZE_MODIFIER "u, depth %" TCL_SIZE_MODIFIER "u:\n",
 		codePtr->numExceptRanges, codePtr->maxExceptDepth);
 	for (i = 0;  i < (int)codePtr->numExceptRanges;  i++) {
 	    ExceptionRange *rangePtr = &codePtr->exceptArrayPtr[i];
 
 	    Tcl_AppendPrintfToObj(bufferObj,
-		    "      %d: level %" TCL_Z_MODIFIER "u, %s, pc %" TCL_Z_MODIFIER "u-%" TCL_Z_MODIFIER "u, ",
+		    "      %" TCL_SIZE_MODIFIER "u: level %" TCL_SIZE_MODIFIER "u, %s, pc %" TCL_SIZE_MODIFIER "u-%" TCL_SIZE_MODIFIER "u, ",
 		    i, rangePtr->nestingLevel,
 		    (rangePtr->type==LOOP_EXCEPTION_RANGE ? "loop" : "catch"),
 		    rangePtr->codeOffset,
 		    (rangePtr->codeOffset + rangePtr->numCodeBytes - 1));
 	    switch (rangePtr->type) {
 	    case LOOP_EXCEPTION_RANGE:
-		Tcl_AppendPrintfToObj(bufferObj, "continue %" TCL_Z_MODIFIER "u, break %" TCL_Z_MODIFIER "u\n",
+		Tcl_AppendPrintfToObj(bufferObj, "continue %" TCL_SIZE_MODIFIER "u, break %" TCL_SIZE_MODIFIER "u\n",
 			rangePtr->continueOffset, rangePtr->breakOffset);
 		break;
 	    case CATCH_EXCEPTION_RANGE:
-		Tcl_AppendPrintfToObj(bufferObj, "catch %" TCL_Z_MODIFIER "u\n",
+		Tcl_AppendPrintfToObj(bufferObj, "catch %" TCL_SIZE_MODIFIER "u\n",
 			rangePtr->catchOffset);
 		break;
 	    default:
@@ -445,7 +446,7 @@ DisassembleByteCodeObj(
 	    srcLengthNext++;
 	}
 
-	Tcl_AppendPrintfToObj(bufferObj, "%s%4d: pc %d-%d, src %d-%d",
+	Tcl_AppendPrintfToObj(bufferObj, "%s%4" TCL_SIZE_MODIFIER "u: pc %d-%d, src %d-%d",
 		((i % 2)? "     " : "\n   "),
 		(i+1), codeOffset, (codeOffset + codeLen - 1),
 		srcOffset, (srcOffset + srcLen - 1));
@@ -504,7 +505,7 @@ DisassembleByteCodeObj(
 	    pc += FormatInstruction(codePtr, pc, bufferObj);
 	}
 
-	Tcl_AppendPrintfToObj(bufferObj, "  Command %d: ", i+1);
+	Tcl_AppendPrintfToObj(bufferObj, "  Command %" TCL_SIZE_MODIFIER "u: ", i+1);
 	PrintSourceToObj(bufferObj, (codePtr->source + srcOffset),
 		TclMin(srcLen, 55));
 	Tcl_AppendToObj(bufferObj, "\n", -1);
@@ -544,7 +545,7 @@ FormatInstruction(
     unsigned char *codeStart = codePtr->codeStart;
     unsigned pcOffset = pc - codeStart;
     int opnd = 0, i, j, numBytes = 1;
-    int localCt = procPtr ? (int)procPtr->numCompiledLocals : 0;
+    Tcl_Size localCt = procPtr ? procPtr->numCompiledLocals : 0;
     CompiledLocal *localPtr = procPtr ? procPtr->firstLocalPtr : NULL;
     char suffixBuffer[128];	/* Additional info to print after main opcode
 				 * and immediates. */
@@ -625,7 +626,7 @@ FormatInstruction(
 	printLVTindex:
 	    if (localPtr != NULL) {
 		if (opnd >= localCt) {
-		    Tcl_Panic("FormatInstruction: bad local var index %u (%u locals)",
+		    Tcl_Panic("FormatInstruction: bad local var index %u (%" TCL_SIZE_MODIFIER "u locals)",
 			    opnd, localCt);
 		}
 		for (j = 0;  j < opnd;  j++) {
@@ -875,7 +876,7 @@ PrintSourceToObj(
     for (;  (*p != '\0') && (i < maxChars);  p+=len) {
 	int ucs4;
 
-	len = Tcl_UtfToUniChar(p, &ucs4);
+	len = TclUtfToUCS4(p, &ucs4);
 	switch (ucs4) {
 	case '"':
 	    Tcl_AppendToObj(appendObj, "\\\"", -1);
@@ -943,8 +944,8 @@ DisassembleByteCodeAsDicts(
     Tcl_Obj *description, *literals, *variables, *instructions, *inst;
     Tcl_Obj *aux, *exn, *commands, *file;
     unsigned char *pc, *opnd, *codeOffPtr, *codeLenPtr, *srcOffPtr, *srcLenPtr;
-    int codeOffset, codeLength, sourceOffset, sourceLength;
-    int i, val, line;
+    int codeOffset, codeLength, sourceOffset, sourceLength, val, line;
+    Tcl_Size i;
 
     ByteCodeGetInternalRep(objPtr, &tclByteCodeType, codePtr);
 
@@ -953,7 +954,7 @@ DisassembleByteCodeAsDicts(
      */
 
     TclNewObj(literals);
-    for (i=0 ; i<(int)codePtr->numLitObjects ; i++) {
+    for (i=0 ; i<codePtr->numLitObjects ; i++) {
 	Tcl_ListObjAppendElement(NULL, literals, codePtr->objArrayPtr[i]);
     }
 
@@ -963,7 +964,7 @@ DisassembleByteCodeAsDicts(
 
     TclNewObj(variables);
     if (codePtr->procPtr) {
-	int localCount = codePtr->procPtr->numCompiledLocals;
+	Tcl_Size localCount = codePtr->procPtr->numCompiledLocals;
 	CompiledLocal *localPtr = codePtr->procPtr->firstLocalPtr;
 
 	for (i=0 ; i<localCount ; i++,localPtr=localPtr->nextPtr) {
@@ -1146,14 +1147,14 @@ DisassembleByteCodeAsDicts(
 	switch (rangePtr->type) {
 	case LOOP_EXCEPTION_RANGE:
 	    Tcl_ListObjAppendElement(NULL, exn, Tcl_ObjPrintf(
-		    "type %s level %" TCL_Z_MODIFIER "u from %" TCL_Z_MODIFIER "u to %" TCL_Z_MODIFIER "u break %" TCL_Z_MODIFIER "u continue %" TCL_Z_MODIFIER "u",
+		    "type %s level %" TCL_SIZE_MODIFIER "u from %" TCL_SIZE_MODIFIER "u to %" TCL_SIZE_MODIFIER "u break %" TCL_SIZE_MODIFIER "u continue %" TCL_SIZE_MODIFIER "u",
 		    "loop", rangePtr->nestingLevel, rangePtr->codeOffset,
 		    rangePtr->codeOffset + rangePtr->numCodeBytes - 1,
 		    rangePtr->breakOffset, rangePtr->continueOffset));
 	    break;
 	case CATCH_EXCEPTION_RANGE:
 	    Tcl_ListObjAppendElement(NULL, exn, Tcl_ObjPrintf(
-		    "type %s level %" TCL_Z_MODIFIER "u from %" TCL_Z_MODIFIER "u to %" TCL_Z_MODIFIER "u catch %" TCL_Z_MODIFIER "u",
+		    "type %s level %" TCL_SIZE_MODIFIER "u from %" TCL_SIZE_MODIFIER "u to %" TCL_SIZE_MODIFIER "u catch %" TCL_SIZE_MODIFIER "u",
 		    "catch", rangePtr->nestingLevel, rangePtr->codeOffset,
 		    rangePtr->codeOffset + rangePtr->numCodeBytes - 1,
 		    rangePtr->catchOffset));

generic/tclEncoding.c

@@ -10,6 +10,7 @@
  */
 
 #include "tclInt.h"
+#include <assert.h>
 
 typedef size_t (LengthProc)(const char *src);
 
@@ -185,6 +186,7 @@ TCL_DECLARE_MUTEX(encodingMutex)
 static Tcl_Encoding defaultEncoding = NULL;
 static Tcl_Encoding systemEncoding = NULL;
 Tcl_Encoding tclIdentityEncoding = NULL;
+Tcl_Encoding tclUtf8Encoding = NULL;
 
 /*
  * Names of encoding profiles and corresponding integer values.
@@ -571,8 +573,8 @@ TclInitEncodingSubsystem(void)
     unsigned size;
     unsigned short i;
     union {
-        char c;
-        short s;
+	char c;
+	short s;
     } isLe;
     int leFlags;
 
@@ -608,7 +610,7 @@ TclInitEncodingSubsystem(void)
     type.freeProc	= NULL;
     type.nullSize	= 1;
     type.clientData	= INT2PTR(ENCODING_UTF);
-    Tcl_CreateEncoding(&type);
+    tclUtf8Encoding = Tcl_CreateEncoding(&type);
     type.clientData	= NULL;
     type.encodingName	= "cesu-8";
     Tcl_CreateEncoding(&type);
@@ -655,6 +657,11 @@ 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
@@ -725,6 +732,8 @@ TclFinalizeEncodingSubsystem(void)
     defaultEncoding = NULL;
     FreeEncoding(tclIdentityEncoding);
     tclIdentityEncoding = NULL;
+    FreeEncoding(tclUtf8Encoding);
+    tclUtf8Encoding = NULL;
 
     hPtr = Tcl_FirstHashEntry(&encodingTable, &search);
     while (hPtr != NULL) {
@@ -1149,7 +1158,7 @@ Tcl_ExternalToUtfDString(
 				 * converted string is stored. */
 {
     Tcl_ExternalToUtfDStringEx(
-	NULL, encoding, src, srcLen, TCL_ENCODING_PROFILE_STRICT, dstPtr, NULL);
+	NULL, encoding, src, srcLen, TCL_ENCODING_PROFILE_TCL8, dstPtr, NULL);
     return Tcl_DStringValue(dstPtr);
 }
 
@@ -1229,6 +1238,7 @@ Tcl_ExternalToUtfDStringEx(
 		"Parameter error: TCL_ENCODING_{START,STOP} bits set in flags.",
 		TCL_INDEX_NONE));
 	Tcl_SetErrorCode(interp, "TCL", "ENCODING", "ILLEGALFLAGS", NULL);
+	errno = EINVAL;
 	return TCL_ERROR;
     }
 
@@ -1293,17 +1303,20 @@ Tcl_ExternalToUtfDStringEx(
 		/* Caller wants error message on failure */
 		if (result != TCL_OK && interp != NULL) {
 		    char buf[TCL_INTEGER_SPACE];
-		    snprintf(buf, sizeof(buf), "%" TCL_Z_MODIFIER "u", nBytesProcessed);
+		    snprintf(buf, sizeof(buf), "%" TCL_SIZE_MODIFIER "u", nBytesProcessed);
 		    Tcl_SetObjResult(
 			interp,
 			Tcl_ObjPrintf("unexpected byte sequence starting at index %"
-				      TCL_Z_MODIFIER "u: '\\x%02X'",
+				      TCL_SIZE_MODIFIER "u: '\\x%02X'",
 				      nBytesProcessed,
 				      UCHAR(srcStart[nBytesProcessed])));
 		    Tcl_SetErrorCode(
 			interp, "TCL", "ENCODING", "ILLEGALSEQUENCE", buf, NULL);
 		}
 	    }
+	    if (result != TCL_OK) {
+		errno = (result == TCL_CONVERT_NOSPACE) ? ENOMEM : EILSEQ;
+	    }
 	    return result;
 	}
 
@@ -1494,7 +1507,7 @@ Tcl_UtfToExternalDString(
  *	The parameter flags controls the behavior, if any of the bytes in
  *	the source buffer are invalid or cannot be represented in the
  *	target encoding. It should be composed by OR-ing the following:
- *	- *At most one* of TCL_ENCODING_PROFILE{DEFAULT,TCL8,STRICT}
+ *	- *At most one* of TCL_ENCODING_PROFILE_*
  *	- TCL_ENCODING_STOPONERROR: Backward compatibility. Sets the profile
  *	  to TCL_ENCODING_PROFILE_STRICT overriding any specified profile flags
  *
@@ -1557,6 +1570,7 @@ Tcl_UtfToExternalDStringEx(
 		"Parameter error: TCL_ENCODING_{START,STOP} bits set in flags.",
 		TCL_INDEX_NONE));
 	Tcl_SetErrorCode(interp, "TCL", "ENCODING", "ILLEGALFLAGS", NULL);
+	errno = EINVAL;
 	return TCL_ERROR;
     }
 
@@ -1623,12 +1637,12 @@ Tcl_UtfToExternalDStringEx(
 		    Tcl_Size pos = Tcl_NumUtfChars(srcStart, nBytesProcessed);
 		    int ucs4;
 		    char buf[TCL_INTEGER_SPACE];
-		    Tcl_UtfToUniChar(&srcStart[nBytesProcessed], &ucs4);
-		    snprintf(buf, sizeof(buf), "%" TCL_Z_MODIFIER "u", nBytesProcessed);
+		    TclUtfToUCS4(&srcStart[nBytesProcessed], &ucs4);
+		    snprintf(buf, sizeof(buf), "%" TCL_SIZE_MODIFIER "u", nBytesProcessed);
 		    Tcl_SetObjResult(
 			interp,
 			Tcl_ObjPrintf(
-			    "unexpected character at index %" TCL_Z_MODIFIER
+			    "unexpected character at index %" TCL_SIZE_MODIFIER
 			    "u: 'U+%06X'",
 			    pos,
 			    ucs4));
@@ -1636,6 +1650,9 @@ Tcl_UtfToExternalDStringEx(
 				     buf, NULL);
 		}
 	    }
+	    if (result != TCL_OK) {
+		errno = (result == TCL_CONVERT_NOSPACE) ? ENOMEM : EILSEQ;
+	    }
 	    return result;
 	}
 
@@ -2526,6 +2543,16 @@ 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++) {
 
@@ -2573,10 +2600,10 @@ UtfToUtfProc(
 	} else if (!Tcl_UtfCharComplete(src, srcEnd - src)) {
 	    /*
 	     * Incomplete byte sequence.
-	     * 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.
+		 * 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.
 	     */
 
 	    if (flags & ENCODING_INPUT) {
@@ -2595,12 +2622,12 @@ UtfToUtfProc(
 		/* TCL_ENCODING_PROFILE_TCL8 */
 		char chbuf[2];
 		chbuf[0] = UCHAR(*src++); chbuf[1] = 0;
-		Tcl_UtfToUniChar(chbuf, &ch);
+		TclUtfToUCS4(chbuf, &ch);
 	    }
 	    dst += Tcl_UniCharToUtf(ch, dst);
 	} else {
 	    int isInvalid = 0;
-	    size_t len = Tcl_UtfToUniChar(src, &ch);
+	    size_t len = TclUtfToUCS4(src, &ch);
 	    if (flags & ENCODING_INPUT) {
 		if ((len < 2) && (ch != 0)) {
 		    isInvalid = 1;
@@ -2628,10 +2655,44 @@ 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)) {
@@ -2706,6 +2767,15 @@ Utf32ToUtfProc(
     }
     result = TCL_OK;
 
+#if TCL_UTF_MAX < 4
+    /* Initialize the buffer so that some random data doesn't trick
+     * Tcl_UniCharToUtf() into thinking it should combine surrogate pairs.
+     * Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its
+     * prior non-stateful nature, this call to memset can also be removed.
+     */
+    memset(dst, 0xff, dstLen);
+#endif
+
     /*
      * Check alignment with utf-32 (4 == sizeof(UTF-32))
      */
@@ -2715,6 +2785,21 @@ 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;
 
@@ -2727,11 +2812,20 @@ 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;
@@ -2741,6 +2835,9 @@ 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;
@@ -2754,6 +2851,11 @@ 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;
@@ -2763,6 +2865,13 @@ 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;
@@ -2855,7 +2964,7 @@ UtfToUtf32Proc(
 	    result = TCL_CONVERT_NOSPACE;
 	    break;
 	}
-	len = Tcl_UtfToUniChar(src, &ch);
+	len = TclUtfToUCS4(src, &ch);
 	if (SURROGATE(ch)) {
 	    if (PROFILE_STRICT(flags)) {
 		result = TCL_CONVERT_UNKNOWN;
@@ -2936,6 +3045,15 @@ Utf16ToUtfProc(
     }
     result = TCL_OK;
 
+#if TCL_UTF_MAX < 4
+    /* Initialize the buffer so that some random data doesn't trick
+     * Tcl_UniCharToUtf() into thinking it should combine surrogate pairs.
+     * Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its
+     * prior non-stateful nature, this call to memset can also be removed.
+     */
+    memset(dst, 0xff, dstLen);
+#endif
+
     /*
      * Check alignment with utf-16 (2 == sizeof(UTF-16))
      */
@@ -3116,7 +3234,7 @@ UtfToUtf16Proc(
     }
 
     dstStart = dst;
-    dstEnd   = dst + dstLen - sizeof(Tcl_UniChar);
+    dstEnd   = dst + dstLen - 2; /* 2 -> sizeof a UTF-16 code unit */
     flags |= PTR2INT(clientData);
 
     result = TCL_OK;
@@ -3134,7 +3252,7 @@ UtfToUtf16Proc(
 	    result = TCL_CONVERT_NOSPACE;
 	    break;
 	}
-	len = Tcl_UtfToUniChar(src, &ch);
+	len = TclUtfToUCS4(src, &ch);
 	if (SURROGATE(ch)) {
 	    if (PROFILE_STRICT(flags)) {
 		result = TCL_CONVERT_UNKNOWN;
@@ -3226,7 +3344,7 @@ UtfToUcs2Proc(
     }
 
     dstStart = dst;
-    dstEnd   = dst + dstLen - sizeof(Tcl_UniChar);
+    dstEnd   = dst + dstLen - 2; /* 2 - size of UCS code unit */
 
     result = TCL_OK;
     for (numChars = 0; src < srcEnd; numChars++) {
@@ -3243,7 +3361,18 @@ 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)) {
@@ -3252,6 +3381,7 @@ UtfToUcs2Proc(
 	    }
 	    ch = UNICODE_REPLACE_CHAR;
 	}
+#endif
 	if (PROFILE_STRICT(flags) && SURROGATE(ch)) {
 	    result = TCL_CONVERT_SYNTAX;
 	    break;
@@ -3337,6 +3467,15 @@ TableToUtfProc(
     dstStart = dst;
     dstEnd = dst + dstLen - TCL_UTF_MAX;
 
+#if TCL_UTF_MAX < 4
+    /* Initialize the buffer so that some random data doesn't trick
+     * Tcl_UniCharToUtf() into thinking it should combine surrogate pairs.
+     * Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its
+     * prior non-stateful nature, this call to memset can also be removed.
+     */
+    memset(dst, 0xff, dstLen);
+#endif
+
     toUnicode = (const unsigned short *const *) dataPtr->toUnicode;
     prefixBytes = dataPtr->prefixBytes;
     pageZero = toUnicode[0];
@@ -3349,30 +3488,28 @@ TableToUtfProc(
 	}
 	byte = *((unsigned char *) src);
 	if (prefixBytes[byte]) {
-	    src++;
-	    if (src >= srcEnd) {
+	    if (src >= srcEnd-1) {
+		/* Prefix byte but nothing after it */
 		if (!(flags & TCL_ENCODING_END)) {
-		    src--;
+		    /* More data to come */
 		    result = TCL_CONVERT_MULTIBYTE;
 		    break;
 		} else if (PROFILE_STRICT(flags)) {
-		    src--;
 		    result = TCL_CONVERT_SYNTAX;
 		    break;
 		} else if (PROFILE_REPLACE(flags)) {
 		    ch = UNICODE_REPLACE_CHAR;
 		} else {
-		    src--; /* See bug [bdcb5126c0] */
-		    result = TCL_CONVERT_MULTIBYTE;
-		    break;
+		    ch = (Tcl_UniChar)byte;
 		}
 	    } else {
-		ch = toUnicode[byte][*((unsigned char *)src)];
+		ch = toUnicode[byte][*((unsigned char *)++src)];
 	    }
 	} else {
 	    ch = pageZero[byte];
 	}
 	if ((ch == 0) && (byte != 0)) {
+	    /* Prefix+suffix pair is invalid */
 	    if (PROFILE_STRICT(flags)) {
 		result = TCL_CONVERT_SYNTAX;
 		break;
@@ -3399,6 +3536,7 @@ TableToUtfProc(
 	src++;
     }
 
+    assert(src <= srcEnd);
     *srcReadPtr = src - srcStart;
     *dstWrotePtr = dst - dstStart;
     *dstCharsPtr = numChars;
@@ -3481,12 +3619,17 @@ 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
+#else
+	if (!len) {
+	    word = 0;
+	} else
+#endif
 	    word = fromUnicode[(ch >> 8)][ch & 0xFF];
-	}
 
 	if ((word == 0) && (ch != 0)) {
 	    if (PROFILE_STRICT(flags)) {
@@ -3573,6 +3716,15 @@ Iso88591ToUtfProc(
     dstStart = dst;
     dstEnd = dst + dstLen - TCL_UTF_MAX;
 
+#if TCL_UTF_MAX < 4
+    /* Initialize the buffer so that some random data doesn't trick
+     * Tcl_UniCharToUtf() into thinking it should combine surrogate pairs.
+     * Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its
+     * prior non-stateful nature, this call to memset can also be removed.
+     */
+    memset(dst, 0xff, dstLen);
+#endif
+
     result = TCL_OK;
     for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) {
 	Tcl_UniChar ch = 0;
@@ -3674,14 +3826,24 @@ Iso88591FromUtfProc(
 	 * Check for illegal characters.
 	 */
 
-	if (ch > 0xFF) {
+	if (ch > 0xFF
+#if TCL_UTF_MAX < 4
+		|| ((ch >= 0xD800) && (len < 3))
+#endif
+		) {
 	    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 */
 	}
 
@@ -3802,6 +3964,15 @@ EscapeToUtfProc(
     dstStart = dst;
     dstEnd = dst + dstLen - TCL_UTF_MAX;
 
+#if TCL_UTF_MAX < 4
+    /* Initialize the buffer so that some random data doesn't trick
+     * Tcl_UniCharToUtf() into thinking it should combine surrogate pairs.
+     * Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its
+     * prior non-stateful nature, this call to memset can also be removed.
+     */
+    memset(dst, 0xff, dstLen);
+#endif
+
     state = PTR2INT(*statePtr);
     if (flags & TCL_ENCODING_START) {
 	state = 0;
@@ -3898,12 +4069,10 @@ EscapeToUtfProc(
 	    if ((checked == dataPtr->numSubTables + 2)
 		    || (flags & TCL_ENCODING_END)) {
 		if (!PROFILE_STRICT(flags)) {
-		    /*
-		     * Skip the unknown escape sequence. TODO - bug?
-		     * May be replace with UNICODE_REPLACE_CHAR?
-		     */
-
-		    src += longest;
+		    unsigned skip = longest > left ? left : longest;
+		    /* Unknown escape sequence */
+		    dst += Tcl_UniCharToUtf(UNICODE_REPLACE_CHAR, dst);
+		    src += skip;
 		    continue;
 		}
 		result = TCL_CONVERT_SYNTAX;

generic/tclEnsemble.c

@@ -312,17 +312,7 @@ TclNamespaceEnsembleCmd(
 			Tcl_AppendObjToObj(newCmd, listv[0]);
 			Tcl_ListObjReplace(NULL, newList, 0, 1, 1, &newCmd);
 			if (patchedDict == NULL) {
-			    patchedDict = TclDuplicatePureObj(
-				interp, objv[1], &tclDictType);
-			    if (!patchedDict) {
-				if (allocatedMapFlag) {
-				    Tcl_DecrRefCount(mapObj);
-				}
-				Tcl_DecrRefCount(newList);
-				Tcl_DecrRefCount(newCmd);
-				Tcl_DecrRefCount(patchedDict);
-				return TCL_ERROR;
-			    }
+			    patchedDict = Tcl_DuplicateObj(objv[1]);
 			}
 			Tcl_DictObjPut(NULL, patchedDict, subcmdWordsObj,
 				newList);
@@ -606,14 +596,7 @@ TclNamespaceEnsembleCmd(
 			}
 			cmd = TclGetString(listv[0]);
 			if (!(cmd[0] == ':' && cmd[1] == ':')) {
-			    Tcl_Obj *newList = TclDuplicatePureObj(
-				interp, listObj, tclListType);
-			    if (!newList) {
-				if (patchedDict) {
-				    Tcl_DecrRefCount(patchedDict);
-				}
-				goto freeMapAndError;
-			    }
+			    Tcl_Obj *newList = Tcl_DuplicateObj(listObj);
 			    Tcl_Obj *newCmd = NewNsObj((Tcl_Namespace*)nsPtr);
 
 			    if (nsPtr->parentPtr) {
@@ -623,11 +606,7 @@ TclNamespaceEnsembleCmd(
 			    Tcl_ListObjReplace(NULL, newList, 0, 1, 1,
 				    &newCmd);
 			    if (patchedDict == NULL) {
-				patchedDict = TclDuplicatePureObj(
-				    interp, objv[1], tclListType);
-				if (!patchedDict) {
-				    goto freeMapAndError;
-				}
+				patchedDict = Tcl_DuplicateObj(objv[1]);
 			    }
 			    Tcl_DictObjPut(NULL, patchedDict, subcmdWordsObj,
 				    newList);
@@ -1925,11 +1904,7 @@ NsEnsembleImplementationCmdNR(
 	TclListObjLengthM(NULL, prefixObj, &prefixObjc);
 
 	if (objc == 2) {
-	    copyPtr = TclDuplicatePureObj(
-		interp, prefixObj, tclListType);
-	    if (!copyPtr) {
-		return TCL_ERROR;
-	    }
+	    copyPtr = TclListObjCopy(NULL, prefixObj);
 	} else {
 	    copyPtr = Tcl_NewListObj(objc - 2 + prefixObjc, NULL);
 	    Tcl_ListObjAppendList(NULL, copyPtr, prefixObj);
@@ -2329,11 +2304,7 @@ EnsembleUnknownCallback(
      * Create the "unknown" command callback to determine what to do.
      */
 
-    unknownCmd = TclDuplicatePureObj(
-	interp, ensemblePtr->unknownHandler, tclListType);
-    if (!unknownCmd) {
-	return TCL_ERROR;
-    }
+    unknownCmd = Tcl_DuplicateObj(ensemblePtr->unknownHandler);
     TclNewObj(ensObj);
     Tcl_GetCommandFullName(interp, ensemblePtr->token, ensObj);
     Tcl_ListObjAppendElement(NULL, unknownCmd, ensObj);
@@ -3293,7 +3264,7 @@ TclAttemptCompileProc(
     Tcl_Size i;
     Tcl_Token *saveTokenPtr = parsePtr->tokenPtr;
     Tcl_Size savedStackDepth = envPtr->currStackDepth;
-    unsigned savedCodeNext = envPtr->codeNext - envPtr->codeStart;
+    Tcl_Size savedCodeNext = envPtr->codeNext - envPtr->codeStart;
     Tcl_Size savedAuxDataArrayNext = envPtr->auxDataArrayNext;
     Tcl_Size savedExceptArrayNext = envPtr->exceptArrayNext;
 #ifdef TCL_COMPILE_DEBUG
@@ -3356,13 +3327,13 @@ TclAttemptCompileProc(
 	ExceptionAux *auxPtr = envPtr->exceptAuxArrayPtr;
 
 	for (i = 0; i < savedExceptArrayNext; i++) {
-	    while ((int)auxPtr->numBreakTargets > 0
-		    && auxPtr->breakTargets[auxPtr->numBreakTargets - 1]
+	    while (auxPtr->numBreakTargets > 0
+		    && (Tcl_Size) auxPtr->breakTargets[auxPtr->numBreakTargets - 1]
 		    >= savedCodeNext) {
 		auxPtr->numBreakTargets--;
 	    }
-	    while ((int)auxPtr->numContinueTargets > 0
-		    && auxPtr->continueTargets[auxPtr->numContinueTargets - 1]
+	    while (auxPtr->numContinueTargets > 0
+		    && (Tcl_Size) auxPtr->continueTargets[auxPtr->numContinueTargets - 1]
 		    >= savedCodeNext) {
 		auxPtr->numContinueTargets--;
 	    }

generic/tclEnv.c

@@ -19,20 +19,20 @@ TCL_DECLARE_MUTEX(envMutex)	/* To serialize access to environ. */
 
 #if defined(_WIN32)
 #  define tenviron _wenviron
-#  define tenviron2utfdstr(string, len, dsPtr) (Tcl_DStringInit(dsPtr), \
-		(char *)Tcl_Char16ToUtfDString((const unsigned short *)(string), ((((len) + 2) >> 1) - 1), (dsPtr)))
-#  define utf2tenvirondstr(string, len, dsPtr) (Tcl_DStringInit(dsPtr), \
-		(const WCHAR *)Tcl_UtfToChar16DString((string), (len), (dsPtr)))
+#  define tenviron2utfdstr(str, dsPtr) (Tcl_DStringInit(dsPtr), \
+		(char *)Tcl_Char16ToUtfDString((const unsigned short *)(str), -1, (dsPtr)))
+#  define utf2tenvirondstr(str, dsPtr) (Tcl_DStringInit(dsPtr), \
+		(const WCHAR *)Tcl_UtfToChar16DString((str), -1, (dsPtr)))
 #  define techar WCHAR
 #  ifdef USE_PUTENV
 #    define putenv(env) _wputenv((const wchar_t *)env)
 #  endif
 #else
 #  define tenviron environ
-#  define tenviron2utfdstr(tenvstr, len, dstr) \
-		Tcl_ExternalToUtfDString(NULL, tenvstr, len, dstr)
-#  define utf2tenvirondstr(str, len, dstr) \
-		Tcl_UtfToExternalDString(NULL, str, len, dstr)
+#  define tenviron2utfdstr(str, dsPtr) \
+		Tcl_ExternalToUtfDString(NULL, str, -1, dsPtr)
+#  define utf2tenvirondstr(str, dsPtr) \
+		Tcl_UtfToExternalDString(NULL, str, -1, dsPtr)
 #  define techar char
 #endif
 
@@ -42,7 +42,7 @@ size_t TclEnvEpoch = 0;	/* Epoch of the tcl environment
 				 * (if changed with tcl-env). */
 
 static struct {
-    size_t cacheSize;		/* Number of env strings in cache. */
+    Tcl_Size cacheSize;		/* Number of env strings in cache. */
     char **cache;		/* Array containing all of the environment
 				 * strings that Tcl has allocated. */
 #ifndef USE_PUTENV
@@ -159,7 +159,11 @@ TclSetupEnv(
 	    const char *p1;
 	    char *p2;
 
-	    p1 = tenviron2utfdstr(tenviron[i], -1, &envString);
+	    p1 = tenviron2utfdstr(tenviron[i], &envString);
+	    if (p1 == NULL) {
+		/* Ignore what cannot be decoded (should not happen) */
+		continue;
+	    }
 	    p2 = (char *)strchr(p1, '=');
 	    if (p2 == NULL) {
 		/*
@@ -301,9 +305,9 @@ TclSetEnv(
 	 * interpreters.
 	 */
 
-	oldEnv = tenviron2utfdstr(tenviron[index], -1, &envString);
-	if (strcmp(value, oldEnv + (length + 1)) == 0) {
-	    Tcl_DStringFree(&envString);
+	oldEnv = tenviron2utfdstr(tenviron[index], &envString);
+	if (oldEnv == NULL || strcmp(value, oldEnv + (length + 1)) == 0) {
+	    Tcl_DStringFree(&envString); /* OK even if oldEnv is NULL */
 	    Tcl_MutexUnlock(&envMutex);
 	    return;
 	}
@@ -324,7 +328,13 @@ TclSetEnv(
     memcpy(p, name, nameLength);
     p[nameLength] = '=';
     memcpy(p+nameLength+1, value, valueLength+1);
-    p2 = utf2tenvirondstr(p, -1, &envString);
+    p2 = utf2tenvirondstr(p, &envString);
+    if (p2 == NULL) {
+	/* No way to signal error from here :-( but should not happen */
+	Tcl_Free(p);
+	Tcl_MutexUnlock(&envMutex);
+	return;
+    }
 
     /*
      * Copy the native string to heap memory.
@@ -502,7 +512,11 @@ TclUnsetEnv(
     string[length] = '\0';
 #endif /* _WIN32 */
 
-    utf2tenvirondstr(string, -1, &envString);
+    if (utf2tenvirondstr(string, &envString) == NULL) {
+	/* Should not happen except memory alloc fail. */
+	Tcl_MutexUnlock(&envMutex);
+	return;
+    }
     string = (char *)Tcl_Realloc(string, Tcl_DStringLength(&envString) + tNTL);
     memcpy(string, Tcl_DStringValue(&envString),
 	    Tcl_DStringLength(&envString) + tNTL);
@@ -577,17 +591,19 @@ TclGetEnv(
     if (index != -1) {
 	Tcl_DString envStr;
 
-	result = tenviron2utfdstr(tenviron[index], -1, &envStr);
-	result += length;
-	if (*result == '=') {
-	    result++;
-	    Tcl_DStringInit(valuePtr);
-	    Tcl_DStringAppend(valuePtr, result, -1);
-	    result = Tcl_DStringValue(valuePtr);
-	} else {
-	    result = NULL;
+	result = tenviron2utfdstr(tenviron[index], &envStr);
+	if (result) {
+	    result += length;
+	    if (*result == '=') {
+		result++;
+		Tcl_DStringInit(valuePtr);
+		Tcl_DStringAppend(valuePtr, result, -1);
+		result = Tcl_DStringValue(valuePtr);
+	    } else {
+		result = NULL;
+	    }
+	    Tcl_DStringFree(&envStr);
 	}
-	Tcl_DStringFree(&envStr);
     }
     Tcl_MutexUnlock(&envMutex);
     return result;
@@ -703,7 +719,7 @@ ReplaceString(
     const char *oldStr,		/* Old environment string. */
     char *newStr)		/* New environment string. */
 {
-    size_t i;
+    Tcl_Size i;
 
     /*
      * Check to see if the old value was allocated by Tcl. If so, it needs to
@@ -782,7 +798,7 @@ TclFinalizeEnvironment(void)
 
     if (env.cache) {
 #ifdef PURIFY
-	size_t i;
+	Tcl_Size i;
 	for (i = 0; i < env.cacheSize; i++) {
 	    Tcl_Free(env.cache[i]);
 	}

generic/tclEvent.c

@@ -232,11 +232,7 @@ HandleBgErrors(
 	 * support one handler setting another handler.
 	 */
 
-	Tcl_Obj *copyObj = TclDuplicatePureObj(
-	    interp, assocPtr->cmdPrefix, tclListType);
-	if (!copyObj) {
-	    return;
-	}
+	Tcl_Obj *copyObj = TclListObjCopy(NULL, assocPtr->cmdPrefix);
 
 	errPtr = assocPtr->firstBgPtr;
 
@@ -1088,6 +1084,9 @@ static const struct {
 #ifdef USE_NMAKE
 	    ".nmake"
 #endif
+#ifdef TCL_NO_DEPRECATED
+	    ".no-deprecate"
+#endif
 #if !TCL_THREADS
 	    ".no-thread"
 #endif
@@ -1109,6 +1108,9 @@ static const struct {
 #ifdef STATIC_BUILD
 	    ".static"
 #endif
+#if TCL_UTF_MAX < 4
+	    ".utf-16"
+#endif
 }};
 
 const char *

generic/tclExecute.c

@@ -10,7 +10,6 @@
  * 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.
@@ -451,11 +450,11 @@ VarHashCreateVar(
  */
 
 #define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \
-    ((TclHasInternalRep((objPtr), tclIntType))					\
+    ((TclHasInternalRep((objPtr), &tclIntType))					\
 	?	(*(tPtr) = TCL_NUMBER_INT,				\
 		*(ptrPtr) = (void *)				\
 		    (&((objPtr)->internalRep.wideValue)), TCL_OK) :	\
-    TclHasInternalRep((objPtr), tclDoubleType)				\
+    TclHasInternalRep((objPtr), &tclDoubleType)				\
 	?	(((isnan((objPtr)->internalRep.doubleValue))		\
 		    ?	(*(tPtr) = TCL_NUMBER_NAN)			\
 		    :	(*(tPtr) = TCL_NUMBER_DOUBLE)),			\
@@ -635,7 +634,7 @@ static ExceptionRange *	GetExceptRangeForPc(const unsigned char *pc,
 			    int searchMode, ByteCode *codePtr);
 static const char *	GetSrcInfoForPc(const unsigned char *pc,
 			    ByteCode *codePtr, Tcl_Size *lengthPtr,
-			    const unsigned char **pcBeg, int *cmdIdxPtr);
+			    const unsigned char **pcBeg, Tcl_Size *cmdIdxPtr);
 static Tcl_Obj **	GrowEvaluationStack(ExecEnv *eePtr, TCL_HASH_TYPE growth,
 			    int move);
 static void		IllegalExprOperandType(Tcl_Interp *interp,
@@ -674,7 +673,8 @@ static const Tcl_ObjType exprCodeType = {
 static const Tcl_ObjType dictIteratorType = {
     "dictIterator",
     ReleaseDictIterator,
-    NULL, NULL, NULL, TCL_OBJTYPE_V0
+    NULL, NULL, NULL,
+    TCL_OBJTYPE_V0
 };
 
 /*
@@ -1481,7 +1481,7 @@ CompileExprObj(
  * DupExprCodeInternalRep --
  *
  *	Part of the Tcl object type implementation for Tcl expression
- *	bytecode. We do not copy the bytecode intrep. Instead, we return
+ *	bytecode. We do not copy the bytecode internalrep. 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 intrep,
+ *	we had some modifying routines that operated directly on the internalrep,
  *	like we do for lists and dicts.
  *
  * Results:
@@ -1850,7 +1850,7 @@ ArgumentBCEnter(
     int objc,
     Tcl_Obj **objv)
 {
-    int cmd;
+    Tcl_Size cmd;
 
     if (GetSrcInfoForPc(pc, codePtr, NULL, NULL, &cmd)) {
 	TclArgumentBCEnter(interp, objv, objc, codePtr, &tdPtr->cmdFrame, cmd,
@@ -2598,13 +2598,16 @@ TEBCresume(
     case INST_STR_CONCAT1:
 
 	opnd = TclGetUInt1AtPtr(pc+1);
+	DECACHE_STACK_INFO();
 	objResultPtr = TclStringCat(interp, opnd, &OBJ_AT_DEPTH(opnd-1),
 		TCL_STRING_IN_PLACE);
 	if (objResultPtr == NULL) {
+	    CACHE_STACK_INFO();
 	    TRACE_ERROR(interp);
 	    goto gotError;
 	}
 
+	CACHE_STACK_INFO();
 	TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr);
 	NEXT_INST_V(2, opnd, 1);
     break;
@@ -3374,12 +3377,7 @@ TEBCresume(
 	    goto gotError;
 	}
 	if (Tcl_IsShared(objResultPtr)) {
-	    Tcl_Obj *newValue = TclDuplicatePureObj(
-		    interp, objResultPtr, tclListType);
-	    if (!newValue) {
-		TRACE_ERROR(interp);
-		goto gotError;
-	    }
+	    Tcl_Obj *newValue = Tcl_DuplicateObj(objResultPtr);
 
 	    TclDecrRefCount(objResultPtr);
 	    varPtr->value.objPtr = objResultPtr = newValue;
@@ -3438,11 +3436,7 @@ TEBCresume(
 		goto gotError;
 	    } else {
 		if (Tcl_IsShared(objResultPtr)) {
-		    valueToAssign = TclDuplicatePureObj(
-			interp, objResultPtr, tclListType);
-		    if (!valueToAssign) {
-			goto errorInLappendListPtr;
-		    }
+		    valueToAssign = Tcl_DuplicateObj(objResultPtr);
 		    createdNewObj = 1;
 		} else {
 		    valueToAssign = objResultPtr;
@@ -4638,8 +4632,7 @@ TEBCresume(
      */
 
     {
-	int dstatus, numIndices, nocase, match, cflags,
-	    toIdxAnchor, fromIdxAnchor;
+	int numIndices, nocase, match, cflags;
 	Tcl_Size slength, length2, fromIdx, toIdx, index, s1len, s2len;
 	const char *s1, *s2;
 
@@ -4668,79 +4661,70 @@ 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;
-
-	    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);
+	/* special case for AbstractList */
+	if (TclObjTypeHasProc(valuePtr,indexProc)) {
 	    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) {
+	    length = TclObjTypeLength(valuePtr);
+	    if (TclGetIntForIndexM(interp, value2Ptr, length-1, &index)!=TCL_OK) {
+		CACHE_STACK_INFO();
 		TRACE_ERROR(interp);
 		goto gotError;
 	    }
+	    if (TclObjTypeIndex(interp, valuePtr, index, &objResultPtr)!=TCL_OK) {
+		CACHE_STACK_INFO();
+		TRACE_ERROR(interp);
+		goto gotError;
+	    }
+	    CACHE_STACK_INFO();
 	    if (objResultPtr == NULL) {
+		/* Index is out of range, return empty result. */
 		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)
+		    ||
+		    ((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();
 
@@ -4768,82 +4752,45 @@ TEBCresume(
 	opnd = TclGetInt4AtPtr(pc+1);
 	TRACE(("\"%.30s\" %d => ", O2S(valuePtr), opnd));
 
-	if (TclObjectHasInterface(valuePtr, list, length)) {
-	    TCL_UNUSEDVAR(int status);
-	    TclObjectDispatchNoDefault(interp, status, valuePtr, list,
-		length, interp, valuePtr, &length);
-
-	    /* Decode end-offset index values. */
-
-	    index = TclIndexDecode(opnd, length-1);
-
-	    /* Compute value @ index */
-	    if (index >= 0 && index < length) {
-		TclObjectDispatchNoDefault(interp, status, valuePtr, list,
-		    index, interp, valuePtr, index, &objResultPtr);
-		if (objResultPtr == NULL) {
-		    CACHE_STACK_INFO();
-		    TRACE_ERROR(interp);
-		    goto gotError;
-		}
-	    } else {
-		TclNewObj(objResultPtr);
-	    }
-	    pcAdjustment = 5;
-	    goto lindexFastPath2;
-	}
-
 	/*
 	 * Get the contents of the list, making sure that it really is a list
 	 * in the process.
 	 */
 
-	if (!TclHasInternalRep(valuePtr, tclListType)
-	    && TclObjectHasInterface(valuePtr, list, index)) {
-	    if (Tcl_ListObjLength(interp, valuePtr, &objc) != TCL_OK) {
-		TRACE_ERROR(interp);
-		goto gotError;
-	    }
+	/* special case for AbstractList */
+	if (TclObjTypeHasProc(valuePtr,indexProc)) {
+	    length = TclObjTypeLength(valuePtr);
 
-	    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) {
+	    /* Decode end-offset index values. */
+	    index = TclIndexDecode(opnd, length-1);
+
+	    if (index >= 0 && index < length) {
+		/* Compute value @ index */
+		DECACHE_STACK_INFO();
+		if (TclObjTypeIndex(interp, valuePtr, index, &objResultPtr)!=TCL_OK) {
+		    CACHE_STACK_INFO();
 		    TRACE_ERROR(interp);
 		    goto gotError;
 		}
+		CACHE_STACK_INFO();
 	    } 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;
+	    goto lindexFastPath2;
 	}
 
+	/* List case */
+	if (TclListObjGetElementsM(interp, valuePtr, &objc, &objv) != TCL_OK) {
+	    TRACE_ERROR(interp);
+	    goto gotError;
+	}
+
+	/* Decode end-offset index values. */
+
+	index = TclIndexDecode(opnd, objc - 1);
+	pcAdjustment = 5;
 
     lindexFastPath:
 	if (index >= 0 && index < objc) {
@@ -4907,9 +4854,17 @@ TEBCresume(
 	 * Compute the new variable value.
 	 */
 
-	objResultPtr = TclLsetFlat(interp, valuePtr, numIndices,
+	DECACHE_STACK_INFO();
+	if (TclObjTypeHasProc(valuePtr, setElementProc)) {
+	    objResultPtr = TclObjTypeSetElement(interp,
+		valuePtr, numIndices,
+	        &OBJ_AT_DEPTH(numIndices), OBJ_AT_TOS);
+	} else {
+	    objResultPtr = TclLsetFlat(interp, valuePtr, numIndices,
 		&OBJ_AT_DEPTH(numIndices), OBJ_AT_TOS);
+	}
 	if (!objResultPtr) {
+	    CACHE_STACK_INFO();
 	    TRACE_ERROR(interp);
 	    goto gotError;
 	}
@@ -4917,7 +4872,7 @@ TEBCresume(
 	/*
 	 * Set result.
 	 */
-
+	CACHE_STACK_INFO();
 	TRACE_APPEND(("\"%.30s\"\n", O2S(objResultPtr)));
 	NEXT_INST_V(5, numIndices+1, -1);
 
@@ -5010,44 +4965,40 @@ TEBCresume(
 	    TRACE_APPEND(("\"%.30s\"", O2S(objResultPtr)));
 	    NEXT_INST_F(9, 1, 1);
 	}
-
-	toIdxAnchor = TclIndexIsFromEnd(toIdx);
-	fromIdxAnchor = TclIndexIsFromEnd(fromIdx);
-
-	if (!Tcl_LengthIsFinite(objc)
-	    && (toIdxAnchor == 1 || fromIdxAnchor == 1)) {
-
-	    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);
+	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;
+	}
+
+	fromIdx = TclIndexDecode(fromIdx, objc - 1);
+
+	DECACHE_STACK_INFO();
+	if (TclObjTypeHasProc(valuePtr, sliceProc)) {
+	    if (TclObjTypeSlice(interp, valuePtr, fromIdx, toIdx, &objResultPtr) != TCL_OK) {
+		objResultPtr = NULL;
+	    }
+	} else {
+	    objResultPtr = TclListObjRange(interp, valuePtr, fromIdx, toIdx);
+	}
+	if (objResultPtr == NULL) {
+	    CACHE_STACK_INFO();
+	    TRACE_ERROR(interp);
+	    goto gotError;
+	}
+
+	CACHE_STACK_INFO();
 	TRACE_APPEND(("\"%.30s\"", O2S(objResultPtr)));
 	NEXT_INST_F(9, 1, 1);
 
@@ -5056,45 +5007,60 @@ TEBCresume(
 	value2Ptr = OBJ_AT_TOS;
 	valuePtr = OBJ_UNDER_TOS;
 
-	s1 = Tcl_GetStringFromObj(valuePtr, &s1len);
-	TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
-	if (TclListObjLengthM(interp, value2Ptr, &length) != TCL_OK) {
-	    TRACE_ERROR(interp);
-	    goto gotError;
-	}
-	match = 0;
-	if (length > 0) {
-	    Tcl_Size i = 0;
-	    Tcl_Obj *o;
-	    /*
-	     * An empty list doesn't match anything.
-	     */
+        s1 = Tcl_GetStringFromObj(valuePtr, &s1len);
+        TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr)));
 
-	    do {
-		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);
-		}
-		if (o != NULL) {
-		    s2 = Tcl_GetStringFromObj(o, &s2len);
-		} else {
-		    s2 = "";
-		    s2len = 0;
-		}
-		if (s1len == s2len) {
-		    match = (memcmp(s1, s2, s1len) == 0);
-		}
-		TclBounceRefCount(o);
-		i++;
-	    } while (i < length && match == 0);
-	}
+        if (TclObjTypeHasProc(value2Ptr,inOperProc) != NULL) {
+            int status = TclObjTypeInOperator(interp, valuePtr, value2Ptr, &match);
+            if (status != TCL_OK) {
+                TRACE_ERROR(interp);
+                goto gotError;
+            }
+        } else {
+
+            if (TclListObjLengthM(interp, value2Ptr, &length) != TCL_OK) {
+                TRACE_ERROR(interp);
+                goto gotError;
+            }
+            match = 0;
+            if (length > 0) {
+                Tcl_Size i = 0;
+                Tcl_Obj *o;
+                int isAbstractList = TclObjTypeHasProc(value2Ptr,indexProc) != NULL;
+
+                /*
+                 * An empty list doesn't match anything.
+                 */
+
+                do {
+                    if (isAbstractList) {
+                        DECACHE_STACK_INFO();
+                        if (TclObjTypeIndex(interp, value2Ptr, i, &o) != TCL_OK) {
+                            CACHE_STACK_INFO();
+                            TRACE_ERROR(interp);
+                            goto gotError;
+                        }
+                        CACHE_STACK_INFO();
+                    } else {
+                        Tcl_ListObjIndex(NULL, value2Ptr, i, &o);
+                    }
+                    if (o != NULL) {
+                        s2 = Tcl_GetStringFromObj(o, &s2len);
+                    } else {
+                        s2 = "";
+                        s2len = 0;
+                    }
+                    if (s1len == s2len) {
+                        match = (memcmp(s1, s2, s1len) == 0);
+                    }
+
+                    /* Could be an ephemeral abstract obj */
+                    Tcl_BounceRefCount(o);
+
+                    i++;
+                } while (i < length && match == 0);
+            }
+        }
 
 	if (*pc == INST_LIST_NOT_IN) {
 	    match = !match;
@@ -5358,46 +5324,44 @@ TEBCresume(
 	 */
 
 	slength = Tcl_GetCharLength(valuePtr);
-	if (TclObjectHasInterface(valuePtr, string, index)) {
-	    int status;
-	    status = TclStringIndexInterface(interp, valuePtr, value2Ptr, &objResultPtr);
-	    if (status != TCL_OK) {
-		goto gotError;
-	    }
-	} else {
-	    DECACHE_STACK_INFO();
-	    if (TclGetIntForIndexM(interp, value2Ptr, slength-1, &index)!=TCL_OK) {
-		CACHE_STACK_INFO();
-		TRACE_ERROR(interp);
-		goto gotError;
-	    }
+	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) {
+	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);
+	} else {
+	    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 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 {
-		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);
+		slength = Tcl_UniCharToUtf(ch, buf);
+#if TCL_UTF_MAX < 4
+		if ((ch >= 0xD800) && (slength < 3)) {
+		    slength += Tcl_UniCharToUtf(-1, buf + slength);
 		}
+#endif
+		objResultPtr = Tcl_NewStringObj(buf, slength);
 	    }
 	}
+
 	TRACE_APPEND(("\"%s\"\n", O2S(objResultPtr)));
 	NEXT_INST_F(1, 2, 1);
 
@@ -5442,73 +5406,14 @@ TEBCresume(
 	    NEXT_INST_F(9, 0, 0);
 	}
 
-	if (TclObjectHasInterface(valuePtr, list, index)) {
-	    if ((TclIndexIsFromEnd(toIdx) || TclIndexIsFromEnd(fromIdx))
-		&& !Tcl_LengthIsFinite(slength)) {
+	/* Decode index operands. */
 
-		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;
-		}
-	    }
+	toIdx = TclIndexDecode(toIdx, slength - 1);
+	fromIdx = TclIndexDecode(fromIdx, slength - 1);
+	if (toIdx == TCL_INDEX_NONE) {
+	    TclNewObj(objResultPtr);
 	} else {
-	    /* 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);
-	    }
+	    objResultPtr = Tcl_GetRange(valuePtr, fromIdx, toIdx);
 	}
 	TRACE_APPEND(("%.30s\n", O2S(objResultPtr)));
 	NEXT_INST_F(9, 1, 1);
@@ -5664,7 +5569,7 @@ TEBCresume(
 	    int ch;
 	    end = ustring1 + slength;
 	    for (p=ustring1 ; p<end ; ) {
-		ch = *p++;
+		p += TclUniCharToUCS4(p, &ch);
 		if (!tclStringClassTable[opnd].comparator(ch)) {
 		    match = 0;
 		    break;
@@ -6018,7 +5923,7 @@ TEBCresume(
 		     * Quickly force large right shifts to 0 or -1.
 		     */
 
-		    if (w2 >= (Tcl_WideInt)(CHAR_BIT*sizeof(long))) {
+		    if (w2 >= (Tcl_WideInt)(CHAR_BIT*sizeof(w1))) {
 			/*
 			 * We assume that INT_MAX is much larger than the
 			 * number of bits in a long. This is a pretty safe
@@ -6086,9 +5991,9 @@ TEBCresume(
 		     * Handle shifts within the native long range.
 		     */
 
-		    if (((size_t)shift < CHAR_BIT*sizeof(long))
+		    if (((size_t)shift < CHAR_BIT*sizeof(w1))
 			    && !((w1>0 ? w1 : ~w1) &
-				-(1UL<<(CHAR_BIT*sizeof(long) - 1 - shift)))) {
+				-(1UL<<(CHAR_BIT*sizeof(w1) - 1 - shift)))) {
 			wResult = (Tcl_WideUInt)w1 << shift;
 			goto wideResultOfArithmetic;
 		    }
@@ -6469,7 +6374,7 @@ TEBCresume(
 	if (Tcl_IsShared(valuePtr)) {
 	    /*
 	     * Here we do some surgery within the Tcl_Obj internals. We want
-	     * to copy the intrep, but not the string, so we temporarily hide
+	     * to copy the internalrep, but not the string, so we temporarily hide
 	     * the string so we do not copy it.
 	     */
 
@@ -6494,7 +6399,7 @@ TEBCresume(
 
     case INST_TRY_CVT_TO_BOOLEAN:
 	valuePtr = OBJ_AT_TOS;
-	if (TclHasInternalRep(valuePtr, tclBooleanType)) {
+	if (TclHasInternalRep(valuePtr,  &tclBooleanType)) {
 	    objResultPtr = TCONST(1);
 	} else {
 	    int res = (TclSetBooleanFromAny(NULL, valuePtr) == TCL_OK);
@@ -6555,17 +6460,15 @@ TEBCresume(
 	    varListPtr = infoPtr->varLists[i];
 	    numVars = varListPtr->numVars;
 	    listPtr = OBJ_AT_DEPTH(listTmpDepth);
+	    DECACHE_STACK_INFO();
 	    if (TclListObjLengthM(interp, listPtr, &listLen) != TCL_OK) {
+		CACHE_STACK_INFO();
 		TRACE_APPEND(("ERROR converting list %" TCL_Z_MODIFIER "d, \"%s\": %s",
 			i, O2S(listPtr), O2S(Tcl_GetObjResult(interp))));
 		goto gotError;
 	    }
 	    if (Tcl_IsShared(listPtr)) {
-		objPtr = TclDuplicatePureObj(
-		    interp, listPtr, tclListType);
-		if (!objPtr) {
-		    goto gotError;
-		}
+		objPtr = TclListObjCopy(NULL, listPtr);
 		Tcl_IncrRefCount(objPtr);
 		Tcl_DecrRefCount(listPtr);
 		OBJ_AT_DEPTH(listTmpDepth) = objPtr;
@@ -6606,7 +6509,7 @@ TEBCresume(
 
 	pc += 5 - infoPtr->loopCtTemp;
 
-    case INST_FOREACH_STEP:
+    case INST_FOREACH_STEP: /* TODO: address abstract list indexing here! */
 	/*
 	 * "Step" a foreach loop (i.e., begin its next iteration) by assigning
 	 * the next value list element to each loop var.
@@ -6639,20 +6542,47 @@ TEBCresume(
 	    for (i = 0;  i < numLists;  i++) {
 		varListPtr = infoPtr->varLists[i];
 		numVars = varListPtr->numVars;
+		int hasAbstractList;
 
 		listPtr = OBJ_AT_DEPTH(listTmpDepth);
-		status = TclListObjGetElementsM(
-		    interp, listPtr, &listLen, &elements);
+		hasAbstractList = TclObjTypeHasProc(listPtr, indexProc) != 0;
+		DECACHE_STACK_INFO();
+		if (hasAbstractList) {
+		    status = Tcl_ListObjLength(interp, listPtr, &listLen);
+		    elements = NULL;
+		} else {
+		    status = TclListObjGetElementsM(
+			interp, listPtr, &listLen, &elements);
+		}
 		if (status != TCL_OK) {
+		    CACHE_STACK_INFO();
 		    goto gotError;
 		}
+		CACHE_STACK_INFO();
+
 
 		valIndex = (iterNum * numVars);
 		for (j = 0;  j < numVars;  j++) {
 		    if (valIndex >= listLen) {
 			TclNewObj(valuePtr);
 		    } else {
-			valuePtr = elements[valIndex];
+			DECACHE_STACK_INFO();
+			if (elements) {
+			    valuePtr = elements[valIndex];
+			} else {
+			    status = Tcl_ListObjIndex(
+				interp, listPtr, valIndex, &valuePtr);
+			    if (status != TCL_OK) {
+				/* Could happen for abstract lists */
+				CACHE_STACK_INFO();
+				goto gotError;
+			    }
+			    if (valuePtr == NULL) {
+				/* Permitted for Tcl_LOI to return NULL */
+				TclNewObj(valuePtr);
+			    }
+			}
+			CACHE_STACK_INFO();
 		    }
 
 		    varIndex = varListPtr->varIndexes[j];
@@ -7175,7 +7105,7 @@ TEBCresume(
 
 	    /*
 	     * dictPtr is no longer on the stack, and we're not
-	     * moving it into the intrep of an iterator.  We need
+	     * moving it into the internalrep of an iterator.  We need
 	     * to drop the refcount [Tcl Bug 9b352768e6].
 	     */
 
@@ -8523,7 +8453,7 @@ ExecuteExtendedBinaryMathOp(
     overflowExpon:
 
 	if ((TclGetWideIntFromObj(NULL, value2Ptr, &w2) != TCL_OK)
-		|| (value2Ptr->typePtr != tclIntType)
+		|| (value2Ptr->typePtr != &tclIntType)
 		|| (Tcl_WideUInt)w2 >= (1<<28)) {
 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		    "exponent too large", -1));
@@ -9083,7 +9013,7 @@ ValidatePcAndStackTop(
     }
     if (checkStack &&
 	    (stackTop > stackUpperBound)) {
-	size_t numChars;
+	Tcl_Size numChars;
 	const char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars, NULL, NULL);
 
 	fprintf(stderr, "\nBad stack top %" TCL_Z_MODIFIER "u at pc %" TCL_Z_MODIFIER "u in TclNRExecuteByteCode (min 0, max %" TCL_Z_MODIFIER "u)",
@@ -9233,7 +9163,7 @@ TclGetSrcInfoForPc(
 	ExtCmdLoc *eclPtr;
 	ECL *locPtr = NULL;
 	Tcl_Size srcOffset;
-	int i;
+	Tcl_Size i;
 	Interp *iPtr = (Interp *) *codePtr->interpHandle;
 	Tcl_HashEntry *hePtr =
 		Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr);
@@ -9245,7 +9175,7 @@ TclGetSrcInfoForPc(
 	srcOffset = cfPtr->cmd - codePtr->source;
 	eclPtr = (ExtCmdLoc *)Tcl_GetHashValue(hePtr);
 
-	for (i=0; i < (int)eclPtr->nuloc; i++) {
+	for (i=0; i < eclPtr->nuloc; i++) {
 	    if (eclPtr->loc[i].srcOffset == srcOffset) {
 		locPtr = eclPtr->loc+i;
 		break;
@@ -9285,7 +9215,7 @@ GetSrcInfoForPc(
     const unsigned char **pcBeg,/* If non-NULL, the bytecode location
 				 * where the current instruction starts.
 				 * If NULL; no pointer is stored. */
-    int *cmdIdxPtr)		/* If non-NULL, the location where the index
+    Tcl_Size *cmdIdxPtr)	/* If non-NULL, the location where the index
 				 * of the command containing the pc should
 				 * be stored. */
 {
@@ -9294,10 +9224,10 @@ GetSrcInfoForPc(
     unsigned char *codeDeltaNext, *codeLengthNext;
     unsigned char *srcDeltaNext, *srcLengthNext;
     Tcl_Size codeOffset, codeLen, codeEnd, srcOffset, srcLen, delta, i;
-    int bestDist = INT_MAX;	/* Distance of pc to best cmd's start pc. */
-    int bestSrcOffset = -1;	/* Initialized to avoid compiler warning. */
-    int bestSrcLength = -1;	/* Initialized to avoid compiler warning. */
-    int bestCmdIdx = -1;
+    Tcl_Size bestDist = TCL_SIZE_MAX; /* Distance of pc to best cmd's start pc. */
+    Tcl_Size bestSrcOffset = -1; /* Initialized to avoid compiler warning. */
+    Tcl_Size bestSrcLength = -1; /* Initialized to avoid compiler warning. */
+    Tcl_Size bestCmdIdx = -1;
 
     /* The pc must point within the bytecode */
     assert ((pcOffset >= 0) && (pcOffset < codePtr->numCodeBytes));
@@ -9376,7 +9306,7 @@ GetSrcInfoForPc(
 	 * instructions. Stop when crossing pc; keep previous.
 	 */
 
-	curr = ((bestDist == INT_MAX) ? codePtr->codeStart : pc - bestDist);
+	curr = ((bestDist == TCL_SIZE_MAX) ? codePtr->codeStart : pc - bestDist);
 	prev = curr;
 	while (curr <= pc) {
 	    prev = curr;
@@ -9385,7 +9315,7 @@ GetSrcInfoForPc(
 	*pcBeg = prev;
     }
 
-    if (bestDist == INT_MAX) {
+    if (bestDist == TCL_SIZE_MAX) {
 	return NULL;
     }
 
@@ -9623,7 +9553,9 @@ EvalStatsCmd(
     double numInstructions, currentHeaderBytes;
     size_t numCurrentByteCodes, numByteCodeLits;
     size_t refCountSum, literalMgmtBytes, sum, decadeHigh, length;
-    size_t numSharedMultX, numSharedOnce, minSizeDecade, maxSizeDecade, i;
+    size_t numSharedMultX, numSharedOnce, minSizeDecade, maxSizeDecade;
+    Tcl_Size i;
+    size_t ui;
     char *litTableStats;
     LiteralEntry *entryPtr;
     Tcl_Obj *objPtr;
@@ -9759,7 +9691,7 @@ EvalStatsCmd(
     strBytesIfUnshared = 0.0;
     strBytesSharedMultX = 0.0;
     strBytesSharedOnce = 0.0;
-    for (i = 0;  i < globalTablePtr->numBuckets;  i++) {
+    for (ui = 0;  ui < globalTablePtr->numBuckets;  ui++) {
 	for (entryPtr = globalTablePtr->buckets[i];  entryPtr != NULL;
 		entryPtr = entryPtr->nextPtr) {
 	    if (TclHasInternalRep(entryPtr->objPtr, &tclByteCodeType)) {
@@ -9877,9 +9809,9 @@ EvalStatsCmd(
 	}
     }
     sum = 0;
-    for (i = 0;  i <= maxSizeDecade;  i++) {
-	decadeHigh = (1 << (i+1)) - 1;
-	sum += statsPtr->literalCount[i];
+    for (ui = 0;  ui <= maxSizeDecade;  ui++) {
+	decadeHigh = (1 << (ui+1)) - 1;
+	sum += statsPtr->literalCount[ui];
 	Tcl_AppendPrintfToObj(objPtr, "\t%10" TCL_SIZE_MODIFIER "d\t\t%8.0f%%\n",
 		decadeHigh, Percent(sum, statsPtr->numLiteralsCreated));
     }
@@ -9910,9 +9842,9 @@ EvalStatsCmd(
     }
     maxSizeDecade = i;
     sum = 0;
-    for (i = minSizeDecade;  i <= maxSizeDecade;  i++) {
-	decadeHigh = (1 << (i+1)) - 1;
-	sum += statsPtr->srcCount[i];
+    for (ui = minSizeDecade;  ui <= maxSizeDecade;  ui++) {
+	decadeHigh = (1 << (ui+1)) - 1;
+	sum += statsPtr->srcCount[ui];
 	Tcl_AppendPrintfToObj(objPtr, "\t%10" TCL_SIZE_MODIFIER "d\t\t%8.0f%%\n",
 		decadeHigh, Percent(sum, statsPtr->numCompilations));
     }
@@ -9934,9 +9866,9 @@ EvalStatsCmd(
     }
     maxSizeDecade = i;
     sum = 0;
-    for (i = minSizeDecade;  i <= maxSizeDecade;  i++) {
-	decadeHigh = (1 << (i+1)) - 1;
-	sum += statsPtr->byteCodeCount[i];
+    for (ui = minSizeDecade;  ui <= maxSizeDecade;  i++) {
+	decadeHigh = (1 << (ui+1)) - 1;
+	sum += statsPtr->byteCodeCount[ui];
 	Tcl_AppendPrintfToObj(objPtr, "\t%10" TCL_SIZE_MODIFIER "d\t\t%8.0f%%\n",
 		decadeHigh, Percent(sum, statsPtr->numCompilations));
     }
@@ -9958,9 +9890,9 @@ EvalStatsCmd(
     }
     maxSizeDecade = i;
     sum = 0;
-    for (i = minSizeDecade;  i <= maxSizeDecade;  i++) {
-	decadeHigh = (1 << (i+1)) - 1;
-	sum += statsPtr->lifetimeCount[i];
+    for (ui = minSizeDecade;  ui <= maxSizeDecade;  ui++) {
+	decadeHigh = (1 << (ui+1)) - 1;
+	sum += statsPtr->lifetimeCount[ui];
 	Tcl_AppendPrintfToObj(objPtr, "\t%12.3f\t\t%8.0f%%\n",
 		decadeHigh/1000.0, Percent(sum, statsPtr->numByteCodesFreed));
     }

generic/tclFileName.c

@@ -2339,8 +2339,8 @@ Tcl_AllocStatBuf(void)
  * Access functions for Tcl_StatBuf --
  *
  *	These functions provide portable read-only access to the portable
- *	fields of the Tcl_StatBuf structure (really a 'struct stat', 'struct
- *	stat64' or something else related). [TIP #316]
+ *	fields of the Tcl_StatBuf structure (really a 'struct stat'
+ *	or something else related). [TIP #316]
  *
  * Results:
  *	The value from the field being retrieved.

generic/tclIO.c

@@ -1664,10 +1664,6 @@ 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 */
 
     /*
@@ -5935,7 +5931,6 @@ DoReadChars(
 	ResetFlag(statePtr, CHANNEL_EOF|CHANNEL_ENCODING_ERROR);
 	/* TODO: UpdateInterest not needed here? */
 	UpdateInterest(chanPtr);
-
 	Tcl_SetErrno(EILSEQ);
 	return -1;
     }
@@ -6036,7 +6031,6 @@ DoReadChars(
 	    if (GotFlag(statePtr, CHANNEL_ENCODING_ERROR)
 		    && !GotFlag(statePtr, CHANNEL_STICKY_EOF)
 		    && (!GotFlag(statePtr, CHANNEL_NONBLOCKING))) {
-		copied = -1;
 		goto finish;
 	    }
 	}
@@ -6116,9 +6110,6 @@ finish:
 	copied = -1;
     }
     TclChannelRelease((Tcl_Channel)chanPtr);
-    if (copied == TCL_INDEX_NONE) {
-	ResetFlag(statePtr, CHANNEL_ENCODING_ERROR|CHANNEL_EOF);
-    }
     return copied;
 }
 
@@ -8214,7 +8205,9 @@ 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,6 +158,10 @@ 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, *resultDictPtr, *returnOptsPtr;
+    Tcl_Obj *linePtr, *chanObjPtr;
     int code = TCL_OK;
 
     if ((objc != 2) && (objc != 3)) {
@@ -306,6 +306,7 @@ Tcl_GetsObjCmd(
     lineLen = Tcl_GetsObj(chan, linePtr);
     if (lineLen == TCL_IO_FAILURE) {
 	if (!Tcl_Eof(chan) && !Tcl_InputBlocked(chan)) {
+	    Tcl_DecrRefCount(linePtr);
 
 	    /*
 	     * TIP #219.
@@ -319,14 +320,7 @@ 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;
@@ -377,7 +371,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, *resultDictPtr, *returnOptsPtr, *chanObjPtr;
+    Tcl_Obj *resultPtr, *chanObjPtr;
 
     if ((objc != 2) && (objc != 3)) {
 	Interp *iPtr;
@@ -439,6 +433,7 @@ 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
@@ -451,14 +446,7 @@ 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

@@ -379,11 +379,7 @@ ExecuteCallback(
     unsigned char *resBuf;
     Tcl_InterpState state = NULL;
     int res = TCL_OK;
-    Tcl_Obj *command = TclDuplicatePureObj(
-	interp, dataPtr->command, tclListType);
-    if (!command) {
-	return TCL_ERROR;
-    }
+    Tcl_Obj *command = TclListObjCopy(NULL, dataPtr->command);
     Tcl_Interp *eval = dataPtr->interp;
 
     Tcl_Preserve(eval);

generic/tclIORChan.c

@@ -2261,10 +2261,7 @@ NewReflectedChannel(
     rcPtr->mode = mode;
     rcPtr->interest = 0;		/* Initially no interest registered */
 
-    rcPtr->cmd = TclDuplicatePureObj(interp, cmdpfxObj, tclListType);
-    if (!rcPtr->cmd) {
-	return NULL;
-    }
+    rcPtr->cmd = TclListObjCopy(NULL, cmdpfxObj);
     Tcl_IncrRefCount(rcPtr->cmd);
     rcPtr->methods = Tcl_NewListObj(METH_WRITE + 1, NULL);
     while (mn <= (int)METH_WRITE) {
@@ -2401,10 +2398,7 @@ InvokeTclMethod(
      * before the channel id.
      */
 
-    cmd = TclDuplicatePureObj(NULL, rcPtr->cmd, tclListType);
-    if (!cmd) {
-	return TCL_ERROR;
-    }
+    cmd = TclListObjCopy(NULL, rcPtr->cmd);
     Tcl_ListObjIndex(NULL, rcPtr->methods, method, &methObj);
     Tcl_ListObjAppendElement(NULL, cmd, methObj);
     Tcl_ListObjAppendElement(NULL, cmd, rcPtr->name);

generic/tclIOUtil.c

@@ -1687,7 +1687,7 @@ Tcl_FSEvalFileEx(
 				   use the utf-8 encoding. */
 {
     Tcl_Size length;
-	int result = TCL_ERROR;
+    int result = TCL_ERROR;
     Tcl_StatBuf statBuf;
     Tcl_Obj *oldScriptFile;
     Interp *iPtr;
@@ -1734,11 +1734,6 @@ 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);
@@ -1807,7 +1802,7 @@ Tcl_FSEvalFileEx(
 
 	const char *pathString = Tcl_GetStringFromObj(pathPtr, &length);
 	unsigned limit = 150;
-	int overflow = (length > limit);
+	int overflow = ((unsigned)length > limit);
 
 	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
 		"\n    (file \"%.*s%s\" line %d)",
@@ -1959,12 +1954,12 @@ EvalFileCallback(
 
 	Tcl_Size length;
 	const char *pathString = Tcl_GetStringFromObj(pathPtr, &length);
-	const unsigned int limit = 150;
-	int overflow = (length > limit);
+	const unsigned limit = 150;
+	int overflow = ((unsigned)length > limit);
 
 	Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
 		"\n    (file \"%.*s%s\" line %d)",
-		(overflow ? limit : (unsigned int)length), pathString,
+		(overflow ? limit : (unsigned)length), pathString,
 		(overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
     }
 

generic/tclIndexObj.c

@@ -37,7 +37,7 @@ static void		PrintUsage(Tcl_Interp *interp,
  * that can be invoked by generic object code.
  */
 
-static const Tcl_ObjType indexType = {
+const Tcl_ObjType tclIndexType = {
     "index",			/* name */
     FreeIndex,			/* freeIntRepProc */
     DupIndex,			/* dupIntRepProc */
@@ -213,7 +213,7 @@ Tcl_GetIndexFromObjStruct(
      */
 
     if (objPtr && !(flags & TCL_INDEX_TEMP_TABLE)) {
-    irPtr = TclFetchInternalRep(objPtr, &indexType);
+    irPtr = TclFetchInternalRep(objPtr, &tclIndexType);
     if (irPtr) {
 	indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;
 	if ((indexRep->tablePtr == tablePtr)
@@ -282,7 +282,7 @@ Tcl_GetIndexFromObjStruct(
      */
 
     if (objPtr && (index != TCL_INDEX_NONE) && !(flags & TCL_INDEX_TEMP_TABLE)) {
-    irPtr = TclFetchInternalRep(objPtr, &indexType);
+    irPtr = TclFetchInternalRep(objPtr, &tclIndexType);
     if (irPtr) {
 	indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;
     } else {
@@ -290,7 +290,7 @@ Tcl_GetIndexFromObjStruct(
 
 	indexRep = (IndexRep*)Tcl_Alloc(sizeof(IndexRep));
 	ir.twoPtrValue.ptr1 = indexRep;
-	Tcl_StoreInternalRep(objPtr, &indexType, &ir);
+	Tcl_StoreInternalRep(objPtr, &tclIndexType, &ir);
     }
     indexRep->tablePtr = (void *) tablePtr;
     indexRep->offset = offset;
@@ -385,7 +385,7 @@ static void
 UpdateStringOfIndex(
     Tcl_Obj *objPtr)
 {
-    IndexRep *indexRep = (IndexRep *)TclFetchInternalRep(objPtr, &indexType)->twoPtrValue.ptr1;
+    IndexRep *indexRep = (IndexRep *)TclFetchInternalRep(objPtr, &tclIndexType)->twoPtrValue.ptr1;
     const char *indexStr = EXPAND_OF(indexRep);
 
     Tcl_InitStringRep(objPtr, indexStr, strlen(indexStr));
@@ -417,11 +417,11 @@ DupIndex(
     Tcl_ObjInternalRep ir;
     IndexRep *dupIndexRep = (IndexRep *)Tcl_Alloc(sizeof(IndexRep));
 
-    memcpy(dupIndexRep, TclFetchInternalRep(srcPtr, &indexType)->twoPtrValue.ptr1,
+    memcpy(dupIndexRep, TclFetchInternalRep(srcPtr, &tclIndexType)->twoPtrValue.ptr1,
 	    sizeof(IndexRep));
 
     ir.twoPtrValue.ptr1 = dupIndexRep;
-    Tcl_StoreInternalRep(dupPtr, &indexType, &ir);
+    Tcl_StoreInternalRep(dupPtr, &tclIndexType, &ir);
 }
 
 /*
@@ -445,7 +445,7 @@ static void
 FreeIndex(
     Tcl_Obj *objPtr)
 {
-    Tcl_Free(TclFetchInternalRep(objPtr, &indexType)->twoPtrValue.ptr1);
+    Tcl_Free(TclFetchInternalRep(objPtr, &tclIndexType)->twoPtrValue.ptr1);
     objPtr->typePtr = NULL;
 }
 
@@ -865,7 +865,7 @@ Tcl_WrongNumArgs(
 	     */
 	    const Tcl_ObjInternalRep *irPtr;
 
-	    if ((irPtr = TclFetchInternalRep(origObjv[i], &indexType))) {
+	    if ((irPtr = TclFetchInternalRep(origObjv[i], &tclIndexType))) {
 		IndexRep *indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;
 
 		elementStr = EXPAND_OF(indexRep);
@@ -912,7 +912,7 @@ Tcl_WrongNumArgs(
 	 */
 	const Tcl_ObjInternalRep *irPtr;
 
-	if ((irPtr = TclFetchInternalRep(objv[i], &indexType))) {
+	if ((irPtr = TclFetchInternalRep(objv[i], &tclIndexType))) {
 	    IndexRep *indexRep = (IndexRep *)irPtr->twoPtrValue.ptr1;
 
 	    Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), NULL);
@@ -1361,7 +1361,7 @@ TclGetCompletionCodeFromObj(
 	"ok", "error", "return", "break", "continue", NULL
     };
 
-    if (!TclHasInternalRep(value, &indexType)
+    if (!TclHasInternalRep(value, &tclIndexType)
 	    && TclGetIntFromObj(NULL, value, codePtr) == TCL_OK) {
 	return TCL_OK;
     }

generic/tclInt.h

@@ -11,7 +11,6 @@
  * 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.
@@ -47,13 +46,10 @@
 
 #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
 
 /*
@@ -70,11 +66,8 @@
 
 #include <ctype.h>
 #include <stdarg.h>
-#ifdef NO_STDLIB_H
-#   include "../compat/stdlib.h"
-#else
-#   include <stdlib.h>
-#endif
+#include <stdlib.h>
+#include <stdint.h>
 #ifdef NO_STRING_H
 #include "../compat/string.h"
 #else
@@ -210,223 +203,6 @@ 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.
@@ -446,7 +222,9 @@ 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;
 
 /*
@@ -496,7 +274,11 @@ 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
@@ -1177,6 +959,9 @@ 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. */
@@ -1187,10 +972,12 @@ 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
@@ -1248,7 +1035,11 @@ 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
@@ -1292,6 +1083,102 @@ typedef struct ActiveInterpTrace {
 #define TCL_TRACE_ENTER_EXEC	1
 #define TCL_TRACE_LEAVE_EXEC	2
 
+#if TCL_MAJOR_VERSION > 8
+#define TclObjTypeHasProc(objPtr, proc) (((objPtr)->typePtr \
+	&& ((offsetof(Tcl_ObjType, proc) < offsetof(Tcl_ObjType, version)) \
+	|| (offsetof(Tcl_ObjType, proc) < (objPtr)->typePtr->version))) ? \
+	((objPtr)->typePtr)->proc : NULL)
+
+MODULE_SCOPE Tcl_Size TclLengthOne(Tcl_Obj *);
+
+
+/*
+ * Abstract List
+ *
+ *  This structure provides the functions used in List operations to emulate a
+ *  List for AbstractList types.
+ */
+
+
+static inline Tcl_Size
+TclObjTypeLength(Tcl_Obj *objPtr)
+{
+    Tcl_ObjTypeLengthProc *proc = TclObjTypeHasProc(objPtr, lengthProc);
+    return proc(objPtr);
+}
+static inline int
+TclObjTypeIndex(
+    Tcl_Interp *interp,
+    Tcl_Obj *objPtr,
+    Tcl_Size index,
+    Tcl_Obj **elemObjPtr)
+{
+    Tcl_ObjTypeIndexProc *proc = TclObjTypeHasProc(objPtr, indexProc);
+    return proc(interp, objPtr, index, elemObjPtr);
+}
+static inline int
+TclObjTypeSlice(
+    Tcl_Interp *interp,
+    Tcl_Obj *objPtr,
+    Tcl_Size fromIdx,
+    Tcl_Size toIdx,
+    Tcl_Obj **newObjPtr)
+{
+    Tcl_ObjTypeSliceProc *proc = TclObjTypeHasProc(objPtr, sliceProc);
+    return proc(interp, objPtr, fromIdx, toIdx, newObjPtr);
+}
+static inline int
+TclObjTypeReverse(
+    Tcl_Interp *interp,
+    Tcl_Obj *objPtr,
+    Tcl_Obj **newObjPtr)
+{
+    Tcl_ObjTypeReverseProc *proc = TclObjTypeHasProc(objPtr, reverseProc);
+    return proc(interp, objPtr, newObjPtr);
+}
+static inline int
+TclObjTypeGetElements(
+    Tcl_Interp *interp,
+    Tcl_Obj *objPtr,
+    Tcl_Size *objCPtr,
+    Tcl_Obj ***objVPtr)
+{
+    Tcl_ObjTypeGetElements *proc = TclObjTypeHasProc(objPtr, getElementsProc);
+    return proc(interp, objPtr, objCPtr, objVPtr);
+}
+static inline Tcl_Obj*
+TclObjTypeSetElement(
+    Tcl_Interp *interp,
+    Tcl_Obj *objPtr,
+    Tcl_Size indexCount,
+    Tcl_Obj *const indexArray[],
+    Tcl_Obj *valueObj)
+{
+    Tcl_ObjTypeSetElement *proc = TclObjTypeHasProc(objPtr, setElementProc);
+    return proc(interp, objPtr, indexCount, indexArray, valueObj);
+}
+static inline int
+TclObjTypeReplace(
+    Tcl_Interp *interp,
+    Tcl_Obj *objPtr,
+    Tcl_Size first,
+    Tcl_Size numToDelete,
+    Tcl_Size numToInsert,
+    Tcl_Obj *const insertObjs[])
+{
+    Tcl_ObjTypeReplaceProc *proc = TclObjTypeHasProc(objPtr, replaceProc);
+    return proc(interp, objPtr, first, numToDelete, numToInsert, insertObjs);
+}
+static inline int
+TclObjTypeInOperator(Tcl_Interp *interp, struct Tcl_Obj *valueObj,
+		     struct Tcl_Obj *listObj, int *boolResult)
+{
+    Tcl_ObjTypeInOperatorProc *proc = TclObjTypeHasProc(listObj, inOperProc);
+    return proc(interp, valueObj, listObj, boolResult);
+}
+#endif /* TCL_MAJOR_VERSION > 8 */
+
+
 /*
  * 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
@@ -1434,7 +1321,7 @@ typedef struct CmdFrame {
     int type;			/* Values see below. */
     int level;			/* Number of frames in stack, prevent O(n)
 				 * scan of list. */
-    int *line;			/* Lines the words of the command start on. */
+    Tcl_Size *line;		/* Lines the words of the command start on. */
     Tcl_Size nline;
     CallFrame *framePtr;	/* Procedure activation record, may be
 				 * NULL. */
@@ -1529,7 +1416,7 @@ typedef struct CFWordBC {
 typedef struct ContLineLoc {
     Tcl_Size num;			/* Number of entries in loc, not counting the
 				 * final -1 marker entry. */
-    int loc[TCLFLEXARRAY];/* Table of locations, as character offsets.
+    Tcl_Size loc[TCLFLEXARRAY];/* Table of locations, as character offsets.
 				 * The table is allocated as part of the
 				 * structure, extending behind the nominal end
 				 * of the structure. An entry containing the
@@ -2073,7 +1960,18 @@ 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.
@@ -2102,6 +2000,12 @@ 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.
      */
@@ -2124,6 +2028,9 @@ 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
@@ -2161,6 +2068,9 @@ 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. */
@@ -2614,7 +2524,6 @@ typedef enum TclEolTranslation {
 #define TCL_INVOKE_NO_UNKNOWN	(1<<1)
 #define TCL_INVOKE_NO_TRACEBACK	(1<<2)
 
-
 /*
  * ListStore --
  *
@@ -2764,8 +2673,8 @@ typedef struct ListRep {
  * (1) No string representation exists which means it will obviously have
  * to be generated from the list representation when needed
  * (2) The ListStore flags is marked canonical. This is done at the time
- * the string representation is generated from the list IF the list
- * representation does not have a span (see comments in UpdateStringOfList).
+ * the string representation is generated from the list under certain
+ * conditions (see comments in UpdateStringOfList).
  * (3) The list representation does not have a span component. This is
  * because list Tcl_Obj's with spans are always created from existing lists
  * and never from strings (see SetListFromAny) and thus their string
@@ -2783,10 +2692,10 @@ typedef struct ListRep {
  * converted to a list.
  */
 #define TclListObjGetElementsM(interp_, listObj_, objcPtr_, objvPtr_)    \
-    (((listObj_)->typePtr == tclListType)                               \
-	 ? ((ListObjGetElements((listObj_), *(objcPtr_), *(objvPtr_))),  \
-	    TCL_OK)                                                      \
-	 : Tcl_ListObjGetElements(                                       \
+    (((listObj_)->typePtr == &tclListType)                              \
+	 ? ((ListObjGetElements((listObj_), *(objcPtr_), *(objvPtr_))), \
+	    TCL_OK)                                                     \
+	 : Tcl_ListObjGetElements(                                      \
 	     (interp_), (listObj_), (objcPtr_), (objvPtr_)))
 
 /*
@@ -2794,14 +2703,13 @@ 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)                           \
-	 ? ((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)    \
-	? ListObjIsCanonical((listObj_)) : 0)
+#define TclListObjIsCanonical(listObj_) \
+    (((listObj_)->typePtr == &tclListType) ? ListObjIsCanonical((listObj_)) : 0)
 
 /*
  * Modes for collecting (or not) in the implementations of TclNRForeachCmd,
@@ -2819,20 +2727,29 @@ 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 \
-	    || (objPtr)->typePtr == tclBooleanType) \
+    (((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)			\
+	? (*(intPtr) = ((objPtr)->internalRep.wideValue!=0), TCL_OK)	\
+	: ((objPtr)->typePtr == &tclBooleanType)			\
+	? (*(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)	\
+    (((objPtr)->typePtr == &tclIntType)	\
 	    ? ((*(longPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \
 	    : Tcl_GetLongFromObj((interp), (objPtr), (longPtr)))
 #else
 #define TclGetLongFromObj(interp, objPtr, longPtr) \
-    (((objPtr)->typePtr == tclIntType \
+    (((objPtr)->typePtr == &tclIntType \
 	    && (objPtr)->internalRep.wideValue >= (Tcl_WideInt)(LONG_MIN) \
 	    && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(LONG_MAX)) \
 	    ? ((*(longPtr) = (long)(objPtr)->internalRep.wideValue), TCL_OK) \
@@ -2840,13 +2757,13 @@ typedef struct ListRep {
 #endif
 
 #define TclGetIntFromObj(interp, objPtr, intPtr) \
-    (((objPtr)->typePtr == tclIntType \
+    (((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) && ((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)))
@@ -2860,7 +2777,7 @@ typedef struct ListRep {
  */
 
 #define TclGetWideIntFromObj(interp, objPtr, wideIntPtr) \
-    (((objPtr)->typePtr == tclIntType)					\
+    (((objPtr)->typePtr == &tclIntType)					\
 	? (*(wideIntPtr) =						\
 		((objPtr)->internalRep.wideValue), TCL_OK) :		\
 	Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr)))
@@ -3113,6 +3030,7 @@ MODULE_SCOPE TclPlatformType tclPlatform;
  */
 
 MODULE_SCOPE Tcl_Encoding tclIdentityEncoding;
+MODULE_SCOPE Tcl_Encoding tclUtf8Encoding;
 MODULE_SCOPE int
 TclEncodingProfileNameToId(Tcl_Interp *interp,
 			   const char *profileName,
@@ -3135,13 +3053,13 @@ MODULE_SCOPE void *tclTimeClientData;
  * Variables denoting the Tcl object types defined in the core.
  */
 
-MODULE_SCOPE const Tcl_ObjType *tclBignumType;
-MODULE_SCOPE const Tcl_ObjType *tclBooleanType;
+MODULE_SCOPE const Tcl_ObjType tclBignumType;
+MODULE_SCOPE const Tcl_ObjType tclBooleanType;
 MODULE_SCOPE const Tcl_ObjType tclByteCodeType;
-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 tclDoubleType;
+MODULE_SCOPE const Tcl_ObjType tclIntType;
+MODULE_SCOPE const Tcl_ObjType tclIndexType;
+MODULE_SCOPE const Tcl_ObjType tclListType;
 MODULE_SCOPE const Tcl_ObjType tclDictType;
 MODULE_SCOPE const Tcl_ObjType tclProcBodyType;
 MODULE_SCOPE const Tcl_ObjType tclStringType;
@@ -3284,11 +3202,12 @@ 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,
 			    int flags);
-MODULE_SCOPE void	TclAdvanceContinuations(Tcl_Size *line, int **next,
+MODULE_SCOPE void	TclAdvanceContinuations(Tcl_Size *line, Tcl_Size **next,
 			    int loc);
 MODULE_SCOPE void	TclAdvanceLines(Tcl_Size *line, const char *start,
 			    const char *end);
@@ -3298,7 +3217,7 @@ MODULE_SCOPE void	TclArgumentRelease(Tcl_Interp *interp,
 			    Tcl_Obj *objv[], int objc);
 MODULE_SCOPE void	TclArgumentBCEnter(Tcl_Interp *interp,
 			    Tcl_Obj *objv[], int objc,
-			    void *codePtr, CmdFrame *cfPtr, int cmd, Tcl_Size pc);
+			    void *codePtr, CmdFrame *cfPtr, Tcl_Size cmd, Tcl_Size pc);
 MODULE_SCOPE void	TclArgumentBCRelease(Tcl_Interp *interp,
 			    CmdFrame *cfPtr);
 MODULE_SCOPE void	TclArgumentGet(Tcl_Interp *interp, Tcl_Obj *obj,
@@ -3307,7 +3226,6 @@ 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);
@@ -3324,9 +3242,9 @@ MODULE_SCOPE Tcl_NRPostProc TclClearRootEnsemble;
 MODULE_SCOPE int	TclCompareTwoNumbers(Tcl_Obj *valuePtr,
 			    Tcl_Obj *value2Ptr);
 MODULE_SCOPE ContLineLoc *TclContinuationsEnter(Tcl_Obj *objPtr, Tcl_Size num,
-			    int *loc);
+			    Tcl_Size *loc);
 MODULE_SCOPE void	TclContinuationsEnterDerived(Tcl_Obj *objPtr,
-			    int start, int *clNext);
+			    Tcl_Size start, Tcl_Size *clNext);
 MODULE_SCOPE ContLineLoc *TclContinuationsGet(Tcl_Obj *objPtr);
 MODULE_SCOPE void	TclContinuationsCopy(Tcl_Obj *objPtr,
 			    Tcl_Obj *originObjPtr);
@@ -3341,8 +3259,7 @@ 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_Obj*	TclDuplicatePureObj(Tcl_Interp *interp,
-			    Tcl_Obj * objPtr, const Tcl_ObjType *typPtr);
+MODULE_SCOPE Tcl_Size	TclDictGetSize(Tcl_Obj *dictPtr);
 MODULE_SCOPE int	TclFindDictElement(Tcl_Interp *interp,
 			    const char *dict, Tcl_Size dictLength,
 			    const char **elementPtr, const char **nextPtr,
@@ -3350,7 +3267,7 @@ MODULE_SCOPE int	TclFindDictElement(Tcl_Interp *interp,
 /* TIP #280 - Modified token based evaluation, with line information. */
 MODULE_SCOPE int	TclEvalEx(Tcl_Interp *interp, const char *script,
 			    Tcl_Size numBytes, int flags, Tcl_Size line,
-			    int *clNextOuter, const char *outerScript);
+			    Tcl_Size *clNextOuter, const char *outerScript);
 MODULE_SCOPE Tcl_ObjCmdProc TclFileAttrsCmd;
 MODULE_SCOPE Tcl_ObjCmdProc TclFileCopyCmd;
 MODULE_SCOPE Tcl_ObjCmdProc TclFileDeleteCmd;
@@ -3431,8 +3348,6 @@ 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,
@@ -3472,12 +3387,10 @@ 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 void	TclListLines(Tcl_Obj *listObj, Tcl_Size line, Tcl_Size n,
+			    Tcl_Size *lines, Tcl_Obj *const *elems);
+MODULE_SCOPE Tcl_Obj *	TclListObjCopy(Tcl_Interp *interp, Tcl_Obj *listPtr);
 MODULE_SCOPE int	TclListObjAppendElements(Tcl_Interp *interp,
 			    Tcl_Obj *toObj, Tcl_Size elemCount,
 			    Tcl_Obj *const elemObjv[]);
@@ -3485,9 +3398,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(tclObjTypeInterfaceArgsListSetList);
-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_Command TclMakeEnsemble(Tcl_Interp *interp, const char *name,
 			    const EnsembleImplMap map[]);
 MODULE_SCOPE int TclMakeSafe(Tcl_Interp *interp);
@@ -3500,9 +3413,6 @@ 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);
@@ -3528,6 +3438,11 @@ MODULE_SCOPE int	TclpObjLstat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
 MODULE_SCOPE Tcl_Obj *	TclpTempFileName(void);
 MODULE_SCOPE Tcl_Obj *  TclpTempFileNameForLibrary(Tcl_Interp *interp,
 			    Tcl_Obj* pathPtr);
+MODULE_SCOPE int	TclNewArithSeriesObj(Tcl_Interp *interp, Tcl_Obj **arithSeriesPtr,
+                            int useDoubles, Tcl_Obj *startObj, Tcl_Obj *endObj,
+                            Tcl_Obj *stepObj, Tcl_Obj *lenObj);
+MODULE_SCOPE Tcl_Obj *  TclNewStringListObj(Tcl_Interp *interp,
+			    Tcl_Obj *srcStringObj);
 MODULE_SCOPE Tcl_Obj *	TclNewFSPathObj(Tcl_Obj *dirPtr, const char *addStrRep,
 			    Tcl_Size len);
 MODULE_SCOPE void	TclpAlertNotifier(void *clientData);
@@ -3584,7 +3499,6 @@ 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);
@@ -3632,8 +3546,6 @@ 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,
@@ -3648,7 +3560,7 @@ MODULE_SCOPE void	TclSubstParse(Tcl_Interp *interp, const char *bytes,
 			    Tcl_InterpState *statePtr);
 MODULE_SCOPE int	TclSubstTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr,
 			    Tcl_Size count, int *tokensLeftPtr, Tcl_Size line,
-			    int *clNextOuter, const char *outerScript);
+			    Tcl_Size *clNextOuter, const char *outerScript);
 MODULE_SCOPE Tcl_Size	TclTrim(const char *bytes, Tcl_Size numBytes,
 			    const char *trim, Tcl_Size numTrim, Tcl_Size *trimRight);
 MODULE_SCOPE Tcl_Size	TclTrimLeft(const char *bytes, Tcl_Size numBytes,
@@ -3659,10 +3571,18 @@ 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,
@@ -4395,6 +4315,7 @@ MODULE_SCOPE TclProcessWaitStatus TclProcessWait(Tcl_Pid pid, int options,
 			    int *codePtr, Tcl_Obj **msgObjPtr,
 			    Tcl_Obj **errorObjPtr);
 MODULE_SCOPE int TclClose(Tcl_Interp *,	Tcl_Channel chan);
+
 /*
  * TIP #508: [array default]
  */
@@ -4418,6 +4339,7 @@ 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)
@@ -4930,10 +4852,17 @@ 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
 
 /*
  *----------------------------------------------------------------
@@ -4996,7 +4925,7 @@ MODULE_SCOPE int	TclIsPureByteArray(Tcl_Obj *objPtr);
  *----------------------------------------------------------------
  */
 
-#if defined(WORDS_BIGENDIAN)
+#if defined(WORDS_BIGENDIAN) && (TCL_UTF_MAX > 3)
 #   define TclUniCharNcmp(cs,ct,n) memcmp((cs),(ct),(n)*sizeof(Tcl_UniChar))
 #endif /* WORDS_BIGENDIAN */
 
@@ -5042,8 +4971,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;
+MODULE_SCOPE Tcl_LibraryInitProc Tcl_ABSListTest_Init;
+
 
 /*
  *----------------------------------------------------------------
@@ -5074,7 +5003,7 @@ MODULE_SCOPE Tcl_LibraryInitProc TcltestObjectInterfaceListIntegerInit;
 	Tcl_ObjInternalRep ir;				\
 	ir.wideValue = (Tcl_WideInt) i;			\
 	TclInvalidateStringRep(objPtr);			\
-	Tcl_StoreInternalRep(objPtr, tclIntType, &ir);	\
+	Tcl_StoreInternalRep(objPtr, &tclIntType, &ir);	\
     } while (0)
 
 #define TclSetDoubleObj(objPtr, d) \
@@ -5082,7 +5011,7 @@ MODULE_SCOPE Tcl_LibraryInitProc TcltestObjectInterfaceListIntegerInit;
 	Tcl_ObjInternalRep ir;				\
 	ir.doubleValue = (double) d;			\
 	TclInvalidateStringRep(objPtr);			\
-	Tcl_StoreInternalRep(objPtr, tclDoubleType, &ir);	\
+	Tcl_StoreInternalRep(objPtr, &tclDoubleType, &ir);	\
     } while (0)
 
 /*
@@ -5093,7 +5022,7 @@ MODULE_SCOPE Tcl_LibraryInitProc TcltestObjectInterfaceListIntegerInit;
  *
  * MODULE_SCOPE void	TclNewIntObj(Tcl_Obj *objPtr, Tcl_WideInt w);
  * MODULE_SCOPE void	TclNewDoubleObj(Tcl_Obj *objPtr, double d);
- * MODULE_SCOPE void	TclNewStringObj(Tcl_Obj *objPtr, const char *s, size_t len);
+ * MODULE_SCOPE void	TclNewStringObj(Tcl_Obj *objPtr, const char *s, Tcl_Size len);
  * MODULE_SCOPE void	TclNewLiteralStringObj(Tcl_Obj*objPtr, const char *sLiteral);
  *
  *----------------------------------------------------------------
@@ -5107,7 +5036,7 @@ MODULE_SCOPE Tcl_LibraryInitProc TcltestObjectInterfaceListIntegerInit;
 	(objPtr)->refCount = 0;				\
 	(objPtr)->bytes = NULL;				\
 	(objPtr)->internalRep.wideValue = (Tcl_WideInt)(w);	\
-	(objPtr)->typePtr = tclIntType;		\
+	(objPtr)->typePtr = &tclIntType;		\
 	TCL_DTRACE_OBJ_CREATE(objPtr);			\
     } while (0)
 
@@ -5126,13 +5055,13 @@ MODULE_SCOPE Tcl_LibraryInitProc TcltestObjectInterfaceListIntegerInit;
 	    TclSetBignumInternalRep((objPtr), &bignumValue_);	\
 	} else {	\
 	    (objPtr)->internalRep.wideValue = (Tcl_WideInt)(uw_);	\
-	    (objPtr)->typePtr = tclIntType;		\
+	    (objPtr)->typePtr = &tclIntType;		\
 	}	\
 	TCL_DTRACE_OBJ_CREATE(objPtr);			\
     } while (0)
 
-#define TclNewIndexObj(objPtr, uw) \
-    TclNewIntObj(objPtr, uw)
+#define TclNewIndexObj(objPtr, w) \
+    TclNewIntObj(objPtr, w)
 
 #define TclNewDoubleObj(objPtr, d) \
     do {							\
@@ -5141,7 +5070,7 @@ MODULE_SCOPE Tcl_LibraryInitProc TcltestObjectInterfaceListIntegerInit;
 	(objPtr)->refCount = 0;					\
 	(objPtr)->bytes = NULL;					\
 	(objPtr)->internalRep.doubleValue = (double)(d);	\
-	(objPtr)->typePtr = tclDoubleType;			\
+	(objPtr)->typePtr = &tclDoubleType;			\
 	TCL_DTRACE_OBJ_CREATE(objPtr);				\
     } while (0)
 
@@ -5402,7 +5331,7 @@ typedef struct NRE_callback {
 #define TCLNR_FREE(interp, ptr)  TclSmallFreeEx((interp), (ptr))
 #else
 #define TCLNR_ALLOC(interp, ptr) \
-    (ptr = (Tcl_Alloc(sizeof(NRE_callback))))
+    ((ptr) = Tcl_Alloc(sizeof(NRE_callback)))
 #define TCLNR_FREE(interp, ptr)  Tcl_Free(ptr)
 #endif
 

generic/tclIntDecls.h

@@ -1281,6 +1281,15 @@ 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,6 +30,535 @@
  * 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(void *hProcess, Tcl_Size 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 */
+    Tcl_Size (*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) (void *hProcess, Tcl_Size 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
@@ -202,6 +731,7 @@ 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
@@ -209,13 +739,17 @@ 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
 
 #undef TclpCreateTempFile_
 #undef TclUnixWaitForFile_
-#ifdef MAC_OSX_TCL /* not accessable on Win32/UNIX */
+#ifdef MAC_OSX_TCL /* not accessible on Win32/UNIX */
 MODULE_SCOPE int TclMacOSXGetFileAttribute(Tcl_Interp *interp,
 	int objIndex, Tcl_Obj *fileName,
 	Tcl_Obj **attributePtrPtr);
@@ -248,6 +782,15 @@ 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,7 +624,9 @@ NRInterpCmd(
 	"hidden",	"issafe",	"invokehidden",
 	"limit",	"marktrusted",	"recursionlimit",
 	"share",
+#ifndef TCL_NO_DEPRECATED
 	"slaves",
+#endif
 	"target",	"transfer",	NULL
     };
     static const char *const optionsNoSlaves[] = {
@@ -642,7 +644,9 @@ 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;
 
@@ -1029,7 +1033,9 @@ 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,6 +179,14 @@ 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 {
@@ -254,6 +262,14 @@ 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;
@@ -531,7 +547,7 @@ GetDouble(
 	return 0;
     } else {
 #ifdef ACCEPT_NAN
-	Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objPtr, tclDoubleType);
+	Tcl_ObjInternalRep *irPtr = TclFetchInternalRep(objPtr, &tclDoubleType);
 
 	if (irPtr != NULL) {
 	    *dblPtr = irPtr->doubleValue;

generic/tclNamesp.c

@@ -395,7 +395,7 @@ Tcl_PopCallFrame(
 	Tcl_Free(framePtr->varTablePtr);
 	framePtr->varTablePtr = NULL;
     }
-    if (framePtr->numCompiledLocals + 1 > 1) {
+    if (framePtr->numCompiledLocals > 0) {
 	TclDeleteCompiledLocalVars(iPtr, framePtr);
 	if (framePtr->localCachePtr->refCount-- <= 1) {
 	    TclFreeLocalCache(interp, framePtr->localCachePtr);

generic/tclOO.c

@@ -138,6 +138,9 @@ 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 " };";
@@ -257,6 +260,10 @@ 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/tclOOMethod.c

@@ -588,7 +588,7 @@ TclOOMakeProcInstanceMethod(
 
 		cfPtr->level = -1;
 		cfPtr->type = context.type;
-		cfPtr->line = (int *)Tcl_Alloc(sizeof(int));
+		cfPtr->line = (Tcl_Size *)Tcl_Alloc(sizeof(Tcl_Size));
 		cfPtr->line[0] = context.line[3];
 		cfPtr->nline = 1;
 		cfPtr->framePtr = NULL;
@@ -701,7 +701,7 @@ TclOOMakeProcMethod(
 
 		cfPtr->level = -1;
 		cfPtr->type = context.type;
-		cfPtr->line = (int *)Tcl_Alloc(sizeof(int));
+		cfPtr->line = (Tcl_Size *)Tcl_Alloc(sizeof(Tcl_Size));
 		cfPtr->line[0] = context.line[3];
 		cfPtr->nline = 1;
 		cfPtr->framePtr = NULL;

generic/tclOOScript.h

@@ -164,12 +164,13 @@ static const char *tclOOSetupScript =
 "\t\tmethod -appendifnew -export args {\n"
 "\t\t\tset my [namespace which my]\n"
 "\t\t\tset current [uplevel 1 [list $my Get]]\n"
-"\t\t\tset args [lmap a $args {\n"
+"\t\t\tforeach a $args {\n"
 "\t\t\t\tset a [uplevel 1 [list $my Resolve $a]]\n"
-"\t\t\t\tif {$a in $current} continue\n"
-"\t\t\t\tset a\n"
-"\t\t\t}]\n"
-"\t\t\ttailcall my Set [list {*}$current {*}$args]\n"
+"\t\t\t\tif {$a ni $current} {\n"
+"\t\t\t\t\tlappend current $a\n"
+"\t\t\t\t}\n"
+"\t\t\t}\n"
+"\t\t\ttailcall my Set $current\n"
 "\t\t}\n"
 "\t\tmethod -clear -export {} {tailcall my Set {}}\n"
 "\t\tmethod -prepend -export args {\n"

generic/tclObj.c

@@ -9,7 +9,6 @@
  * 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.
@@ -20,7 +19,6 @@
 #include <math.h>
 #include <assert.h>
 
-
 /*
  * Table of all object types.
  */
@@ -29,10 +27,6 @@ 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.
  */
@@ -208,9 +202,6 @@ static void		DupBignum(Tcl_Obj *objPtr, Tcl_Obj *copyPtr);
 static void		UpdateStringOfBignum(Tcl_Obj *objPtr);
 static int		GetBignumFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
 			    int copy, mp_int *bignumValue);
-static int		SetDuplicatePureObj(Tcl_Interp *interp,
-			    Tcl_Obj *dupPtr, Tcl_Obj *objPtr,
-			    const Tcl_ObjType *typePtr);
 
 /*
  * Prototypes for the array hash key methods.
@@ -227,32 +218,6 @@ 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
@@ -260,55 +225,39 @@ ObjInterface tclScalarInterface = {
  * implementations.
  */
 
-const ObjectType tclBooleanObjType= {
+const Tcl_ObjType tclBooleanType= {
     "boolean",			/* name */
     NULL,			/* freeIntRepProc */
     NULL,			/* dupIntRepProc */
     NULL,			/* updateStringProc */
-    TclSetBooleanFromAny,		/* setFromAnyProc */
-    2,
-    (Tcl_ObjInterface *)&tclScalarInterface
+    TclSetBooleanFromAny,	/* setFromAnyProc */
+    TCL_OBJTYPE_V1(TclLengthOne)
 };
-
-
-MODULE_SCOPE const Tcl_ObjType *tclBooleanType = (Tcl_ObjType *)&tclBooleanObjType;
-
-const ObjectType tclDoubleObjType= {
+const Tcl_ObjType tclDoubleType= {
     "double",			/* name */
     NULL,			/* freeIntRepProc */
     NULL,			/* dupIntRepProc */
     UpdateStringOfDouble,	/* updateStringProc */
     SetDoubleFromAny,		/* setFromAnyProc */
-    2,
-    (Tcl_ObjInterface *)&tclScalarInterface
+    TCL_OBJTYPE_V1(TclLengthOne)
 };
-
-MODULE_SCOPE const Tcl_ObjType *tclDoubleType = (Tcl_ObjType *)&tclDoubleObjType;
-
-const ObjectType tclIntObjType = {
+const Tcl_ObjType tclIntType = {
     "int",			/* name */
     NULL,			/* freeIntRepProc */
     NULL,			/* dupIntRepProc */
     UpdateStringOfInt,		/* updateStringProc */
     SetIntFromAny,		/* setFromAnyProc */
-    2,
-    (Tcl_ObjInterface *)&tclScalarInterface
+    TCL_OBJTYPE_V1(TclLengthOne)
 };
-
-MODULE_SCOPE const Tcl_ObjType *tclIntType = (Tcl_ObjType *)&tclIntObjType;
-
-const ObjectType tclBignumObjType = {
+const Tcl_ObjType tclBignumType = {
     "bignum",			/* name */
     FreeBignum,			/* freeIntRepProc */
     DupBignum,			/* dupIntRepProc */
     UpdateStringOfBignum,	/* updateStringProc */
     NULL,			/* setFromAnyProc */
-    2,
-    (Tcl_ObjInterface *)&tclScalarInterface
+    TCL_OBJTYPE_V1(TclLengthOne)
 };
 
-MODULE_SCOPE const Tcl_ObjType *tclBignumType = (Tcl_ObjType *)&tclBignumObjType;
-
 /*
  * The structure below defines the Tcl obj hash key type.
  */
@@ -351,7 +300,7 @@ Tcl_ObjType tclCmdNameType = {
     DupCmdNameInternalRep,	/* dupIntRepProc */
     NULL,			/* updateStringProc */
     SetCmdNameFromAny,		/* setFromAnyProc */
-    0
+    TCL_OBJTYPE_V0
 };
 
 /*
@@ -428,15 +377,24 @@ TclInitObjSubsystem(void)
     Tcl_InitHashTable(&typeTable, TCL_STRING_KEYS);
     Tcl_MutexUnlock(&tableMutex);
 
-    Tcl_RegisterObjType(tclDoubleType);
+    Tcl_RegisterObjType(&tclDoubleType);
     Tcl_RegisterObjType(&tclStringType);
-    Tcl_RegisterObjType(tclListType);
+    Tcl_RegisterObjType(&tclListType);
     Tcl_RegisterObjType(&tclDictType);
     Tcl_RegisterObjType(&tclByteCodeType);
     Tcl_RegisterObjType(&tclCmdNameType);
     Tcl_RegisterObjType(&tclRegexpType);
     Tcl_RegisterObjType(&tclProcBodyType);
 
+    /* For backward compatibility only ... */
+#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
+    Tcl_RegisterObjType(&tclIntType);
+#if !defined(TCL_WIDE_INT_IS_LONG)
+    Tcl_RegisterObjType(&oldIntType);
+#endif
+    Tcl_RegisterObjType(&oldBooleanType);
+#endif
+
 #ifdef TCL_COMPILE_STATS
     Tcl_MutexLock(&tclObjMutex);
     tclObjsAlloced = 0;
@@ -594,13 +552,13 @@ ContLineLoc *
 TclContinuationsEnter(
     Tcl_Obj *objPtr,
     Tcl_Size num,
-    int *loc)
+    Tcl_Size *loc)
 {
     int newEntry;
     ThreadSpecificData *tsdPtr = TclGetContLineTable();
     Tcl_HashEntry *hPtr =
 	    Tcl_CreateHashEntry(tsdPtr->lineCLPtr, objPtr, &newEntry);
-    ContLineLoc *clLocPtr = (ContLineLoc *)Tcl_Alloc(offsetof(ContLineLoc, loc) + (num + 1U) *sizeof(int));
+    ContLineLoc *clLocPtr = (ContLineLoc *)Tcl_Alloc(offsetof(ContLineLoc, loc) + (num + 1U) *sizeof(Tcl_Size));
 
     if (!newEntry) {
 	/*
@@ -628,7 +586,7 @@ TclContinuationsEnter(
     }
 
     clLocPtr->num = num;
-    memcpy(&clLocPtr->loc, loc, num*sizeof(int));
+    memcpy(&clLocPtr->loc, loc, num*sizeof(Tcl_Size));
     clLocPtr->loc[num] = CLL_END;       /* Sentinel */
     Tcl_SetHashValue(hPtr, clLocPtr);
 
@@ -657,12 +615,12 @@ TclContinuationsEnter(
 void
 TclContinuationsEnterDerived(
     Tcl_Obj *objPtr,
-    int start,
-    int *clNext)
+    Tcl_Size start,
+    Tcl_Size *clNext)
 {
     Tcl_Size length;
-    int end, num;
-    int *wordCLLast = clNext;
+    Tcl_Size end, num;
+    Tcl_Size *wordCLLast = clNext;
 
     /*
      * We have to handle invisible continuations lines here as well, despite
@@ -705,7 +663,7 @@ TclContinuationsEnterDerived(
 
     num = wordCLLast - clNext;
     if (num) {
-	int i;
+	Tcl_Size i;
 	ContLineLoc *clLocPtr = TclContinuationsEnter(objPtr, num, clNext);
 
 	/*
@@ -856,25 +814,6 @@ 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
@@ -884,9 +823,8 @@ Tcl_RegisterObjType(
     int isNew;
 
     Tcl_MutexLock(&tableMutex);
-    const char *name = TclObjTypeName(typePtr);
     Tcl_SetHashValue(
-	    Tcl_CreateHashEntry(&typeTable, name, &isNew), typePtr);
+	    Tcl_CreateHashEntry(&typeTable, typePtr->name, &isNew), typePtr);
     Tcl_MutexUnlock(&tableMutex);
 }
 
@@ -1012,7 +950,7 @@ Tcl_ConvertToType(
     }
 
     /*
-     * Use the target type's setFromAnyProc to set "objPtr"s internal form
+     * Use the target type's Tcl_SetFromAnyProc to set "objPtr"s internal form
      * as appropriate for the target type. This frees the old internal
      * representation.
      */
@@ -1588,14 +1526,6 @@ TclObjBeingDeleted(
  *	Create and return a new object that is a duplicate of the argument
  *	object.
  *
- * TclDuplicatePureObj --
- *	Like Tcl_DuplicateObj, except that it converts the duplicate to the
- *	specifid typ, does not duplicate the 'bytes'
- *	field unless it is necessary, i.e. the duplicated Tcl_Obj provides no
- *	updateStringProc.  This can avoid an expensive memory allocation since
- *	the data in the 'bytes' field of each Tcl_Obj must reside in allocated
- *	memory.
- *
  * Results:
  *	The return value is a pointer to a newly created Tcl_Obj. This object
  *	has reference count 0 and the same type, if any, as the source object
@@ -1647,111 +1577,6 @@ Tcl_DuplicateObj(
     return dupPtr;
 }
 
-
-/*
- *----------------------------------------------------------------------
- *
- * TclDuplicatePureObj --
- *
- *	Duplicates a Tcl_Obj and converts the internal representation of the
- *	duplicate to the given type, changing neither the 'bytes' field
- *	nor the internal representation of the original object, and without
- *	duplicating the bytes field unless necessary, i.e. unless the
- *	duplicate provides no updateStringProc after conversion.  This can
- *	avoid an expensive memory allocation since the data in the 'bytes'
- *	field of each Tcl_Obj must reside in allocated memory.
- *
- * Results:
- *	A pointer to a newly-created Tcl_Obj or NULL if there was an error.
- *	This object has reference count 0.  Also:
- *
- *----------------------------------------------------------------------
- */
-int SetDuplicatePureObj(
-    Tcl_Interp *interp,
-    Tcl_Obj *dupPtr,
-    Tcl_Obj *objPtr,
-    const Tcl_ObjType *typePtr)
-{
-    char *bytes = objPtr->bytes;
-    int status = TCL_OK;
-
-    TclInvalidateStringRep(dupPtr);
-    assert(dupPtr->typePtr == NULL);
-
-    if (objPtr->typePtr && objPtr->typePtr->dupIntRepProc) {
-	objPtr->typePtr->dupIntRepProc(objPtr, dupPtr);
-    } else {
-	dupPtr->internalRep = objPtr->internalRep;
-	dupPtr->typePtr = objPtr->typePtr;
-    }
-
-    if (typePtr != NULL && dupPtr->typePtr != typePtr) {
-	if (bytes) {
-	    dupPtr->bytes = bytes;
-	    dupPtr->length = objPtr->length;
-	}
-	/* borrow bytes from original object */
-	status = Tcl_ConvertToType(interp, dupPtr, typePtr);
-	if (bytes) {
-	    dupPtr->bytes = NULL;
-	    dupPtr->length = 0;
-	}
-	if (status != TCL_OK) {
-	    return status;
-	}
-    }
-
-    /* tclStringType is treated as a special case because a Tcl_Obj having this
-     * type can not always update the string representation.  This happens, for
-     * example, when Tcl_GetCharLength() converts the internal representation
-     * to tclStringType in order to store the number of characters, but does
-     * not store enough information to generate the string representation.
-     *
-     * Perhaps in the future this can be remedied and this special treatment
-     * removed.
-     */
-
-
-    if (bytes && (dupPtr->typePtr == NULL
-	|| dupPtr->typePtr->updateStringProc == NULL
-	|| typePtr == &tclStringType
-	)
-    ) {
-	if (!TclAttemptInitStringRep(dupPtr, bytes, objPtr->length)) {
-	    if (interp) {
-		Tcl_SetObjResult(interp, Tcl_NewStringObj(
-			"insufficient memory to initialize string", -1));
-		Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
-	    }
-	    status = TCL_ERROR;
-	}
-    }
-    return status;
-}
-
-Tcl_Obj *
-TclDuplicatePureObj(
-    Tcl_Interp *interp,
-    Tcl_Obj *objPtr,
-    const Tcl_ObjType *typePtr
-)		/* The object to duplicate. */
-{
-    int status;
-    Tcl_Obj *dupPtr;
-
-    TclNewObj(dupPtr);
-    status = SetDuplicatePureObj(interp, dupPtr, objPtr, typePtr);
-    if (status == TCL_OK) {
-	return dupPtr;
-    } else {
-	Tcl_DecrRefCount(dupPtr);
-	return NULL;
-    }
-}
-
-
-
 void
 TclSetDuplicateObj(
     Tcl_Obj *dupPtr,
@@ -1843,7 +1668,52 @@ 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
@@ -2137,6 +2007,7 @@ Tcl_FreeInternalRep(
  *----------------------------------------------------------------------
  */
 
+#undef Tcl_GetBoolFromObj
 int
 Tcl_GetBoolFromObj(
     Tcl_Interp *interp,         /* Used for error reporting if not NULL. */
@@ -2159,11 +2030,11 @@ Tcl_GetBoolFromObj(
 	return TCL_ERROR;
     }
     do {
-	if (objPtr->typePtr == tclIntType || objPtr->typePtr == tclBooleanType) {
+	if (objPtr->typePtr == &tclIntType || objPtr->typePtr == &tclBooleanType) {
 	    result = (objPtr->internalRep.wideValue != 0);
 	    goto boolEnd;
 	}
-	if (objPtr->typePtr == tclDoubleType) {
+	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
@@ -2180,7 +2051,7 @@ Tcl_GetBoolFromObj(
 	    result = (d != 0.0);
 	    goto boolEnd;
 	}
-	if (objPtr->typePtr == tclBignumType) {
+	if (objPtr->typePtr == &tclBignumType) {
 	    result = 1;
 	boolEnd:
 	    if (charPtr != NULL) {
@@ -2206,6 +2077,7 @@ Tcl_GetBoolFromObj(
     return TCL_ERROR;
 }
 
+#undef Tcl_GetBooleanFromObj
 int
 Tcl_GetBooleanFromObj(
     Tcl_Interp *interp,         /* Used for error reporting if not NULL. */
@@ -2247,18 +2119,18 @@ TclSetBooleanFromAny(
      */
 
     if (objPtr->bytes == NULL) {
-	if (objPtr->typePtr == tclIntType) {
+	if (objPtr->typePtr == &tclIntType) {
 	    if ((Tcl_WideUInt)objPtr->internalRep.wideValue < 2) {
 		return TCL_OK;
 	    }
 	    goto badBoolean;
 	}
 
-	if (objPtr->typePtr == tclBignumType) {
+	if (objPtr->typePtr == &tclBignumType) {
 	    goto badBoolean;
 	}
 
-	if (objPtr->typePtr == tclDoubleType) {
+	if (objPtr->typePtr == &tclDoubleType) {
 	    goto badBoolean;
 	}
     }
@@ -2389,13 +2261,13 @@ ParseBoolean(
   goodBoolean:
     TclFreeInternalRep(objPtr);
     objPtr->internalRep.wideValue = newBool;
-    objPtr->typePtr = tclBooleanType;
+    objPtr->typePtr = &tclBooleanType;
     return TCL_OK;
 
   numericBoolean:
     TclFreeInternalRep(objPtr);
     objPtr->internalRep.wideValue = newBool;
-    objPtr->typePtr = tclIntType;
+    objPtr->typePtr = &tclIntType;
     return TCL_OK;
 }
 
@@ -2487,7 +2359,7 @@ Tcl_DbNewDoubleObj(
     objPtr->bytes = NULL;
 
     objPtr->internalRep.doubleValue = dblValue;
-    objPtr->typePtr = tclDoubleType;
+    objPtr->typePtr = &tclDoubleType;
     return objPtr;
 }
 
@@ -2560,7 +2432,7 @@ Tcl_GetDoubleFromObj(
     double *dblPtr)	/* Place to store resulting double. */
 {
     do {
-	if (objPtr->typePtr == tclDoubleType) {
+	if (objPtr->typePtr == &tclDoubleType) {
 	    if (isnan(objPtr->internalRep.doubleValue)) {
 		if (interp != NULL) {
 		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
@@ -2573,11 +2445,11 @@ Tcl_GetDoubleFromObj(
 	    *dblPtr = (double) objPtr->internalRep.doubleValue;
 	    return TCL_OK;
 	}
-	if (objPtr->typePtr == tclIntType) {
+	if (objPtr->typePtr == &tclIntType) {
 	    *dblPtr = (double) objPtr->internalRep.wideValue;
 	    return TCL_OK;
 	}
-	if (objPtr->typePtr == tclBignumType) {
+	if (objPtr->typePtr == &tclBignumType) {
 	    mp_int big;
 
 	    TclUnpackBignum(objPtr, big);
@@ -2705,17 +2577,6 @@ 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;
-}
 
 
 /*
@@ -2802,12 +2663,12 @@ Tcl_GetLongFromObj(
 {
     do {
 #ifdef TCL_WIDE_INT_IS_LONG
-	if (objPtr->typePtr == tclIntType) {
+	if (objPtr->typePtr == &tclIntType) {
 	    *longPtr = objPtr->internalRep.wideValue;
 	    return TCL_OK;
 	}
 #else
-	if (objPtr->typePtr == tclIntType) {
+	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
@@ -2826,7 +2687,7 @@ Tcl_GetLongFromObj(
 	    goto tooLarge;
 	}
 #endif
-	if (objPtr->typePtr == tclDoubleType) {
+	if (objPtr->typePtr == &tclDoubleType) {
 	    if (interp != NULL) {
                 Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                         "expected integer but got \"%s\"",
@@ -2835,7 +2696,7 @@ Tcl_GetLongFromObj(
 	    }
 	    return TCL_ERROR;
 	}
-	if (objPtr->typePtr == tclBignumType) {
+	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
@@ -3063,11 +2924,11 @@ Tcl_GetWideIntFromObj(
 				/* Place to store resulting long. */
 {
     do {
-	if (objPtr->typePtr == tclIntType) {
+	if (objPtr->typePtr == &tclIntType) {
 	    *wideIntPtr = objPtr->internalRep.wideValue;
 	    return TCL_OK;
 	}
-	if (objPtr->typePtr == tclDoubleType) {
+	if (objPtr->typePtr == &tclDoubleType) {
 	    if (interp != NULL) {
                 Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                         "expected integer but got \"%s\"",
@@ -3076,7 +2937,7 @@ Tcl_GetWideIntFromObj(
 	    }
 	    return TCL_ERROR;
 	}
-	if (objPtr->typePtr == tclBignumType) {
+	if (objPtr->typePtr == &tclBignumType) {
 	    /*
 	     * Must check for those bignum values that can fit in a
 	     * Tcl_WideInt, even when auto-narrowing is enabled.
@@ -3148,7 +3009,7 @@ Tcl_GetWideUIntFromObj(
 				/* Place to store resulting long. */
 {
     do {
-	if (objPtr->typePtr == tclIntType) {
+	if (objPtr->typePtr == &tclIntType) {
 	    if (objPtr->internalRep.wideValue < 0) {
 	wideUIntOutOfRange:
 		if (interp != NULL) {
@@ -3162,10 +3023,10 @@ Tcl_GetWideUIntFromObj(
 	    *wideUIntPtr = (Tcl_WideUInt)objPtr->internalRep.wideValue;
 	    return TCL_OK;
 	}
-	if (objPtr->typePtr == tclDoubleType) {
+	if (objPtr->typePtr == &tclDoubleType) {
 	    goto wideUIntOutOfRange;
 	}
-	if (objPtr->typePtr == tclBignumType) {
+	if (objPtr->typePtr == &tclBignumType) {
 	    /*
 	     * Must check for those bignum values that can fit in a
 	     * Tcl_WideUInt, even when auto-narrowing is enabled.
@@ -3232,11 +3093,11 @@ TclGetWideBitsFromObj(
     Tcl_WideInt *wideIntPtr)    /* Place to store resulting wide integer. */
 {
     do {
-	if (objPtr->typePtr == tclIntType) {
+	if (objPtr->typePtr == &tclIntType) {
 	    *wideIntPtr = objPtr->internalRep.wideValue;
 	    return TCL_OK;
 	}
-	if (objPtr->typePtr == tclDoubleType) {
+	if (objPtr->typePtr == &tclDoubleType) {
 	    if (interp != NULL) {
                 Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                         "expected integer but got \"%s\"",
@@ -3245,7 +3106,7 @@ TclGetWideBitsFromObj(
 	    }
 	    return TCL_ERROR;
 	}
-	if (objPtr->typePtr == tclBignumType) {
+	if (objPtr->typePtr == &tclBignumType) {
 	    mp_int big;
 	    mp_err err;
 
@@ -3349,7 +3210,7 @@ DupBignum(
     mp_int bignumVal;
     mp_int bignumCopy;
 
-    copyPtr->typePtr = tclBignumType;
+    copyPtr->typePtr = &tclBignumType;
     TclUnpackBignum(srcPtr, bignumVal);
     if (mp_init_copy(&bignumCopy, &bignumVal) != MP_OKAY) {
 	Tcl_Panic("initialization failure in DupBignum");
@@ -3519,7 +3380,7 @@ GetBignumFromObj(
     mp_int *bignumValue)	/* Returned bignum value. */
 {
     do {
-	if (objPtr->typePtr == tclBignumType) {
+	if (objPtr->typePtr == &tclBignumType) {
 	    if (copy || Tcl_IsShared(objPtr)) {
 		mp_int temp;
 
@@ -3544,14 +3405,14 @@ GetBignumFromObj(
 	    }
 	    return TCL_OK;
 	}
-	if (objPtr->typePtr == tclIntType) {
+	if (objPtr->typePtr == &tclIntType) {
 	    if (mp_init_i64(bignumValue,
 		    objPtr->internalRep.wideValue) != MP_OKAY) {
 		return TCL_ERROR;
 	    }
 	    return TCL_OK;
 	}
-	if (objPtr->typePtr == tclDoubleType) {
+	if (objPtr->typePtr == &tclDoubleType) {
 	    if (interp != NULL) {
                 Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                         "expected integer but got \"%s\"",
@@ -3711,7 +3572,7 @@ TclSetBignumInternalRep(
     void *big)
 {
     mp_int *bignumValue = (mp_int *)big;
-    objPtr->typePtr = tclBignumType;
+    objPtr->typePtr = &tclBignumType;
     PACK_BIGNUM(*bignumValue, objPtr);
 
     /*
@@ -3734,13 +3595,14 @@ TclSetBignumInternalRep(
  *      Extracts a number (of any possible numeric type) from an object.
  *
  * Results:
- *      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.
+ *      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.
  *
  * Side effects:
- *      May allocate thread-specific data shared within a thread for handling
- *      the copy-out space for bignums.
+ *      Can allocate thread-specific data for handling the copy-out space for
+ *      bignums; this space is shared within a thread.
  *
  *----------------------------------------------------------------------
  */
@@ -3753,7 +3615,7 @@ Tcl_GetNumberFromObj(
     int *typePtr)
 {
     do {
-	if (objPtr->typePtr == tclDoubleType) {
+	if (objPtr->typePtr == &tclDoubleType) {
 	    if (isnan(objPtr->internalRep.doubleValue)) {
 		*typePtr = TCL_NUMBER_NAN;
 	    } else {
@@ -3762,12 +3624,12 @@ Tcl_GetNumberFromObj(
 	    *clientDataPtr = &objPtr->internalRep.doubleValue;
 	    return TCL_OK;
 	}
-	if (objPtr->typePtr == tclIntType) {
+	if (objPtr->typePtr == &tclIntType) {
 	    *typePtr = TCL_NUMBER_INT;
 	    *clientDataPtr = &objPtr->internalRep.wideValue;
 	    return TCL_OK;
 	}
-	if (objPtr->typePtr == tclBignumType) {
+	if (objPtr->typePtr == &tclBignumType) {
 	    static Tcl_ThreadDataKey bignumKey;
 	    mp_int *bigPtr = (mp_int *)Tcl_GetThreadData(&bignumKey,
 		    sizeof(mp_int));
@@ -3818,29 +3680,6 @@ 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);
-    }
-}
-
 /*
  *----------------------------------------------------------------------
  *
@@ -4633,37 +4472,6 @@ 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;
-    }
-}
 
 /*
  *----------------------------------------------------------------------
@@ -4776,14 +4584,13 @@ 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",
-	    name,
+	    objv[1]->typePtr ? objv[1]->typePtr->name : "pure string",
 	    objv[1]->refCount, objv[1]);
 
     if (objv[1]->typePtr) {
-	if (objv[1]->typePtr == tclDoubleType) {
+	if (objv[1]->typePtr == &tclDoubleType) {
 	    Tcl_AppendPrintfToObj(descObj, ", internal representation %g",
 		    objv[1]->internalRep.doubleValue);
 	} else {
@@ -4805,32 +4612,6 @@ 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,6 +871,18 @@ 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':
@@ -926,13 +938,13 @@ TclParseBackslash(
 	 */
 
 	if (Tcl_UtfCharComplete(p, numBytes - 1)) {
-	    count = Tcl_UtfToUniChar(p, &unichar) + 1;	/* +1 for '\' */
+	    count = TclUtfToUCS4(p, &unichar) + 1;	/* +1 for '\' */
 	} else {
 	    char utfBytes[8];
 
 	    memcpy(utfBytes, p, numBytes - 1);
 	    utfBytes[numBytes - 1] = '\0';
-	    count = Tcl_UtfToUniChar(utfBytes, &unichar) + 1;
+	    count = TclUtfToUCS4(utfBytes, &unichar) + 1;
 	}
 	result = unichar;
 	break;
@@ -943,6 +955,12 @@ 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;
 }
 
@@ -1054,7 +1072,7 @@ ParseTokens(
 				 * termination information. */
 {
     char type;
-    int originalTokens;
+    Tcl_Size originalTokens;
     int noSubstCmds = !(flags & TCL_SUBST_COMMANDS);
     int noSubstVars = !(flags & TCL_SUBST_VARIABLES);
     int noSubstBS = !(flags & TCL_SUBST_BACKSLASHES);
@@ -1088,7 +1106,7 @@ ParseTokens(
 	    tokenPtr->size = src - tokenPtr->start;
 	    parsePtr->numTokens++;
 	} else if (*src == '$') {
-	    int varToken;
+	    Tcl_Size varToken;
 
 	    if (noSubstVars) {
 		tokenPtr->type = TCL_TOKEN_TEXT;
@@ -1215,7 +1233,7 @@ ParseTokens(
 		 */
 
 		if (mask & TYPE_SPACE) {
-		    if ((int)parsePtr->numTokens == originalTokens) {
+		    if (parsePtr->numTokens == originalTokens) {
 			goto finishToken;
 		    }
 		    break;
@@ -1236,7 +1254,7 @@ ParseTokens(
 	    Tcl_Panic("ParseTokens encountered unknown character");
 	}
     }
-    if ((int)parsePtr->numTokens == originalTokens) {
+    if (parsePtr->numTokens == originalTokens) {
 	/*
 	 * There was nothing in this range of text. Add an empty token for the
 	 * empty range, so that there is always at least one token added.
@@ -1633,8 +1651,7 @@ Tcl_ParseBraces(
 {
     Tcl_Token *tokenPtr;
     const char *src;
-    int startIndex, level;
-    Tcl_Size length;
+    Tcl_Size length, startIndex, level;
 
     if (numBytes < 0 && start) {
 	numBytes = strlen(start);
@@ -1685,7 +1702,7 @@ Tcl_ParseBraces(
 		 */
 
 		if ((src != tokenPtr->start)
-			|| ((int)parsePtr->numTokens == startIndex)) {
+			|| (parsePtr->numTokens == startIndex)) {
 		    tokenPtr->size = (src - tokenPtr->start);
 		    parsePtr->numTokens++;
 		}
@@ -2104,7 +2121,7 @@ TclSubstTokens(
 				 * integer representing the number of tokens
 				 * left to be substituted will be written */
     Tcl_Size line,		/* The line the script starts on. */
-    int *clNextOuter,		/* Information about an outer context for */
+    Tcl_Size *clNextOuter,	/* Information about an outer context for */
     const char *outerScript)	/* continuation line data. This is set by
 				 * EvalEx() to properly handle [...]-nested
 				 * commands. The 'outerScript' refers to the
@@ -2127,7 +2144,7 @@ TclSubstTokens(
 #define NUM_STATIC_POS 20
     int isLiteral;
     Tcl_Size i, maxNumCL, numCL, adjust;
-    int *clPosition = NULL;
+    Tcl_Size *clPosition = NULL;
     Interp *iPtr = (Interp *) interp;
     int inFile = iPtr->evalFlags & TCL_EVAL_FILE;
 
@@ -2162,7 +2179,7 @@ TclSubstTokens(
 
     if (isLiteral) {
 	maxNumCL = NUM_STATIC_POS;
-	clPosition = (int *)Tcl_Alloc(maxNumCL * sizeof(int));
+	clPosition = (Tcl_Size *)Tcl_Alloc(maxNumCL * sizeof(Tcl_Size));
     }
 
     adjust = 0;
@@ -2212,8 +2229,8 @@ TclSubstTokens(
 
 		    if (numCL >= maxNumCL) {
 			maxNumCL *= 2;
-			clPosition = (int *)Tcl_Realloc(clPosition,
-				maxNumCL * sizeof(int));
+			clPosition = (Tcl_Size *)Tcl_Realloc(clPosition,
+				maxNumCL * sizeof(Tcl_Size));
 		    }
 		    clPosition[numCL] = clPos;
 		    numCL++;

generic/tclPlatDecls.h

@@ -48,6 +48,93 @@
 #   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,
+				Tcl_Size maxPathLen, char *libraryPath);
+/* 1 */
+EXTERN int		Tcl_MacOSXOpenVersionedBundleResources(
+				Tcl_Interp *interp, const char *bundleName,
+				const char *bundleVersion,
+				int hasResourceFile, Tcl_Size 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, Tcl_Size maxPathLen, char *libraryPath); /* 0 */
+    int (*tcl_MacOSXOpenVersionedBundleResources) (Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, int hasResourceFile, Tcl_Size 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. */
 
@@ -106,6 +193,7 @@ extern const TclPlatStubs *tclPlatStubsPtr;
 
 /* !END!: Do not edit above this line. */
 
+#endif /* TCL_MAJOR_VERSION */
 
 #ifdef MAC_OSX_TCL /* MACOSX */
 #undef Tcl_MacOSXOpenBundleResources
@@ -125,7 +213,8 @@ extern const TclPlatStubs *tclPlatStubsPtr;
 #   undef Tcl_MacOSXNotifierAddRunLoopMode
 #endif
 
-#if defined(USE_TCL_STUBS) && (defined(_WIN32) || defined(__CYGWIN__))
+#if defined(USE_TCL_STUBS) && (defined(_WIN32) || defined(__CYGWIN__))\
+	&& (defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8)
 #undef Tcl_WinUtfToTChar
 #undef Tcl_WinTCharToUtf
 #ifdef _WIN32

generic/tclProc.c

@@ -268,7 +268,7 @@ Tcl_ProcObjCmd(
 
 		cfPtr->level = -1;
 		cfPtr->type = contextPtr->type;
-		cfPtr->line = (int *)Tcl_Alloc(sizeof(int));
+		cfPtr->line = (Tcl_Size *)Tcl_Alloc(sizeof(Tcl_Size));
 		cfPtr->line[0] = contextPtr->line[3];
 		cfPtr->nline = 1;
 		cfPtr->framePtr = NULL;
@@ -495,8 +495,8 @@ TclCreateProc(
     if (precompiled) {
 	if (numArgs > procPtr->numArgs) {
 	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		    "procedure \"%s\": arg list contains %" TCL_Z_MODIFIER "u entries, "
-		    "precompiled header expects %" TCL_Z_MODIFIER "u", procName, numArgs,
+		    "procedure \"%s\": arg list contains %" TCL_SIZE_MODIFIER "u entries, "
+		    "precompiled header expects %" TCL_SIZE_MODIFIER "u", procName, numArgs,
 		    procPtr->numArgs));
 	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
 		    "BYTECODELIES", NULL);
@@ -590,7 +590,7 @@ TclCreateProc(
 		    || (localPtr->defValuePtr == NULL && fieldCount == 2)
 		    || (localPtr->defValuePtr != NULL && fieldCount != 2)) {
 		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-			"procedure \"%s\": formal parameter %" TCL_Z_MODIFIER "u is "
+			"procedure \"%s\": formal parameter %" TCL_SIZE_MODIFIER "u is "
 			"inconsistent with precompiled body", procName, i));
 		Tcl_SetErrorCode(interp, "TCL", "OPERATION", "PROC",
 			"BYTECODELIES", NULL);
@@ -1067,7 +1067,7 @@ ProcWrongNumArgs(
 {
     CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
     Proc *procPtr = framePtr->procPtr;
-    int localCt = procPtr->numCompiledLocals, numArgs, i;
+    Tcl_Size localCt = procPtr->numCompiledLocals, numArgs, i;
     Tcl_Obj **desiredObjs;
     const char *final = NULL;
 
@@ -1348,7 +1348,7 @@ InitArgsAndLocals(
     Proc *procPtr = framePtr->procPtr;
     ByteCode *codePtr;
     Var *varPtr, *defPtr;
-    int localCt = procPtr->numCompiledLocals, numArgs, argCt, i, imax;
+    Tcl_Size localCt = procPtr->numCompiledLocals, numArgs, argCt, i, imax;
     Tcl_Obj *const *argObjs;
 
     ByteCodeGetInternalRep(procPtr->bodyPtr, &tclByteCodeType, codePtr);
@@ -2547,7 +2547,7 @@ SetLambdaFromAny(
 
 	    if (contextPtr->line
 		    && (contextPtr->nline >= 2) && (contextPtr->line[1] >= 0)) {
-		int buf[2];
+		Tcl_Size buf[2];
 
 		/*
 		 * Move from approximation (line of list cmd word) to actual
@@ -2559,7 +2559,7 @@ SetLambdaFromAny(
 
 		cfPtr->level = -1;
 		cfPtr->type = contextPtr->type;
-		cfPtr->line = (int *)Tcl_Alloc(sizeof(int));
+		cfPtr->line = (Tcl_Size *)Tcl_Alloc(sizeof(Tcl_Size));
 		cfPtr->line[0] = buf[1];
 		cfPtr->nline = 1;
 		cfPtr->framePtr = NULL;

generic/tclScan.c

@@ -903,7 +903,7 @@ Tcl_ScanObjCmd(
 	     * Scan a single Unicode character.
 	     */
 
-	    offset = Tcl_UtfToUniChar(string, &i);
+	    offset = TclUtfToUCS4(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);
+			    = 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)) {
+	    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;
+		    objPtr->typePtr = &tclIntType;
 		    if (signum) {
 			objPtr->internalRep.wideValue =
 				(Tcl_WideInt)(-octalSignificandWide);
@@ -1414,7 +1414,7 @@ TclParseNumber(
 			    significandWide);
 		    significandOverflow = 1;
 		} else {
-		    objPtr->typePtr = tclIntType;
+		    objPtr->typePtr = &tclIntType;
 		    if (signum) {
 			objPtr->internalRep.wideValue =
 				(Tcl_WideInt)(-significandWide);
@@ -1446,7 +1446,7 @@ TclParseNumber(
 	     * k = numTrailZeros+exponent-numDigitsAfterDp.
 	     */
 
-	    objPtr->typePtr = tclDoubleType;
+	    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;
+	    objPtr->typePtr = &tclDoubleType;
 	    break;
 
 #ifdef IEEE_FLOATING_POINT
 	case sNAN:
 	case sNANFINISH:
 	    objPtr->internalRep.doubleValue = MakeNaN(signum, significandWide);
-	    objPtr->typePtr = tclDoubleType;
+	    objPtr->typePtr = &tclDoubleType;
 	    break;
 #endif
 	case INITIAL:

generic/tclStringList.c

@@ -0,0 +1,602 @@
+/*
+ * tclStringList.c --
+ *
+ *     This file contains the StringList concrete abstract list
+ *     implementation. It implements a view of a string as a list of
+ *     of characters.
+ *
+ * Copyright © 2023 Ashok P. Nadkarni
+ *
+ * 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"
+#include <assert.h>
+#include <math.h>
+
+/*
+ * The structure below defines the StringList Tcl_ObjType. Implementation
+ * stores the target Tcl_Obj being split in the internal representation of the
+ * abstract list Tcl_Obj. List operations are then mapped to the corresponding
+ * string operations. This makes per character processing of the form
+ *    foreach ch [split $str ""] {...}
+ * less expensive for large strings.
+ *
+ * The source string is stored in the internalRep.twpPtrValue.ptr1 field.
+ * The ptr2 field holds a StringListInfo struct with ancillary information
+ * as below. If ptr2 is NULL, list covers all elements of source string.
+ */
+typedef struct StringListInfo {
+    Tcl_Size startIndex; /* Starting index in source string where this list
+                            begins. Used for fast range operations */
+    Tcl_Size count;      /* Number of elements in list. If negative, count
+                            is entire source string */
+    int flags;
+#define STRINGLIST_REVERSE 0x01 /* If set, reverse element order */
+} StringListInfo;
+
+/* -------------------------- StringList object ---------------------------- */
+
+static int StringListObjIndex(TCL_UNUSED(Tcl_Interp *), Tcl_Obj *arithSeriesObj,
+				  Tcl_Size index, Tcl_Obj **elemObj);
+
+static Tcl_Size StringListObjLength(Tcl_Obj *strListObj);
+static int StringListObjRange(Tcl_Interp *interp, Tcl_Obj *strListObj,
+			    Tcl_Size fromIdx, Tcl_Size toIdx, Tcl_Obj **newObjPtr);
+static int StringListObjReverse(Tcl_Interp *interp, Tcl_Obj *strListObj, Tcl_Obj **newObjPtr);
+static void DupStringListInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
+static void FreeStringListInternalRep(Tcl_Obj *strListObj);
+static void UpdateStringOfStringList(Tcl_Obj *strListObj);
+
+static const Tcl_ObjType stringListType = {
+    "stringlist",               /* name */
+    FreeStringListInternalRep, /* freeIntRepProc */
+    DupStringListInternalRep,  /* dupIntRepProc */
+    UpdateStringOfStringList,  /* updateStringProc */
+    NULL,                      /* setFromAnyProc */
+    TCL_OBJTYPE_V2(
+    StringListObjLength,
+    StringListObjIndex,
+    StringListObjRange,
+    StringListObjReverse,
+    NULL, /* GetElements */
+    NULL, /* SetElement */
+    NULL, /* Replace */
+    NULL) /* "in" operator */
+};
+
+/* Returns the source for a StringList, NULL if objPtr is not a StringList */
+static inline Tcl_Obj *
+StringListGetSourceObj(Tcl_Obj *objPtr)
+{
+    const Tcl_ObjInternalRep *irPtr;
+    irPtr = TclFetchInternalRep((objPtr), &stringListType);
+    return irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr1 : NULL;
+}
+
+/*
+ * Returns the ancillary information about a StringList. May return an
+ * NULL either because objPtr is not a StringList or because it has no
+ * ancillary information. Use StringListGetSourceObj to distinguish.
+ */
+static inline StringListInfo *
+StringListGetInfo(Tcl_Obj *objPtr)
+{
+    const Tcl_ObjInternalRep *irPtr;
+    irPtr = TclFetchInternalRep((objPtr), &stringListType);
+    return irPtr ? (StringListInfo *)irPtr->twoPtrValue.ptr2 : NULL;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupStringListInternalRep --
+ *
+ *	Initialize the internal representation of a StringList Tcl_Obj to a
+ *	copy of the internal representation of an existing one.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	We set "copyPtr"s internal rep to a newly allocated structure.
+ *----------------------------------------------------------------------
+ */
+
+static void
+DupStringListInternalRep(
+    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
+    Tcl_Obj *copyPtr)		/* Object with internal rep to set. */
+{
+    /* Copy the source string and hold a reference */
+    Tcl_Obj *srcStringObj = StringListGetSourceObj(srcPtr);
+    copyPtr->internalRep.twoPtrValue.ptr1 = srcStringObj;
+    Tcl_IncrRefCount(srcStringObj);
+
+    /* Copy the ancillary information if there is any. */
+    StringListInfo *srcInfoPtr = StringListGetInfo(srcPtr);
+    if (srcInfoPtr) {
+	StringListInfo *copyInfoPtr;
+	copyInfoPtr = (StringListInfo *)Tcl_Alloc(sizeof(*copyInfoPtr));
+	*copyInfoPtr = *srcInfoPtr;
+	copyPtr->internalRep.twoPtrValue.ptr2 = copyInfoPtr;
+    } else {
+	    copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
+    }
+    copyPtr->typePtr = &stringListType;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeStringListInternalRep --
+ *
+ *	Free any allocated memory in the StringList Rep
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+FreeStringListInternalRep(Tcl_Obj *strListObj)
+{
+    Tcl_Obj *srcStringObj = StringListGetSourceObj(strListObj);
+    assert(srcStringObj);
+    if (srcStringObj) {
+	    Tcl_DecrRefCount(srcStringObj);
+    }
+    StringListInfo *infoPtr = StringListGetInfo(strListObj);
+    if (infoPtr) {
+	    Tcl_Free(infoPtr);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclNewStringListObj --
+ *
+ *	Creates a new StringList object formed by splitting the source string
+ *  object.
+ *
+ * Results:
+ *
+ * 	A Tcl_Obj pointer to the created StringList object with ref count 0.
+ *
+ * Side Effects:
+ *
+ * 	None.
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclNewStringListObj(
+    TCL_UNUSED(Tcl_Interp *),
+    Tcl_Obj *srcStringObj) /* String to split */
+{
+    Tcl_Obj *objPtr = Tcl_NewObj();
+    Tcl_InvalidateStringRep(objPtr);
+    objPtr->internalRep.twoPtrValue.ptr1 = srcStringObj;
+    Tcl_IncrRefCount(srcStringObj);
+    objPtr->internalRep.twoPtrValue.ptr2 = NULL;
+    objPtr->typePtr = &stringListType;
+    return objPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringListGetExtent
+ *
+ *  Gets the starting index and length subrange within the source string
+ *  that comprises this list.
+ *
+ * Results:
+ *
+ * 	Returns the length of the list.
+ *
+ * Side Effects:
+ *
+ *  The starting index in the source string is stored in startIndexPtr
+ *  if it is not NULL.
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_Size
+StringListGetExtent(Tcl_Obj *strListObj, Tcl_Size *startIndexPtr, Tcl_Size *numCharsPtr, int *reversedPtr)
+{
+    Tcl_Obj *srcStringObj;
+    StringListInfo *infoPtr;
+    Tcl_Size numChars;
+    Tcl_Size listLen;
+    Tcl_Size startIndex;
+    int reversed;
+
+    srcStringObj = StringListGetSourceObj(strListObj);
+    infoPtr = StringListGetInfo(strListObj);
+
+    assert(srcStringObj);
+    numChars = Tcl_GetCharLength(srcStringObj);
+
+    if (infoPtr) {
+	/* The list is a subrange of the string */
+	startIndex = infoPtr->startIndex;
+	if (infoPtr->count >= 0) {
+	    listLen = infoPtr->count;
+	    assert(listLen <= numChars);
+	}
+	else {
+	    listLen = numChars - startIndex;
+	}
+	reversed = (infoPtr->flags & STRINGLIST_REVERSE) != 0;
+    } else {
+	startIndex = 0;
+	listLen = numChars;
+	reversed = 0;
+    }
+
+    assert(listLen <= numChars);
+    assert(startIndex == 0 || startIndex < numChars);
+    assert(startIndex <= (numChars - listLen));
+
+    if (startIndexPtr) {
+	*startIndexPtr = startIndex;
+    }
+    if (numCharsPtr) {
+	*numCharsPtr = numChars;
+    }
+    if (reversedPtr) {
+	*reversedPtr = reversed;
+    }
+    return listLen;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringListObjIndex --
+ *
+ *	Returns the element with the specified index in the list. If index
+ *  is out of range, an empty Tcl_Obj is returned.
+ *
+ * Results:
+ *
+ * 	TCL_OK on success.
+ *
+ * Side Effects:
+ *
+ * 	On success, the 
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+StringListObjIndex(
+    TCL_UNUSED(Tcl_Interp *),/* Used for error reporting if not NULL. */
+    Tcl_Obj *strListObj,     /* List obj */
+    Tcl_Size index,          /* index to element of interest */
+    Tcl_Obj **elemObj)       /* Return value */
+{
+    Tcl_Size listLen;
+    Tcl_Size startIndex;
+    Tcl_Obj *srcStringObj;
+    int reversed;
+    Tcl_Size strIndex;
+
+    if (index < 0) {
+	goto outOfBounds;
+    }
+
+    srcStringObj = StringListGetSourceObj(strListObj);
+    assert(srcStringObj);
+
+    listLen = StringListGetExtent(strListObj, &startIndex, NULL, &reversed);
+    if (index >= listLen) {
+	goto outOfBounds;
+    }
+
+    /*
+     * The index into the string depends on whether the list is only a
+     * substring of the string and whether it is reversed.
+     */
+    if (reversed) {
+	strIndex = startIndex + listLen - index - 1;
+    } else {
+	strIndex = startIndex + index;
+    }
+
+    char buf[TCL_UTF_MAX];
+    int utfLen;
+
+    assert(strIndex <
+	   Tcl_GetCharLength(srcStringObj));
+    Tcl_UniChar ch = Tcl_GetUniChar(srcStringObj, strIndex);
+    utfLen = Tcl_UniCharToUtf(ch, buf);
+    *elemObj = Tcl_NewStringObj(buf, utfLen);
+
+    return TCL_OK;
+
+outOfBounds:
+    /* TODO - NULL or empty obj? */
+    *elemObj = Tcl_NewObj();
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringListObjLength
+ *
+ *	Returns the length of the StringList
+ *
+ * Results:
+ *
+ * 	The length of the list.
+ *
+ * Side Effects:
+ *
+ * 	None.
+ *
+ *----------------------------------------------------------------------
+ */
+Tcl_Size StringListObjLength(Tcl_Obj *strListObj)
+{
+    return StringListGetExtent(strListObj, NULL, NULL, NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringListObjRange --
+ *
+ *	Makes a slice of an StringList.
+ *
+ * Results:
+ *	Returns a pointer to the sliced series.
+ *      This may be a new object or the same object if not shared.
+ *
+ * Side effects:
+ *	?The possible conversion of the object referenced by listPtr?
+ *	?to a list object.?
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+StringListObjRange(
+    TCL_UNUSED(Tcl_Interp *),   /* For error message(s) */
+    Tcl_Obj *strListObj,	/* 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. */
+    Tcl_Obj **newObjPtr)        /* return value */
+{
+    Tcl_Size listLen;
+    Tcl_Size startIndex;
+    Tcl_Obj *srcStringObj;
+    int reversed;
+
+    srcStringObj = StringListGetSourceObj(strListObj);
+    assert(srcStringObj);
+
+    listLen = StringListGetExtent(strListObj, &startIndex, NULL, &reversed);
+
+    if (fromIdx < 0) {
+	fromIdx = 0;
+    }
+
+    if (toIdx >= listLen) {
+	toIdx = listLen - 1;
+    } 
+    
+    if (fromIdx > toIdx ||
+	fromIdx >= listLen) {
+	TclNewObj(*newObjPtr);
+	return TCL_OK;
+    }
+
+    assert(fromIdx >= 0);
+    assert(toIdx >= fromIdx);
+    assert(listLen > toIdx);
+
+    /*
+     * We could do a Tcl_Range to allocate a new string but instead
+     * keep the old one and just add ancillary information specifying
+     * range and reverse setting.
+     */
+    StringListInfo *infoPtr;
+    infoPtr = (StringListInfo *) Tcl_Alloc(sizeof(*infoPtr));
+
+    infoPtr->count = toIdx - fromIdx + 1;
+    if (reversed) {
+	infoPtr->startIndex = startIndex + listLen - toIdx - 1;
+	infoPtr->flags = STRINGLIST_REVERSE;
+    } else {
+	infoPtr->startIndex = startIndex + fromIdx;
+	infoPtr->flags = 0;
+	assert(fromIdx < Tcl_GetCharLength(strListObj));
+	assert(toIdx < Tcl_GetCharLength(strListObj));
+    }
+
+    Tcl_Obj *newObj = Tcl_NewObj();
+    Tcl_InvalidateStringRep(newObj);
+    newObj->internalRep.twoPtrValue.ptr1 = srcStringObj;
+    Tcl_IncrRefCount(srcStringObj);
+    newObj->internalRep.twoPtrValue.ptr2 = infoPtr;
+    newObj->typePtr = &stringListType;
+
+    *newObjPtr = newObj;
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringListObjReverse --
+ *
+ *	Reverse the order of the StringList value.
+ *
+ * Results:
+ *      The result will be StringList in the reverse order.
+ *
+ * Side effects:
+ *
+ *----------------------------------------------------------------------
+ */
+int
+StringListObjReverse(
+    TCL_UNUSED(Tcl_Interp *),   /* For error message(s) */
+    Tcl_Obj *strListObj,	/* List object to reverse. */
+    Tcl_Obj **newObjPtr)
+{
+    Tcl_Obj *srcStringObj, *newObj;
+    StringListInfo *infoPtr, *newInfoPtr;
+
+    srcStringObj = StringListGetSourceObj(strListObj);
+    assert(srcStringObj);
+
+    newObj = Tcl_NewObj();
+    Tcl_InvalidateStringRep(newObj);
+    newObj->internalRep.twoPtrValue.ptr1 = srcStringObj;
+    Tcl_IncrRefCount(srcStringObj);
+    newObj->typePtr = &stringListType;
+    
+    infoPtr = StringListGetInfo(strListObj);
+    if (infoPtr) {
+	if (infoPtr->startIndex == 0 && infoPtr->count < 0 &&
+	    (infoPtr->flags & STRINGLIST_REVERSE)) {
+	    /* No need for ancillary information */
+	    newInfoPtr = NULL;
+	} else {
+	    newInfoPtr = (StringListInfo *) Tcl_Alloc(sizeof(*newInfoPtr));
+	    newInfoPtr->startIndex = infoPtr->startIndex;
+	    newInfoPtr->count = infoPtr->count;
+	    newInfoPtr->flags = infoPtr->flags ^ STRINGLIST_REVERSE;
+	}
+    } else {
+	newInfoPtr = (StringListInfo *) Tcl_Alloc(sizeof(*newInfoPtr));
+	newInfoPtr->startIndex = 0;
+	newInfoPtr->count = -1; /* Entire string */
+	newInfoPtr->flags = STRINGLIST_REVERSE;
+    }
+
+    newObj->internalRep.twoPtrValue.ptr2 = newInfoPtr;
+    *newObjPtr = newObj;
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateStringOfStringList --
+ *
+ *	Update the string representation for an StringList object.
+ *	Note: This procedure does not invalidate an existing old string rep
+ *	so storage will be lost if this has not already been done.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	The object's string is set to a valid string that results from
+ *	the list-to-string conversion. This string will be empty if the
+ *	list has no elements. The list internal representation
+ *	should be a StringList when this function is called.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateStringOfStringList(Tcl_Obj *strListObj)
+{
+    Tcl_Size listLen;
+    Tcl_Size startIndex;
+    Tcl_Size numChars;
+    Tcl_Obj *srcStringObj;
+    int reversed;
+
+    assert(strListObj->bytes == NULL);
+
+    srcStringObj = StringListGetSourceObj(strListObj);
+    assert(srcStringObj);
+
+    listLen =
+	StringListGetExtent(strListObj, &startIndex, &numChars, &reversed);
+    if (listLen == 0) {
+	Tcl_InitStringRep(strListObj, NULL, 0);
+	return;
+    }
+
+    if (reversed) {
+	Tcl_Obj *tempObj = TclStringReverse(srcStringObj, TCL_STRING_IN_PLACE);
+	/* NOTE: TclStringReverse may return same or different Tcl_Obj! */
+	srcStringObj = tempObj;
+	startIndex = numChars - (startIndex + listLen) - 1;
+    }
+
+    /* srcStringObj may be original or newly allocated so we have to decrref later */
+    Tcl_IncrRefCount(srcStringObj);
+
+    const char *utf;
+    const char *utfStart = Tcl_GetString(srcStringObj);
+#   define LOCAL_SIZE 64
+    char localFlags[LOCAL_SIZE], *flagPtr = NULL;
+    Tcl_Size i, bytesNeeded;
+    int utfLen, uniChar;
+
+    utfStart = Tcl_UtfAtIndex(utfStart, startIndex);
+
+    /* Pass 1: estimate space, gather flags. */
+    if (listLen <= LOCAL_SIZE) {
+	flagPtr = localFlags;
+    } else {
+	/* We know numElems <= LIST_MAX, so this is safe. */
+	flagPtr = (char *)Tcl_Alloc(listLen);
+    }
+    for (i = 0, bytesNeeded = 0, utf = utfStart; i < listLen; ++i) {
+	flagPtr[i] = (i ? TCL_DONT_QUOTE_HASH : 0);
+	utfLen = Tcl_UtfToUniChar(utf, &uniChar);
+	bytesNeeded += TclScanElement(utf, utfLen, flagPtr+i);
+	if (bytesNeeded > TCL_SIZE_MAX - listLen) {
+	    Tcl_Panic("max size for a Tcl value (%" TCL_Z_MODIFIER "d bytes) exceeded", TCL_SIZE_MAX);
+	}
+	utf += utfLen;
+    }
+    bytesNeeded += listLen - 1; /* Room for space separators */
+
+    /*
+     * Pass 2: copy into string rep buffer.
+     */
+
+    char * const dstStart = Tcl_InitStringRep(strListObj, NULL, bytesNeeded);
+    char *dst;
+    TclOOM(dstStart, bytesNeeded);
+    for (i = 0, dst = dstStart, utf = utfStart; i < listLen; ++i) {
+	flagPtr[i] |= (i ? TCL_DONT_QUOTE_HASH : 0);
+	utfLen = Tcl_UtfToUniChar(utf, &uniChar);
+	dst += TclConvertElement(utf, utfLen, dst, flagPtr[i]);
+	*dst++ = ' ';
+	utf += utfLen;
+    }
+
+    /* Set the string length to what was actually written, the safe choice */
+    (void) Tcl_InitStringRep(strListObj, NULL, dst - 1 - dstStart);
+
+    Tcl_DecrRefCount(srcStringObj);
+    if (flagPtr != localFlags) {
+	Tcl_Free(flagPtr);
+    }
+}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */

generic/tclStringObj.c

@@ -59,8 +59,6 @@ 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);
@@ -69,6 +67,16 @@ 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.
@@ -371,18 +379,11 @@ 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;
@@ -588,6 +589,22 @@ 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;
 }
 
@@ -649,6 +666,36 @@ 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
@@ -694,15 +741,11 @@ Tcl_GetUnicodeFromObj(
  */
 
 Tcl_Obj *
-Tcl_GetRange(tclObjTypeInterfaceArgsStringRange)
+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. */
 {
-    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;
@@ -773,6 +816,18 @@ GetRange(tclObjTypeInterfaceArgsStringRange) {
 	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);
 }
 
@@ -1228,6 +1283,12 @@ 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 {
@@ -1427,6 +1488,13 @@ 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.
@@ -2089,6 +2157,12 @@ 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;
@@ -3050,7 +3124,7 @@ TclStringCat(
     Tcl_Obj *objResultPtr, * const *ov;
     int binary = 1;
     Tcl_Size oc, length = 0;
-    int allowUniChar = 1, requestUniChar = 0;
+    int allowUniChar = 1, requestUniChar = 0, forceUniChar = 0;
     Tcl_Size first = objc - 1;	/* Index of first value possibly not empty */
     Tcl_Size last = 0;		/* Index of last value possibly not empty */
     int inPlace = (flags & TCL_STRING_IN_PLACE) && !Tcl_IsShared(*objv);
@@ -3092,7 +3166,9 @@ TclStringCat(
 		 */
 
 	 	binary = 0;
-	 	if ((objPtr->typePtr) && (objPtr->typePtr != &tclStringType)) {
+	 	if (ov > objv+1 && ISCONTINUATION(TclGetString(objPtr))) {
+	 	    forceUniChar = 1;
+	 	} else if ((objPtr->typePtr) && (objPtr->typePtr != &tclStringType)) {
 		    /* Prevent shimmer of non-string types. */
 		    allowUniChar = 0;
 		}
@@ -3142,7 +3218,7 @@ TclStringCat(
 		}
 	    }
 	} while (--oc);
-    } else if ((allowUniChar && requestUniChar)) {
+    } else if ((allowUniChar && requestUniChar) || forceUniChar) {
 	/*
 	 * Result will be pure Tcl_UniChar array. Pre-size it.
 	 */
@@ -3299,7 +3375,7 @@ TclStringCat(
 		dst += more;
 	    }
 	}
-    } else if ((allowUniChar && requestUniChar)) {
+    } else if ((allowUniChar && requestUniChar) || forceUniChar) {
 	/* Efficiently produce a pure Tcl_UniChar array result */
 	Tcl_UniChar *dst;
 
@@ -3491,7 +3567,7 @@ TclStringCmp(
 		    s1 = (char *) Tcl_GetUnicode(value1Ptr);
 		    s2 = (char *) Tcl_GetUnicode(value2Ptr);
 		    if (
-#if defined(WORDS_BIGENDIAN)
+#if defined(WORDS_BIGENDIAN) && (TCL_UTF_MAX > 3)
 			    1
 #else
 			    checkEq
@@ -3714,32 +3790,6 @@ 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;
-}
-
 /*
  *---------------------------------------------------------------------------
  *
@@ -3877,6 +3927,9 @@ 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;
@@ -3909,19 +3962,54 @@ 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) {
@@ -3955,7 +4043,7 @@ TclStringReverse(
 		 * skip calling Tcl_UtfCharComplete() here.
 		 */
 
-		int bytesInChar = Tcl_UtfToUniChar(from, &chw);
+		int bytesInChar = TclUtfToUCS4(from, &chw);
 
 		ReverseBytes((unsigned char *)to, (unsigned char *)from,
 			bytesInChar);
@@ -4404,6 +4492,14 @@ ExtendStringRepWithUnicode(
 
   copyBytes:
     dst = objPtr->bytes + origLength;
+#if TCL_UTF_MAX < 4
+    /* Initialize the buffer so that some random data doesn't trick
+     * Tcl_UniCharToUtf() into thinking it should combine surrogate pairs.
+     * Once TCL_UTF_MAX == 3 is removed and Tcl_UniCharToUtf restored to its
+     * prior non-stateful nature, this call to memset can also be removed.
+     */
+    memset(dst, 0xff, stringPtr->allocated - origLength);
+#endif
     for (i = 0; i < numChars; i++) {
 	dst += Tcl_UniCharToUtf(unicode[i], dst);
     }

generic/tclStubInit.c

@@ -79,12 +79,16 @@
 # 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
-# define TclGetUnicodeFromObj 0
+# if TCL_UTF_MAX > 3
+#   define TclGetUnicodeFromObj 0
+# endif
+#endif
 #undef Tcl_Close
 #define Tcl_Close 0
 #undef TclGetByteArrayFromObj
@@ -93,10 +97,24 @@
 #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 *, void *))(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
@@ -104,6 +122,101 @@
 # 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,6 +515,9 @@ 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
@@ -543,10 +546,12 @@ 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);
     }
@@ -727,12 +732,6 @@ 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;
     }
@@ -742,6 +741,10 @@ Tcltest_Init(
     }
 #endif
 
+    if (Tcl_ABSListTest_Init(interp) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
     /*
      * Check for special options used in ../tests/main.test
      */
@@ -811,10 +814,12 @@ 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);
     }
@@ -5757,7 +5762,17 @@ 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;
@@ -8791,4 +8806,3 @@ vamoose:
  * indent-tabs-mode: nil
  * End:
  */
-

generic/tclTestObj.c

@@ -891,6 +891,7 @@ TestlistobjCmd(
 	"replace",
 	"indexmemcheck",
 	"getelementsmemcheck",
+	"index",
 	NULL
     };
     enum listobjCmdIndex {
@@ -899,6 +900,7 @@ TestlistobjCmd(
 	LISTOBJ_REPLACE,
 	LISTOBJ_INDEXMEMCHECK,
 	LISTOBJ_GETELEMENTSMEMCHECK,
+	LISTOBJ_INDEX,
     } cmdIndex;
 
     Tcl_Size varIndex;		/* Variable number converted to binary */
@@ -974,16 +976,13 @@ TestlistobjCmd(
 		!= TCL_OK) {
 		return TCL_ERROR;
 	    }
-	    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 */
-		}
-	    )
+	    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_BounceRefCount(objP);
 	}
 	break;
 
@@ -1010,6 +1009,26 @@ TestlistobjCmd(
 	    }
 	}
 	break;
+    case LISTOBJ_INDEX:
+	/*
+	 * Tcl_ListObjIndex semantics differ from lindex for out of bounds.
+	 * Hence this explicit test.
+	 */
+	if (objc != 4) {
+	    Tcl_WrongNumArgs(interp, 2, objv,
+			     "varIndex listIndex");
+	    return TCL_ERROR;
+	}
+	if (Tcl_GetIntForIndex(interp, objv[3], TCL_INDEX_NONE, &first) != TCL_OK) {
+	    return TCL_ERROR;
+	} else {
+	    Tcl_Obj *objP;
+	    if (Tcl_ListObjIndex(interp, varPtr[varIndex], first, &objP) != TCL_OK) {
+		return TCL_ERROR;
+	    }
+	    Tcl_SetObjResult(interp, objP ? objP : Tcl_NewStringObj("null", -1));
+	}
+	break;
     }
     return TCL_OK;
 }
@@ -1031,6 +1050,33 @@ TestlistobjCmd(
  *----------------------------------------------------------------------
  */
 
+static Tcl_Size V1TestListObjLength(TCL_UNUSED(Tcl_Obj *)) {
+    return 100;
+}
+
+static int V1TestListObjIndex(
+    TCL_UNUSED(Tcl_Interp *),
+    TCL_UNUSED(Tcl_Obj *),
+    TCL_UNUSED(Tcl_Size),
+    Tcl_Obj **objPtr)
+{
+    *objPtr = Tcl_NewStringObj("This indexProc should never be accessed (bug: e58d7e19e9)", -1);
+    return TCL_OK;
+}
+
+static const Tcl_ObjType v1TestListType = {
+    "testlist",			/* name */
+    NULL,		/* freeIntRepProc */
+    NULL,		/* dupIntRepProc */
+    NULL,		/* updateStringProc */
+    NULL,		/* setFromAnyProc */
+    offsetof(Tcl_ObjType, indexProc),			/* This is a V1 objType, which doesn't have an indexProc */
+    V1TestListObjLength, /* always return 100, doesn't really matter */
+    V1TestListObjIndex, /* should never be accessed, because this objType = V1*/
+    NULL, NULL, NULL, NULL, NULL, NULL
+};
+
+
 static int
 TestobjCmd(
     TCL_UNUSED(void *),
@@ -1043,15 +1089,15 @@ TestobjCmd(
     const Tcl_ObjType *targetType;
     Tcl_Obj **varPtr;
     const char *subcommands[] = {
-	"freeallvars", "bug3598580", "types",
-	"objtype", "newobj", "set",
+	"freeallvars", "bug3598580", "buge58d7e19e9",
+	"types", "objtype", "newobj", "set",
 	"assign", "convert", "duplicate",
 	"invalidateStringRep", "refcount", "type",
 	NULL
     };
     enum testobjCmdIndex {
-	TESTOBJ_FREEALLVARS, TESTOBJ_BUG3598580, TESTOBJ_TYPES,
-	TESTOBJ_OBJTYPE, TESTOBJ_NEWOBJ, TESTOBJ_SET,
+	TESTOBJ_FREEALLVARS, TESTOBJ_BUG3598580, TESTOBJ_BUGE58D7E19E9,
+	TESTOBJ_TYPES, TESTOBJ_OBJTYPE, TESTOBJ_NEWOBJ, TESTOBJ_SET,
 	TESTOBJ_ASSIGN, TESTOBJ_CONVERT, TESTOBJ_DUPLICATE,
 	TESTOBJ_INVALIDATESTRINGREP, TESTOBJ_REFCOUNT, TESTOBJ_TYPE,
     } cmdIndex;
@@ -1093,6 +1139,15 @@ TestobjCmd(
 	    Tcl_SetObjResult(interp, listObjPtr);
 	}
 	return TCL_OK;
+    case TESTOBJ_BUGE58D7E19E9:
+	if (objc != 3) {
+	    goto wrongNumArgs;
+	} else {
+	    Tcl_Obj *listObjPtr = Tcl_NewStringObj(Tcl_GetString(objv[2]), -1);
+	    listObjPtr->typePtr = &v1TestListType;
+	    Tcl_SetObjResult(interp, listObjPtr);
+	}
+	return TCL_OK;
     case TESTOBJ_TYPES:
 	if (objc != 2) {
 	    goto wrongNumArgs;

generic/tclTestObjInterface.c

@@ -1,530 +0,0 @@
-/*
- * 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

@@ -1,683 +0,0 @@
-/*
- * 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/tclTomMath.h

@@ -1,13 +1,7 @@
 #ifndef BN_TCL_H_
 #define BN_TCL_H_
 
-#ifdef MP_NO_STDINT
-#   ifdef HAVE_STDINT_H
-#	include <stdint.h>
-#   else
-#	include "../compat/stdint.h"
-#   endif
-#endif
+#include <stdint.h>
 #if defined(TCL_NO_TOMMATH_H)
     typedef size_t mp_digit;
     typedef int mp_sign;

generic/tclUniData.c

@@ -195,6 +195,7 @@ 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,
@@ -567,6 +568,8 @@ 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 */
 };
 
 /*
@@ -1177,6 +1180,7 @@ 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,
@@ -1649,6 +1653,8 @@ 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 */
 };
 
 /*
@@ -1696,7 +1702,11 @@ static const int groups[] = {
     18, 17, 10305, 10370, 10049, 10114, 8769, 8834
 };
 
-# define UNICODE_OUT_OF_RANGE(ch) (((ch) & 0x1FFFFF) >= 0x323C0)
+#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
 
 /*
  * The following constants are used to determine the category of a
@@ -1751,4 +1761,8 @@ enum {
  * Unicode character tables.
  */
 
-# define GetUniCharInfo(ch) (groups[groupMap[pageMap[((ch) & 0x1FFFFF) >> OFFSET_BITS] | ((ch) & ((1 << OFFSET_BITS)-1))]])
+#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

generic/tclUtf.c

@@ -215,7 +215,9 @@ Tcl_UniCharToUtf(
 		 * character (at most 4 bytes).
 		 */
 {
+#if TCL_UTF_MAX > 3
     int flags = ch;
+#endif
 
     if (ch >= TCL_COMBINE) {
 	ch &= (TCL_COMBINE - 1);
@@ -232,7 +234,9 @@ Tcl_UniCharToUtf(
 	}
 	if (ch <= 0xFFFF) {
 	    if (
+#if TCL_UTF_MAX > 3
 		    (flags & TCL_COMBINE) &&
+#endif
 		    ((ch & 0xF800) == 0xD800)) {
 		if (ch & 0x0400) {
 		    /* Low surrogate */
@@ -345,6 +349,15 @@ 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++;
@@ -389,6 +402,15 @@ 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. */
@@ -425,6 +447,15 @@ 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.
@@ -684,11 +715,11 @@ Tcl_UtfToUniCharDString(
     endPtr = src + length;
     optPtr = endPtr - 4;
     while (p <= optPtr) {
-	p += Tcl_UtfToUniChar(p, &ch);
+	p += TclUtfToUCS4(p, &ch);
 	*w++ = ch;
     }
     while ((p < endPtr) && Tcl_UtfCharComplete(p, endPtr-p)) {
-	p += Tcl_UtfToUniChar(p, &ch);
+	p += TclUtfToUCS4(p, &ch);
 	*w++ = ch;
     }
     while (p < endPtr) {
@@ -934,7 +965,7 @@ Tcl_UtfFindFirst(
     int ch)			/* The Unicode character to search for. */
 {
     while (1) {
-	int find, len = Tcl_UtfToUniChar(src, &find);
+	int find, len = TclUtfToUCS4(src, &find);
 
 	if (find == ch) {
 	    return src;
@@ -973,7 +1004,7 @@ Tcl_UtfFindLast(
     const char *last = NULL;
 
     while (1) {
-	int find, len = Tcl_UtfToUniChar(src, &find);
+	int find, len = TclUtfToUCS4(src, &find);
 
 	if (find == ch) {
 	    last = src;
@@ -1196,7 +1227,13 @@ Tcl_UniCharAtIndex(
 	i = TclUtfToUniChar(src, &ch);
 	src += i;
     }
-    Tcl_UtfToUniChar(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);
     return i;
 }
 
@@ -1205,8 +1242,10 @@ Tcl_UniCharAtIndex(
  *
  * Tcl_UtfAtIndex --
  *
- *	Returns a pointer to the specified character (not byte) position in the
- *	UTF-8 string. 
+ *	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.
  *
  * Results:
  *	As above.
@@ -1338,7 +1377,7 @@ Tcl_UtfToUpper(
 
     src = dst = str;
     while (*src) {
-	len = Tcl_UtfToUniChar(src, &ch);
+	len = TclUtfToUCS4(src, &ch);
 	upChar = Tcl_UniCharToUpper(ch);
 
 	/*
@@ -1391,7 +1430,7 @@ Tcl_UtfToLower(
 
     src = dst = str;
     while (*src) {
-	len = Tcl_UtfToUniChar(src, &ch);
+	len = TclUtfToUCS4(src, &ch);
 	lowChar = Tcl_UniCharToLower(ch);
 
 	/*
@@ -1447,7 +1486,7 @@ Tcl_UtfToTitle(
     src = dst = str;
 
     if (*src) {
-	len = Tcl_UtfToUniChar(src, &ch);
+	len = TclUtfToUCS4(src, &ch);
 	titleChar = Tcl_UniCharToTitle(ch);
 
 	if (len < TclUtfCount(titleChar)) {
@@ -1459,7 +1498,7 @@ Tcl_UtfToTitle(
 	src += len;
     }
     while (*src) {
-	len = Tcl_UtfToUniChar(src, &ch);
+	len = TclUtfToUCS4(src, &ch);
 	lowChar = ch;
 	/* Special exception for Georgian Asomtavruli chars, no titlecase. */
 	if ((unsigned)(lowChar - 0x1C90) >= 0x30) {
@@ -1566,6 +1605,16 @@ 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);
 	}
     }
@@ -1607,6 +1656,16 @@ 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) {
@@ -1646,6 +1705,16 @@ 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;
 	}
     }
@@ -1682,6 +1751,16 @@ 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) {
@@ -1880,7 +1959,7 @@ TclUniCharNcmp(
     const Tcl_UniChar *uct,	/* Unicode string ucs is compared to. */
     size_t numChars)	/* Number of unichars to compare. */
 {
-#if defined(WORDS_BIGENDIAN)
+#if defined(WORDS_BIGENDIAN) && (TCL_UTF_MAX > 3)
     /*
      * We are definitely on a big-endian machine; memcmp() is safe
      */
@@ -1894,6 +1973,14 @@ 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);
 	}
     }
@@ -1931,6 +2018,14 @@ 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);
 	    }
 	}
@@ -2657,6 +2752,71 @@ 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

@@ -129,10 +129,16 @@ static const Tcl_ObjType endOffsetType = {
     NULL,				/* dupIntRepProc */
     NULL,				/* updateStringProc */
     NULL,				/* setFromAnyProc */
-	0
+    TCL_OBJTYPE_V1(TclLengthOne)
 };
-
 
+Tcl_Size
+TclLengthOne(
+    TCL_UNUSED(Tcl_Obj *))
+{
+    return 1;
+}
+
 /*
  *	*	STRING REPRESENTATION OF LISTS	*	*	*
  *
@@ -1566,7 +1572,8 @@ Tcl_Merge(
 {
 #define LOCAL_SIZE 64
     char localFlags[LOCAL_SIZE], *flagPtr = NULL;
-    Tcl_Size i, bytesNeeded = 0;
+    Tcl_Size i;
+    size_t bytesNeeded = 0;
     char *result, *dst;
 
     /*
@@ -1575,6 +1582,9 @@ Tcl_Merge(
      */
 
     if (argc <= 0) {
+	if (argc < 0) {
+	    Tcl_Panic("Tcl_Merge called with negative argc (%" TCL_SIZE_MODIFIER "d)", argc);
+	}
 	result = (char *)Tcl_Alloc(1);
 	result[0] = '\0';
 	return result;
@@ -1662,7 +1672,7 @@ TclTrimRight(
 	pp = Tcl_UtfPrev(p, bytes);
 	do {
 	    pp += pInc;
- 	    pInc = Tcl_UtfToUniChar(pp, &ch1);
+ 	    pInc = TclUtfToUCS4(pp, &ch1);
 	} while (pp + pInc < p);
 
 	/*
@@ -1670,7 +1680,7 @@ TclTrimRight(
 	 */
 
 	do {
-	    pInc = Tcl_UtfToUniChar(q, &ch2);
+	    pInc = TclUtfToUCS4(q, &ch2);
 
 	    if (ch1 == ch2) {
 		break;
@@ -1735,7 +1745,7 @@ TclTrimLeft(
      */
 
     do {
-	Tcl_Size pInc = Tcl_UtfToUniChar(p, &ch1);
+	Tcl_Size pInc = TclUtfToUCS4(p, &ch1);
 	const char *q = trim;
 	Tcl_Size bytesLeft = numTrim;
 
@@ -1744,7 +1754,7 @@ TclTrimLeft(
 	 */
 
 	do {
-	    Tcl_Size qInc = Tcl_UtfToUniChar(q, &ch2);
+	    Tcl_Size qInc = TclUtfToUCS4(q, &ch2);
 
 	    if (ch1 == ch2) {
 		break;
@@ -1811,7 +1821,7 @@ TclTrim(
 	if (numBytes > 0) {
 	    int ch;
 	    const char *first = bytes + trimLeft;
-	    bytes += Tcl_UtfToUniChar(first, &ch);
+	    bytes += TclUtfToUCS4(first, &ch);
 	    numBytes -= (bytes - first);
 
 	    if (numBytes > 0) {
@@ -1967,7 +1977,8 @@ Tcl_ConcatObj(
 	Tcl_Size length;
 
 	objPtr = objv[i];
-	if (TclListObjIsCanonical(objPtr)) {
+	if (TclListObjIsCanonical(objPtr) ||
+            TclObjTypeHasProc(objPtr,indexProc)) {
 	    continue;
 	}
 	(void)Tcl_GetStringFromObj(objPtr, &length);
@@ -1979,7 +1990,8 @@ Tcl_ConcatObj(
 	resPtr = NULL;
 	for (i = 0;  i < objc;  i++) {
 	    objPtr = objv[i];
-	    if (!TclListObjIsCanonical(objPtr)) {
+	    if (!TclListObjIsCanonical(objPtr) &&
+		!TclObjTypeHasProc(objPtr,indexProc)) {
 		continue;
 	    }
 	    if (resPtr) {
@@ -1993,14 +2005,12 @@ Tcl_ConcatObj(
 			!= Tcl_ListObjAppendList(NULL, resPtr, objPtr)) {
 		    /* Abandon ship! */
 		    Tcl_DecrRefCount(resPtr);
+		    Tcl_BounceRefCount(elemPtr); // could be an abstract list element
 		    goto slow;
 		}
+		Tcl_BounceRefCount(elemPtr); // could be an an abstract list element
 	    } else {
-		resPtr = TclDuplicatePureObj(
-		    NULL, objPtr, tclListType);
-		if (!resPtr) {
-		    return NULL;
-		}
+		resPtr = TclListObjCopy(NULL, objPtr);
 	    }
 	}
 	if (!resPtr) {
@@ -2141,7 +2151,7 @@ Tcl_StringCaseMatch(
 		ch2 = (int)
 			(nocase ? tolower(UCHAR(*pattern)) : UCHAR(*pattern));
 	    } else {
-		Tcl_UtfToUniChar(pattern, &ch2);
+		TclUtfToUCS4(pattern, &ch2);
 		if (nocase) {
 		    ch2 = Tcl_UniCharToLower(ch2);
 		}
@@ -2157,7 +2167,7 @@ Tcl_StringCaseMatch(
 		if ((p != '[') && (p != '?') && (p != '\\')) {
 		    if (nocase) {
 			while (*str) {
-			    charLen = Tcl_UtfToUniChar(str, &ch1);
+			    charLen = TclUtfToUCS4(str, &ch1);
 			    if (ch2==ch1 || ch2==Tcl_UniCharToLower(ch1)) {
 				break;
 			    }
@@ -2171,7 +2181,7 @@ Tcl_StringCaseMatch(
 			 */
 
 			while (*str) {
-			    charLen = Tcl_UtfToUniChar(str, &ch1);
+			    charLen = TclUtfToUCS4(str, &ch1);
 			    if (ch2 == ch1) {
 				break;
 			    }
@@ -2185,7 +2195,7 @@ Tcl_StringCaseMatch(
 		if (*str == '\0') {
 		    return 0;
 		}
-		str += Tcl_UtfToUniChar(str, &ch1);
+		str += TclUtfToUCS4(str, &ch1);
 	    }
 	}
 
@@ -2196,7 +2206,7 @@ Tcl_StringCaseMatch(
 
 	if (p == '?') {
 	    pattern++;
-	    str += Tcl_UtfToUniChar(str, &ch1);
+	    str += TclUtfToUCS4(str, &ch1);
 	    continue;
 	}
 
@@ -2215,7 +2225,7 @@ Tcl_StringCaseMatch(
 			(nocase ? tolower(UCHAR(*str)) : UCHAR(*str));
 		str++;
 	    } else {
-		str += Tcl_UtfToUniChar(str, &ch1);
+		str += TclUtfToUCS4(str, &ch1);
 		if (nocase) {
 		    ch1 = Tcl_UniCharToLower(ch1);
 		}
@@ -2229,7 +2239,7 @@ Tcl_StringCaseMatch(
 			    ? tolower(UCHAR(*pattern)) : UCHAR(*pattern));
 		    pattern++;
 		} else {
-		    pattern += Tcl_UtfToUniChar(pattern, &startChar);
+		    pattern += TclUtfToUCS4(pattern, &startChar);
 		    if (nocase) {
 			startChar = Tcl_UniCharToLower(startChar);
 		    }
@@ -2244,7 +2254,7 @@ Tcl_StringCaseMatch(
 				? tolower(UCHAR(*pattern)) : UCHAR(*pattern));
 			pattern++;
 		    } else {
-			pattern += Tcl_UtfToUniChar(pattern, &endChar);
+			pattern += TclUtfToUCS4(pattern, &endChar);
 			if (nocase) {
 			    endChar = Tcl_UniCharToLower(endChar);
 			}
@@ -2292,8 +2302,8 @@ Tcl_StringCaseMatch(
 	 * each string match.
 	 */
 
-	str += Tcl_UtfToUniChar(str, &ch1);
-	pattern += Tcl_UtfToUniChar(pattern, &ch2);
+	str += TclUtfToUCS4(str, &ch1);
+	pattern += TclUtfToUCS4(pattern, &ch2);
 	if (nocase) {
 	    if (Tcl_UniCharToLower(ch1) != Tcl_UniCharToLower(ch2)) {
 		return 0;
@@ -2741,8 +2751,7 @@ Tcl_DStringAppendElement(
     newSize += 1; /* For terminating nul */
     if (newSize > dsPtr->spaceAvl) {
 	if (dsPtr->string == dsPtr->staticSpace) {
-	    char *newString;
-	    newString = (char *) TclAllocEx(newSize, &dsPtr->spaceAvl);
+	    char *newString = (char *) TclAllocEx(newSize, &dsPtr->spaceAvl);
 	    memcpy(newString, dsPtr->string, dsPtr->length);
 	    dsPtr->string = newString;
 	} else {
@@ -2755,7 +2764,7 @@ Tcl_DStringAppendElement(
 		offset = element - dsPtr->string;
 	    }
 	    dsPtr->string =
-		(char *)TclReallocEx(dsPtr->string, newSize, &dsPtr->spaceAvl);
+		    (char *)TclReallocEx(dsPtr->string, newSize, &dsPtr->spaceAvl);
 	    if (offset >= 0) {
 		element = dsPtr->string + offset;
 	    }
@@ -2928,7 +2937,7 @@ Tcl_DStringGetResult(
 				 * of interp. */
 {
     Tcl_Obj *obj = Tcl_GetObjResult(interp);
-    char *bytes = TclGetString(obj);
+    const char *bytes = TclGetString(obj);
 
     Tcl_DStringFree(dsPtr);
     Tcl_DStringAppend(dsPtr, bytes, obj->length);
@@ -3369,6 +3378,9 @@ GetWideForIndex(
 	if (numType == TCL_NUMBER_INT) {
 	    /* objPtr holds an integer in the signed wide range */
 	    *widePtr = *(Tcl_WideInt *)cd;
+            if ((*widePtr < 0)) {
+		*widePtr = (endValue == -1) ? WIDE_MIN : -1;
+	    }
 	    return TCL_OK;
 	}
 	if (numType == TCL_NUMBER_BIG) {
@@ -3437,11 +3449,15 @@ Tcl_GetIntForIndex(
     if (indexPtr != NULL) {
 	/* Note: check against TCL_SIZE_MAX needed for 32-bit builds */
 	if (wide >= 0 && wide <= TCL_SIZE_MAX) {
-	    *indexPtr = (Tcl_Size)wide;
+	    *indexPtr = (Tcl_Size)wide; /* A valid index */
 	} else if (wide > TCL_SIZE_MAX) {
-	    *indexPtr = TCL_SIZE_MAX;
-	} else {
-	    *indexPtr = TCL_INDEX_NONE;
+	    *indexPtr = TCL_SIZE_MAX;   /* Beyond max possible index */
+	} else if (wide < -1-TCL_SIZE_MAX) {
+            *indexPtr = -1-TCL_SIZE_MAX; /* Below most negative index */
+        } else if ((wide < 0) && (endValue >= 0)) {
+            *indexPtr = TCL_INDEX_NONE; /* No clue why this special case */
+        } else {
+	    *indexPtr = (Tcl_Size) wide;
 	}
     }
     return TCL_OK;
@@ -3501,10 +3517,13 @@ GetEndOffsetFromObj(
 
 	    /* Value doesn't start with "e" */
 
+	    /* If we reach here, the string rep of objPtr exists. */
+
 	    /*
-	     * 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.
+	     * 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.
 	     */
 
 	    /*
@@ -3622,7 +3641,6 @@ GetEndOffsetFromObj(
 	    /* Doesn't start with "end" */
 	    goto parseError;
 	}
-
 	if (length > 4) {
 	    int t;
 
@@ -3680,14 +3698,15 @@ GetEndOffsetFromObj(
 
     if (offset == WIDE_MAX) {
 	/*
-	 * Encodes end+1. This is distinguished from end+n as noted above
+	 * Encodes end+1. This is distinguished from end+n as noted
+         * in function header.
 	 * NOTE: this may wrap around if the caller passes (as lset does)
 	 * listLen-1 as endValue and and listLen is 0. The -1 will be
 	 * interpreted as FF...FF and adding 1 will result in 0 which
-	 * is what we want. 2's complements shenanigans but it is what
-	 * it is ...
+	 * is what we want. Callers like lset which pass in listLen-1 == -1
+         * as endValue will have to adjust accordingly.
 	 */
-	*widePtr = endValue + 1;
+	*widePtr = (endValue == -1) ? WIDE_MAX : endValue + 1;
     } else if (offset == WIDE_MIN) {
 	/* -1 - position before first */
 	*widePtr = -1;
@@ -3730,7 +3749,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.  This includes
+ *	index value in the Tcl_Size range.  Note that this includes
  *	index values that are integers as presented and it includes index
  *      arithmetic expressions.
  *
@@ -3946,39 +3965,6 @@ 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

@@ -245,7 +245,8 @@ static Tcl_DupInternalRepProc	DupParsedVarName;
 
 static const Tcl_ObjType localVarNameType = {
     "localVarName",
-    FreeLocalVarName, DupLocalVarName, NULL, NULL, TCL_OBJTYPE_V0
+    FreeLocalVarName, DupLocalVarName, NULL, NULL,
+    TCL_OBJTYPE_V0
 };
 
 #define LocalSetInternalRep(objPtr, index, namePtr)				\
@@ -268,7 +269,8 @@ static const Tcl_ObjType localVarNameType = {
 
 static const Tcl_ObjType parsedVarNameType = {
     "parsedVarName",
-    FreeParsedVarName, DupParsedVarName, NULL, NULL, TCL_OBJTYPE_V0
+    FreeParsedVarName, DupParsedVarName, NULL, NULL,
+    TCL_OBJTYPE_V0
 };
 
 #define ParsedSetInternalRep(objPtr, arrayPtr, elem)				\
@@ -376,7 +378,7 @@ CleanupVar(
 {
     if (TclIsVarUndefined(varPtr) && TclIsVarInHash(varPtr)
 	    && !TclIsVarTraced(varPtr)
-	    && (VarHashRefCount(varPtr) == (unsigned)
+	    && (VarHashRefCount(varPtr) == (Tcl_Size)
 		    !TclIsVarDeadHash(varPtr))) {
 	if (VarHashRefCount(varPtr) == 0) {
 	    Tcl_Free(varPtr);
@@ -386,7 +388,7 @@ CleanupVar(
     }
     if (arrayPtr != NULL && TclIsVarUndefined(arrayPtr) &&
 	    TclIsVarInHash(arrayPtr) && !TclIsVarTraced(arrayPtr) &&
-	    (VarHashRefCount(arrayPtr) == (unsigned)
+	    (VarHashRefCount(arrayPtr) == (Tcl_Size)
 		    !TclIsVarDeadHash(arrayPtr))) {
 	if (VarHashRefCount(arrayPtr) == 0) {
 	    Tcl_Free(arrayPtr);
@@ -841,8 +843,8 @@ TclLookupSimpleVar(
 				 * the variable. */
     Namespace *varNsPtr, *cxtNsPtr, *dummy1Ptr, *dummy2Ptr;
     ResolverScheme *resPtr;
-    int isNew, i, result;
-    Tcl_Size varLen;
+    int isNew, result;
+    Tcl_Size i, varLen;
     const char *varName = Tcl_GetStringFromObj(varNamePtr, &varLen);
 
     varPtr = NULL;
@@ -967,7 +969,7 @@ TclLookupSimpleVar(
 	    }
 	}
     } else {			/* Local var: look in frame varFramePtr. */
-	int localCt = varFramePtr->numCompiledLocals;
+	Tcl_Size localCt = varFramePtr->numCompiledLocals;
 
 	if (localCt > 0) {
 	    Tcl_Obj **objPtrPtr = &varFramePtr->localCachePtr->varName0;
@@ -3097,7 +3099,7 @@ ArrayForNRCmd(
      * loop) don't vanish.
      */
 
-    varListObj = TclDuplicatePureObj(interp, objv[1], tclListType);
+    varListObj = TclListObjCopy(NULL, objv[1]);
     if (!varListObj) {
 	return TCL_ERROR;
     }
@@ -4073,8 +4075,7 @@ ArraySetCmd(
 	 * the loop and return an error.
 	 */
 
-	copyListObj =
-	    TclDuplicatePureObj(interp, arrayElemObj, tclListType);
+	copyListObj = TclListObjCopy(NULL, arrayElemObj);
 	if (!copyListObj) {
 	    return TCL_ERROR;
 	}
@@ -5421,7 +5422,7 @@ TclDeleteCompiledLocalVars(
 				 * assigned local variables to delete. */
 {
     Var *varPtr;
-    size_t numLocals, i;
+    Tcl_Size numLocals, i;
     Tcl_Obj **namePtrPtr;
 
     numLocals = framePtr->numCompiledLocals;

generic/tclZipfs.c

@@ -273,15 +273,11 @@ static struct {
 				 * they are believed to not be UTF-8; only
 				 * written to from Tcl code in a trusted
 				 * interpreter, so not protected by mutex. */
-    Tcl_Encoding utf8;		/* The UTF-8 encoding that we prefer to use
-				 * for the strings (especially filenames)
-				 * embedded in a ZIP. Other encodings are used
-				 * dynamically. */
     int idCount;		/* Counter for channel names */
     Tcl_HashTable fileHash;	/* File name to ZipEntry mapping */
     Tcl_HashTable zipHash;	/* Mount to ZipFile mapping */
 } ZipFS = {
-    0, 0, 0, DEFAULT_WRITE_MAX_SIZE, NULL, NULL, 0,
+    0, 0, 0, DEFAULT_WRITE_MAX_SIZE, NULL, 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}
 };
@@ -743,7 +739,7 @@ DecodeZipEntryText(
 
     while (1) {
 	int srcRead, dstWrote;
-	int result = Tcl_ExternalToUtf(NULL, ZipFS.utf8, src, srcLen, flags,
+	int result = Tcl_ExternalToUtf(NULL, tclUtf8Encoding, src, srcLen, flags,
 		&state, dst, dstLen, &srcRead, &dstWrote, NULL);
 	int soFar = dst + dstWrote - Tcl_DStringValue(dstPtr);
 
@@ -1860,7 +1856,6 @@ ZipfsSetup(void)
     ZipFS.fallbackEntryEncoding = (char *)
 	    Tcl_Alloc(strlen(ZIPFS_FALLBACK_ENCODING) + 1);
     strcpy(ZipFS.fallbackEntryEncoding, ZIPFS_FALLBACK_ENCODING);
-    ZipFS.utf8 = Tcl_GetEncoding(NULL, "utf-8");
     ZipFS.initialized = 1;
     Tcl_CreateExitHandler(ZipfsExitHandler, NULL);
 }
@@ -2541,7 +2536,7 @@ ZipAddFile(
      * crazy enough to embed NULs in filenames, they deserve what they get!
      */
 
-    zpathExt = Tcl_UtfToExternalDString(ZipFS.utf8, zpathTcl, -1, &zpathDs);
+    zpathExt = Tcl_UtfToExternalDString(tclUtf8Encoding, zpathTcl, -1, &zpathDs);
     zpathlen = strlen(zpathExt);
     if (zpathlen + ZIP_CENTRAL_HEADER_LEN > bufsize) {
 	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
@@ -3210,7 +3205,7 @@ ZipFSMkZipOrImg(
 	}
 	z = (ZipEntry *) Tcl_GetHashValue(hPtr);
 
-	name = Tcl_UtfToExternalDString(ZipFS.utf8, z->name, TCL_INDEX_NONE, &ds);
+	name = Tcl_UtfToExternalDString(tclUtf8Encoding, z->name, TCL_INDEX_NONE, &ds);
 	len = Tcl_DStringLength(&ds);
 	SerializeCentralDirectoryEntry(start, end, (unsigned char *) buf,
 		z, len);

library/http/http.tcl

@@ -1746,6 +1746,9 @@ 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
         }
 
@@ -2164,6 +2167,9 @@ 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.
@@ -2554,6 +2560,9 @@ 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
@@ -4545,7 +4554,11 @@ proc http::Eot {token {reason {}}} {
 
 	    set enc [CharsetToEncoding $state(charset)]
 	    if {$enc ne "binary"} {
-		set state(body) [encoding convertfrom $enc $state(body)]
+		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)]
+		}
 	    }
 
 	    # Translate text line endings.
@@ -4628,7 +4641,11 @@ proc http::GuessType {token} {
     if {$enc eq "binary"} {
         return 0
     }
-    set state(body) [encoding convertfrom $enc $state(body)]
+    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) [string map {\r\n \n \r \n} $state(body)]
     set state(type) application/xml
     set state(binary) 0
@@ -4709,7 +4726,11 @@ proc http::quoteString {string} {
     # a pre-computed map and [string map] to do the conversion (much faster
     # than [regsub]/[subst]). [Bug 1020491]
 
-    set string [encoding convertto $http(-urlencoding) $string]
+    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]
+    }
     return [string map $formMap $string]
 }
 

library/tcltest/tcltest.tcl

@@ -29,6 +29,7 @@ namespace eval tcltest {
     # yourself.  You don't need tcltest to wrap it for you.
     variable version [package provide Tcl]
     variable patchLevel [info patchlevel]
+    variable fullutf [package vsatisfies $version 8.7-]
 
 ##### Export the public tcltest procs; several categories
     #
@@ -400,7 +401,7 @@ namespace eval tcltest {
 	    default {
 		set outputChannel [open $filename a]
 		if {[package vsatisfies [package provide Tcl] 8.7-]} {
-		    fconfigure $outputChannel -encoding utf-8
+		    fconfigure $outputChannel -profile tcl8 -encoding utf-8
 		}
 		set ChannelsWeOpened($outputChannel) 1
 
@@ -447,7 +448,7 @@ namespace eval tcltest {
 	    default {
 		set errorChannel [open $filename a]
 		if {[package vsatisfies [package provide Tcl] 8.7-]} {
-		    fconfigure $errorChannel -encoding utf-8
+		    fconfigure $errorChannel -profile tcl8 -encoding utf-8
 		}
 		set ChannelsWeOpened($errorChannel) 1
 
@@ -792,7 +793,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 -encoding utf-8
+	    fconfigure $tmp -profile tcl8 -encoding utf-8
 	}
 	loadScript [read $tmp]
 	close $tmp
@@ -1134,7 +1135,6 @@ proc tcltest::SafeFetch {n1 n2 op} {
     }
 }
 
-
 # tcltest::Asciify --
 #
 #       Transforms the passed string to contain only printable ascii characters.
@@ -1151,16 +1151,17 @@ proc tcltest::SafeFetch {n1 n2 op} {
 #       None.
 
 proc tcltest::Asciify {s} {
+    variable fullutf
     set print ""
     foreach c [split $s ""] {
         if {[string is print $c] && (($c <= "\x7E") || ($c == "\n"))} {
             append print $c
-        } elseif {$c <= "\xFF"} {
+        } elseif {$c < "\u0100"} {
             append print \\x[format %02X [scan $c %c]]
-        } elseif {$c <= "\xFFFF"} {
-            append print \\u[format %04X [scan $c %c]]
-        } else {
+        } elseif {$fullutf && ($c >= "\U10000")} {
             append print \\U[format %08X [scan $c %c]]
+        } else {
+            append print \\u[format %04X [scan $c %c]]
         }
     }
     return $print
@@ -1372,7 +1373,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 -encoding utf-8
+		fconfigure $f -profile tcl8 -encoding utf-8
 	    }
 	    if {![catch {puts $f exit}]} {
 		if {![catch {close $f}]} {
@@ -2222,7 +2223,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 -encoding utf-8
+		    fconfigure $testFd -profile tcl8 -encoding utf-8
 		}
 		set testLine [expr {[lsearch -regexp \
 			[split [read $testFd] "\n"] \
@@ -2253,7 +2254,11 @@ proc tcltest::test {name description args} {
 	if {$scriptCompare} {
 	    puts [outputChannel] "---- Error testing result: $scriptMatch"
 	} else {
-	    puts [outputChannel] "---- Result was:\n[Asciify $actualAnswer]"
+	    if {[catch {
+		puts [outputChannel] "---- Result was:\n[Asciify $actualAnswer]"
+	    } errMsg]} {
+		puts [outputChannel] "\n---- Result was:\n<error printing result: $errMsg>"
+	    }
 	    puts [outputChannel] "---- Result should have been\
 		    ($match matching):\n[Asciify $result]"
 	}
@@ -2933,7 +2938,7 @@ proc tcltest::runAllTests { {shell ""} } {
 		incr numTestFiles
 		set pipeFd [open $cmd "r"]
 		if {[package vsatisfies [package provide Tcl] 8.7-]} {
-		    fconfigure $pipeFd -encoding utf-8
+		    fconfigure $pipeFd -profile tcl8 -encoding utf-8
 		}
 		while {[gets $pipeFd line] >= 0} {
 		    if {[regexp [join {
@@ -3133,7 +3138,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 -encoding utf-8
+	fconfigure $fd -profile tcl8 -encoding utf-8
     }
     if {[string index $contents end] eq "\n"} {
 	puts -nonewline $fd $contents
@@ -3284,7 +3289,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 -encoding utf-8
+	fconfigure $f -profile tcl8 -encoding utf-8
     }
     set data [read -nonewline $f]
     close $f

libtommath/tommath.h

@@ -4,10 +4,7 @@
 #ifndef BN_H_
 #define BN_H_
 
-#if !defined(MP_NO_STDINT) && !defined(_STDINT_H) && !defined(_STDINT_H_) \
-	&& !defined(__CLANG_STDINT_H) && !defined(_STDINT)
-#  include <stdint.h>
-#endif
+#include <stdint.h>
 #include <stddef.h>
 #include <limits.h>
 

libtommath/tommath_private.h

@@ -4,13 +4,7 @@
 #ifndef TOMMATH_PRIV_H_
 #define TOMMATH_PRIV_H_
 
-#ifdef MP_NO_STDINT
-#ifdef HAVE_STDINT_H
-#  include <stdint.h>
-#else
-#  include "../compat/stdint.h"
-#endif
-#endif
+#include <stdint.h>
 #include "tclTomMath.h"
 #include "tommath_class.h"