merge core-8-branch

Also has (ifdef'd out) API for reading ZIP file comments.

.github/workflows/linux-build.yml

@@ -38,6 +38,8 @@ jobs:
       - name: Run Tests
         run: |
           make test
+        env:
+          ERROR_ON_FAILURES: 1
       - name: Test-Drive Installation
         run: |
           make install

.github/workflows/mac-build.yml

@@ -16,6 +16,8 @@ jobs:
         working-directory: generic
       - name: Build
         run: make all
+        env:
+          CFLAGS: -arch x86_64 -arch arm64e
       - name: Run Tests
         run: make test styles=develop
         env:
@@ -46,10 +48,13 @@ jobs:
         # Note that macOS is always a 64 bit platform
         run: ./configure --enable-64bit --enable-dtrace --enable-framework ${CFGOPT} "--prefix=$HOME/install" || (cat config.log && exit 1)
         env:
+          CFLAGS: -arch x86_64 -arch arm64e
           CFGOPT: ${{ matrix.cfgopt }}
       - name: Build
         run: |
           make all tcltest
+        env:
+          CFLAGS: -arch x86_64 -arch arm64e
       - name: Run Tests
         run: |
           make test

.github/workflows/onefiledist.yml

@@ -21,13 +21,13 @@ jobs:
         working-directory: unix
       - name: Build
         run: |
-          make tclsh tclzipfile
+          make tclsh
           make shell SCRIPT="$VER_PATH $GITHUB_ENV"
           echo "TCL_ZIP=`pwd`/`echo libtcl*.zip`" >> $GITHUB_ENV
         working-directory: unix
       - name: Package
         run: |
-          cat ../unix/tclsh $TCL_ZIP > tclsh${TCL_PATCHLEVEL}_unofficial
+          cp ../unix/tclsh tclsh${TCL_PATCHLEVEL}_unofficial
           chmod +x tclsh${TCL_PATCHLEVEL}_unofficial
           tar -cf tclsh${TCL_PATCHLEVEL}_unofficial.tar tclsh${TCL_PATCHLEVEL}_unofficial
         working-directory: 1dist
@@ -38,7 +38,7 @@ jobs:
           path: 1dist/*.tar
   macos:
     name: macOS
-    runs-on: macos-latest
+    runs-on: macos-11.0
     defaults:
       run:
         shell: bash
@@ -55,14 +55,18 @@ jobs:
         run: |
           mkdir 1dist
           touch generic/tclStubInit.c generic/tclOOStubInit.c || true
+          wget https://github.com/culler/macher/releases/download/v1.3/macher
+          sudo cp macher /usr/local/bin
+          sudo chmod a+x /usr/local/bin/macher
           echo "VER_PATH=$(cd tools; pwd)/addVerToFile.tcl" >> $GITHUB_ENV
           echo "CREATE_DMG=$(cd create-dmg;pwd)/create-dmg" >> $GITHUB_ENV
+          echo "CFLAGS=-arch x86_64 -arch arm64e" >> $GITHUB_ENV
       - name: Configure
         run: ./configure --disable-symbols --disable-shared --enable-zipfs
         working-directory: unix
       - name: Build
         run: |
-          make tclsh tclzipfile
+          make tclsh
           make shell SCRIPT="$VER_PATH $GITHUB_ENV"
           echo "TCL_BIN=`pwd`/tclsh" >> $GITHUB_ENV
           echo "TCL_ZIP=`pwd`/`echo libtcl*.zip`" >> $GITHUB_ENV
@@ -70,7 +74,7 @@ jobs:
       - name: Package
         run: |
           mkdir contents
-          cat $TCL_BIN $TCL_ZIP > contents/tclsh${TCL_PATCHLEVEL}_unofficial
+          cp $TCL_BIN contents/tclsh${TCL_PATCHLEVEL}_unofficial
           chmod +x contents/tclsh${TCL_PATCHLEVEL}_unofficial
           cat > contents/README.txt <<EOF
           This is a single-file executable developer preview of Tcl $TCL_PATCHLEVEL
@@ -116,20 +120,16 @@ jobs:
         working-directory: win
       - name: Build
         run: |
-          make binaries libraries tclzipfile
+          make binaries libraries
           echo "TCL_ZIP=`pwd`/`echo libtcl*.zip`" >> $GITHUB_ENV
         working-directory: win
-      - name: Package
-        run: |
-          cat ../win/tclsh*.exe $TCL_ZIP > combined.exe
-        working-directory: 1dist
       - name: Get Exact Version
         run: |
-          ./combined.exe $VER_PATH $GITHUB_ENV
-        working-directory: 1dist
+          ./tclsh*.exe $VER_PATH $GITHUB_ENV
+        working-directory: win
       - name: Set Executable Name
         run: |
-          mv combined.exe tclsh${TCL_PATCHLEVEL}_unofficial.exe
+          cp ../win/tclsh*.exe tclsh${TCL_PATCHLEVEL}_unofficial.exe
         working-directory: 1dist
       - name: Upload
         uses: actions/upload-artifact@v2

changes

@@ -9018,8 +9018,8 @@ in this changeset (new minor version) rather than bug fixes:
 2020-02-25 (bug) release refs when setting class's superclasses fails (dkf)
 
 2020-02-26 (bug) C++ compiler compatibility for registry and dde (nijtmans)
-=> registry 1.4.3
-=> dde 1.3.5
+=> registry 1.3.5
+=> dde 1.4.3
 
 2020-03-05 (new) Update to Unicode-13 (nijtmans)
 

doc/Alloc.3

@@ -8,7 +8,7 @@
 .so man.macros
 .BS
 .SH NAME
-Tcl_Alloc, Tcl_Free, Tcl_Realloc, Tcl_AttemptAlloc, Tcl_AttemptRealloc, ckalloc, ckfree, ckrealloc, attemptckalloc, attemptckrealloc \- allocate or free heap memory
+Tcl_Alloc, Tcl_Free, Tcl_Realloc, Tcl_AttemptAlloc, Tcl_AttemptRealloc, Tcl_GetMemoryInfo, ckalloc, ckfree, ckrealloc, attemptckalloc, attemptckrealloc \- allocate or free heap memory
 .SH SYNOPSIS
 .nf
 \fB#include <tcl.h>\fR
@@ -28,6 +28,9 @@ char *
 char *
 \fBTcl_AttemptRealloc\fR(\fIptr, size\fR)
 .sp
+void
+\fBTcl_GetMemoryInfo\fR(\fIdsPtr\fR)
+.sp
 char *
 \fBckalloc\fR(\fIsize\fR)
 .sp
@@ -48,6 +51,8 @@ char *
 Size in bytes of the memory block to allocate.
 .AP char *ptr in
 Pointer to memory block to free or realloc.
+.AP Tcl_DString *dsPtr in
+Initialized DString pointer.
 .BE
 
 .SH DESCRIPTION
@@ -88,5 +93,9 @@ these macros are redefined to be special debugging versions
 of these procedures.  To support Tcl's memory debugging within a
 module, use the macros rather than direct calls to \fBTcl_Alloc\fR, etc.
 
+\fBTcl_GetMemoryInfo\fR appends a list-of-lists of memory stats to the
+provided DString. This function cannot be used in stub-enabled extensions,
+and it is only available if Tcl is compiled with the threaded memory allocator.
+
 .SH KEYWORDS
 alloc, allocation, free, malloc, memory, realloc, TCL_MEM_DEBUG

doc/ByteArrObj.3

@@ -37,8 +37,9 @@ byte-array type.  For \fBTcl_GetByteArrayFromObj\fR and
 \fBTcl_SetByteArrayLength\fR, this points to the value from which to get
 the byte-array value; if \fIobjPtr\fR does not already point to a byte-array
 value, it will be converted to one.
-.AP int *lengthPtr out
-If non-NULL, filled with the length of the array of bytes in the value.
+.AP size_t | int *lengthPtr out
+Filled with the length of the array of bytes in the value.
+May be (int *)NULL when not used.
 .BE
 
 .SH DESCRIPTION

doc/CrtChannel.3

@@ -600,9 +600,9 @@ in preference to the \fIseekProc\fR, but both must be defined if the
 following prototype:
 .PP
 .CS
-typedef Tcl_WideInt \fBTcl_DriverWideSeekProc\fR(
+typedef long long \fBTcl_DriverWideSeekProc\fR(
         ClientData \fIinstanceData\fR,
-        Tcl_WideInt \fIoffset\fR,
+        long long \fIoffset\fR,
         int \fIseekMode\fR,
         int *\fIerrorCodePtr\fR);
 .CE
@@ -824,7 +824,7 @@ length. It can be NULL.
 .CS
 typedef int \fBTcl_DriverTruncateProc\fR(
         ClientData \fIinstanceData\fR,
-        Tcl_WideInt \fIlength\fR);
+        long long \fIlength\fR);
 .CE
 .PP
 \fIInstanceData\fR is the same as the value passed to

doc/FileSystem.3

@@ -144,16 +144,16 @@ Tcl_Obj *
 Tcl_StatBuf *
 \fBTcl_AllocStatBuf\fR()
 .sp
-Tcl_WideInt
+long long
 \fBTcl_GetAccessTimeFromStat\fR(\fIstatPtr\fR)
 .sp
 unsigned
 \fBTcl_GetBlockSizeFromStat\fR(\fIstatPtr\fR)
 .sp
-Tcl_WideUInt
+unsigned long long
 \fBTcl_GetBlocksFromStat\fR(\fIstatPtr\fR)
 .sp
-Tcl_WideInt
+long long
 \fBTcl_GetChangeTimeFromStat\fR(\fIstatPtr\fR)
 .sp
 int
@@ -174,10 +174,10 @@ int
 unsigned
 \fBTcl_GetModeFromStat\fR(\fIstatPtr\fR)
 .sp
-Tcl_WideInt
+long long
 \fBTcl_GetModificationTimeFromStat\fR(\fIstatPtr\fR)
 .sp
-Tcl_WideUInt
+unsigned long long
 \fBTcl_GetSizeFromStat\fR(\fIstatPtr\fR)
 .sp
 int
@@ -241,9 +241,9 @@ The structure that contains the result of a stat or lstat operation.
 Name of a procedure to look up in the file's symbol table
 .AP "const char" *sym2 in
 Name of a procedure to look up in the file's symbol table
-.AP Tcl_PackageInitProc **proc1Ptr out
+.AP Tcl_LibraryInitProc **proc1Ptr out
 Filled with the init function for this code.
-.AP Tcl_PackageInitProc **proc2Ptr out
+.AP Tcl_LibraryInitProc **proc2Ptr out
 Filled with the safe-init function for this code.
 .AP ClientData *clientDataPtr out
 Filled with the clientData value to pass to this code's unload

doc/IntObj.3

@@ -102,7 +102,7 @@ are provided by the C language standard.  The \fBTcl_WideInt\fR type is a
 typedef defined to be whatever signed integral type covers at least the
 64-bit integer range (-9223372036854775808 to 9223372036854775807).  Depending
 on the platform and the C compiler, the actual type might be
-\fBlong long int\fR, \fB__int64\fR, or something else.
+\fBlong long int\fR, or something else.
 The \fBmp_int\fR type is a multiple-precision integer type defined
 by the LibTomMath multiple-precision integer library.
 .PP

doc/OpenFileChnl.3

@@ -92,10 +92,10 @@ int
 int
 \fBTcl_OutputBuffered\fR(\fIchannel\fR)
 .sp
-Tcl_WideInt
+long long
 \fBTcl_Seek\fR(\fIchannel, offset, seekMode\fR)
 .sp
-Tcl_WideInt
+long long
 \fBTcl_Tell\fR(\fIchannel\fR)
 .sp
 int
@@ -190,7 +190,7 @@ A buffer containing the bytes to output to the channel.
 .AP int bytesToWrite in
 The number of bytes to consume from \fIcharBuf\fR or \fIbyteBuf\fR and
 output to the channel.
-.AP Tcl_WideInt offset in
+.AP "long long" offset in
 How far to move the access point in the channel at which the next input or
 output operation will be applied, measured in bytes from the position
 given by \fIseekMode\fR.  May be either positive or negative.
@@ -198,7 +198,7 @@ given by \fIseekMode\fR.  May be either positive or negative.
 Relative to which point to seek; used with \fIoffset\fR to calculate the new
 access point for the channel. Legal values are \fBSEEK_SET\fR,
 \fBSEEK_CUR\fR, and \fBSEEK_END\fR.
-.AP Tcl_WideInt length in
+.AP "long long" length in
 The (non-negative) length to truncate the channel the channel to.
 .AP "const char" *optionName in
 The name of an option applicable to this channel, such as \fB\-blocking\fR.

doc/PkgRequire.3

@@ -94,4 +94,4 @@ compatibility and translate their invocations to this form.
 .SH KEYWORDS
 package, present, provide, require, version
 .SH "SEE ALSO"
-package(n), Tcl_StaticPackage(3)
+package(n), Tcl_StaticLibrary(3)

doc/RegConfig.3

@@ -28,7 +28,7 @@ configuration as ASCII string. This means that this information is in
 UTF-8 too. Must not be NULL.
 .AP "const Tcl_Config" *configuration in
 Refers to an array of Tcl_Config entries containing the information
-embedded in the binary library. Must not be NULL. The end of the array
+embedded in the library. Must not be NULL. The end of the array
 is signaled by either a key identical to NULL, or a key referring to
 the empty string.
 .AP "const char" *valEncoding in
@@ -40,10 +40,10 @@ too. Must not be NULL.
 .PP
 The function described here has its base in TIP 59 and provides
 extensions with support for the embedding of configuration
-information into their binary library and the generation of a
+information into their library and the generation of a
 Tcl-level interface for querying this information.
 .PP
-To embed configuration information into their binary library an
+To embed configuration information into their library an
 extension has to define a non-volatile array of Tcl_Config entries in
 one if its source files and then call \fBTcl_RegisterConfig\fR to
 register that information.
@@ -108,4 +108,4 @@ typedef struct Tcl_Config {
 .\" No cross references yet.
 .\" .SH "SEE ALSO"
 .SH KEYWORDS
-embedding, configuration, binary library
+embedding, configuration, library

doc/StaticLibrary.3

@@ -0,0 +1,78 @@
+'\"
+'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.TH Tcl_StaticLibrary 3 7.5 Tcl "Tcl Library Procedures"
+.so man.macros
+.BS
+.SH NAME
+Tcl_StaticLibrary, Tcl_StaticPackage \- make a statically linked library available via the 'load' command
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+\fBTcl_StaticLibrary\fR(\fIinterp, prefix, initProc, safeInitProc\fR)
+.sp
+\fBTcl_StaticPackage\fR(\fIinterp, prefix, initProc, safeInitProc\fR)
+.SH ARGUMENTS
+.AS Tcl_LibraryInitProc *safeInitProc
+.AP Tcl_Interp *interp in
+If not NULL, points to an interpreter into which the library has
+already been incorporated (i.e., the caller has already invoked the
+appropriate initialization procedure).  NULL means the library
+has not yet been incorporated into any interpreter.
+.AP "const char" *prefix in
+Prefix for library initialization function;  should be properly
+capitalized (first letter upper-case, all others lower-case).
+.AP Tcl_LibraryInitProc *initProc in
+Procedure to invoke to incorporate this library into a trusted
+interpreter.
+.AP Tcl_LibraryInitProc *safeInitProc in
+Procedure to call to incorporate this library into a safe interpreter
+(one that will execute untrusted scripts).  NULL means the library
+cannot be used in safe interpreters.
+.BE
+.SH DESCRIPTION
+.PP
+This procedure may be invoked to announce that a library has been
+linked statically with a Tcl application and, optionally, that it
+has already been incorporated into an interpreter.
+Once \fBTcl_StaticLibrary\fR has been invoked for a library, it
+may be incorporated into interpreters using the \fBload\fR command.
+\fBTcl_StaticLibrary\fR is normally invoked only by the \fBTcl_AppInit\fR
+procedure for the application, not by libraries for themselves
+(\fBTcl_StaticLibrary\fR should only be invoked for statically
+linked libraries, and code in the library itself should not need
+to know whether the library is dynamically loaded or statically linked).
+.PP
+When the \fBload\fR command is used later to incorporate the library into
+an interpreter, one of \fIinitProc\fR and \fIsafeInitProc\fR will
+be invoked, depending on whether the target interpreter is safe
+or not.
+\fIinitProc\fR and \fIsafeInitProc\fR must both match the
+following prototype:
+.PP
+.CS
+typedef int \fBTcl_LibraryInitProc\fR(
+        Tcl_Interp *\fIinterp\fR);
+.CE
+.PP
+The \fIinterp\fR argument identifies the interpreter in which the library
+is to be incorporated.  The initialization procedure must return \fBTCL_OK\fR or
+\fBTCL_ERROR\fR to indicate whether or not it completed successfully; in
+the event of an error it should set the interpreter's result to point to an
+error message.  The result or error from the initialization procedure will
+be returned as the result of the \fBload\fR command that caused the
+initialization procedure to be invoked.
+.PP
+\fBTcl_StaticLibrary\fR was named \fBTcl_StaticPackage\fR in Tcl 8.6 and
+earlier, but the old name is deprecated now.
+.PP
+\fBTcl_StaticLibrary\fR can not be used in stub-enabled extensions. Its symbol
+entry in the stub table is deprecated and it will be removed in Tcl 9.0.
+.SH KEYWORDS
+initialization procedure, package, static linking
+.SH "SEE ALSO"
+load(n), package(n), Tcl_PkgRequire(3)

doc/StaticPkg.3

@@ -1,73 +0,0 @@
-'\"
-'\" Copyright (c) 1995-1996 Sun Microsystems, Inc.
-'\"
-'\" See the file "license.terms" for information on usage and redistribution
-'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
-'\"
-.TH Tcl_StaticPackage 3 7.5 Tcl "Tcl Library Procedures"
-.so man.macros
-.BS
-.SH NAME
-Tcl_StaticPackage \- make a statically linked package available via the 'load' command
-.SH SYNOPSIS
-.nf
-\fB#include <tcl.h>\fR
-.sp
-\fBTcl_StaticPackage\fR(\fIinterp, pkgName, initProc, safeInitProc\fR)
-.SH ARGUMENTS
-.AS Tcl_PackageInitProc *safeInitProc
-.AP Tcl_Interp *interp in
-If not NULL, points to an interpreter into which the package has
-already been loaded (i.e., the caller has already invoked the
-appropriate initialization procedure).  NULL means the package
-has not yet been incorporated into any interpreter.
-.AP "const char" *pkgName in
-Name of the package;  should be properly capitalized (first letter
-upper-case, all others lower-case).
-.AP Tcl_PackageInitProc *initProc in
-Procedure to invoke to incorporate this package into a trusted
-interpreter.
-.AP Tcl_PackageInitProc *safeInitProc in
-Procedure to call to incorporate this package into a safe interpreter
-(one that will execute untrusted scripts).  NULL means the package
-cannot be used in safe interpreters.
-.BE
-.SH DESCRIPTION
-.PP
-This procedure may be invoked to announce that a package has been
-linked statically with a Tcl application and, optionally, that it
-has already been loaded into an interpreter.
-Once \fBTcl_StaticPackage\fR has been invoked for a package, it
-may be loaded into interpreters using the \fBload\fR command.
-\fBTcl_StaticPackage\fR is normally invoked only by the \fBTcl_AppInit\fR
-procedure for the application, not by packages for themselves
-(\fBTcl_StaticPackage\fR should only be invoked for statically
-loaded packages, and code in the package itself should not need
-to know whether the package is dynamically or statically loaded).
-.PP
-When the \fBload\fR command is used later to load the package into
-an interpreter, one of \fIinitProc\fR and \fIsafeInitProc\fR will
-be invoked, depending on whether the target interpreter is safe
-or not.
-\fIinitProc\fR and \fIsafeInitProc\fR must both match the
-following prototype:
-.PP
-.CS
-typedef int \fBTcl_PackageInitProc\fR(
-        Tcl_Interp *\fIinterp\fR);
-.CE
-.PP
-The \fIinterp\fR argument identifies the interpreter in which the package
-is to be loaded.  The initialization procedure must return \fBTCL_OK\fR or
-\fBTCL_ERROR\fR to indicate whether or not it completed successfully; in
-the event of an error it should set the interpreter's result to point to an
-error message.  The result or error from the initialization procedure will
-be returned as the result of the \fBload\fR command that caused the
-initialization procedure to be invoked.
-.PP
-\fBTcl_StaticPackage\fR can not be used in stub-enabled extensions. Its symbol
-entry in the stub table is deprecated and it will be removed in Tcl 9.0.
-.SH KEYWORDS
-initialization procedure, package, static linking
-.SH "SEE ALSO"
-load(n), package(n), Tcl_PkgRequire(3)

doc/StringObj.3

@@ -120,8 +120,8 @@ Points to a value to manipulate.
 .AP Tcl_Obj *appendObjPtr in
 The value to append to \fIobjPtr\fR in \fBTcl_AppendObjToObj\fR.
 .AP size_t | int *lengthPtr out
-If non-NULL, the location where \fBTcl_GetStringFromObj\fR will store
-the length of a value's string representation.
+The location where \fBTcl_GetStringFromObj\fR will store the length
+of a value's string representation. May be (int *)NULL when not used.
 .AP "const char" *string in
 Null-terminated string value to append to \fIobjPtr\fR.
 .AP va_list argList in

doc/Tcl_Main.3

@@ -10,13 +10,17 @@
 .so man.macros
 .BS
 .SH NAME
-Tcl_Main, Tcl_SetStartupScript, Tcl_GetStartupScript, Tcl_SetMainLoop \- main program, startup script, and event loop definition for Tcl-based applications
+Tcl_Main, Tcl_MainEx, Tcl_MainExW, Tcl_SetStartupScript, Tcl_GetStartupScript, Tcl_SetMainLoop \- main program, startup script, and event loop definition for Tcl-based applications
 .SH SYNOPSIS
 .nf
 \fB#include <tcl.h>\fR
 .sp
 \fBTcl_Main\fR(\fIargc, argv, appInitProc\fR)
 .sp
+\fBTcl_MainEx\fR(\fIargc, charargv, appInitProc, interp\fR)
+.sp
+\fBTcl_MainExW\fR(\fIargc, wideargv, appInitProc, interp\fR)
+.sp
 \fBTcl_SetStartupScript\fR(\fIpath, encoding\fR)
 .sp
 Tcl_Obj *
@@ -30,6 +34,10 @@ Number of elements in \fIargv\fR.
 .AP char *argv[] in
 Array of strings containing command-line arguments. On Windows, when
 using -DUNICODE, the parameter type changes to wchar_t *.
+.AP char *charargv[] in
+As argv, but does not change type to wchar_t.
+.AP char *wideargv[] in
+As argv, but type is always wchar_t.
 .AP Tcl_AppInitProc *appInitProc in
 Address of an application-specific initialization procedure.
 The value for this argument is usually \fBTcl_AppInit\fR.
@@ -42,6 +50,8 @@ If non-NULL, location to write a copy of the (const char *)
 pointing to the encoding name.
 .AP Tcl_MainLoopProc *mainLoopProc in
 Address of an application-specific event loop procedure.
+.AP Tcl_Interp *interp in
+Already created Tcl Interpreter.
 .BE
 .SH DESCRIPTION
 .PP

doc/Utf.3

@@ -233,10 +233,10 @@ 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
-\fBTcl_UtfToUniChar\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 know if a
-full Unicode character has been seen.
+\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
+know if a full Unicode character has been seen.
 .PP
 \fBTcl_NumUtfChars\fR corresponds to \fBstrlen\fR for UTF-8 strings.  It
 returns the number of Tcl_UniChars that are represented by the UTF-8 string
@@ -257,7 +257,8 @@ Given \fIsrc\fR, a pointer to some location in a UTF-8 string,
 \fBTcl_UtfNext\fR returns a pointer to the next UTF-8 character in the
 string.  The caller must not ask for the next character after the last
 character in the string if the string is not terminated by a null
-character.
+character. \fBTcl_UtfCharComplete\fR can be used in that case to
+make sure enough bytes are available before calling \fBTcl_UtfNext\fR.
 .PP
 \fBTcl_UtfPrev\fR is used to step backward through but not beyond the
 UTF-8 string that begins at \fIstart\fR.  If the UTF-8 string is made
@@ -274,12 +275,12 @@ always a pointer to a location in the string. It always returns a pointer to
 a byte that begins a character when scanning for characters beginning
 from \fIstart\fR. When \fIsrc\fR is greater than \fIstart\fR, it
 always returns a pointer less than \fIsrc\fR and greater than or
-equal to (\fIsrc\fR - \fBTCL_UTF_MAX\fR).  The character that begins
+equal to (\fIsrc\fR - 4).  The character that begins
 at the returned pointer is the first one that either includes the
 byte \fIsrc[-1]\fR, or might include it if the right trail bytes are
 present at \fIsrc\fR and greater. \fBTcl_UtfPrev\fR never reads the
 byte \fIsrc[0]\fR nor the byte \fIstart[-1]\fR nor the byte
-\fIsrc[-\fBTCL_UTF_MAX\fI-1]\fR.
+\fIsrc[-5]\fR.
 .PP
 \fBTcl_UniCharAtIndex\fR corresponds to a C string array dereference or the
 Pascal Ord() function.  It returns the Unicode character represented at the

doc/exec.n

@@ -22,6 +22,10 @@ of one or more subprocesses to execute.
 The arguments take the form of a standard shell pipeline
 where each \fIarg\fR becomes one word of a command, and
 each distinct command becomes a subprocess.
+The result of the command is the standard output of the final subprocess in
+the pipeline, interpreted using the system \fBencoding\fR; to use any other
+encoding (especially including binary data), the pipeline must be
+\fBopen\fRed, configured and read explicitly.
 .PP
 If the initial arguments to \fBexec\fR start with \fB\-\fR then
 they are treated as command-line switches and are not part
@@ -411,7 +415,9 @@ With the file \fIcmp.bat\fR looking something like:
 .CS
 @gcc %*
 .CE
+.PP
 or like another variant using single parameters:
+.PP
 .CS
 @gcc %1 %2 %3 %4 %5 %6 %7 %8 %9
 .CE

doc/file.n

@@ -38,28 +38,31 @@ generated.  On Windows, FAT file systems do not support access time.
 .TP
 \fBfile attributes \fIname\fR ?\fIoption value option value...\fR?
 .
-This subcommand returns or sets platform specific values associated
-with a file. The first form returns a list of the platform specific
-flags and their values. The second form returns the value for the
-specific option. The third form sets one or more of the values. The
-values are as follows:
+This subcommand returns or sets platform-specific values associated
+with a file. The first form returns a list of the platform-specific
+options and their values. The second form returns the value for the
+given option. The third form sets one or more of the values. The values
+are as follows:
 .RS
 .PP
-On Unix, \fB\-group\fR gets or sets the group name for the file. A group id
-can be given to the command, but it returns a group name. \fB\-owner\fR gets
-or sets the user name of the owner of the file. The command returns the
-owner name, but the numerical id can be passed when setting the
-owner. \fB\-permissions\fR sets or retrieves the octal code that chmod(1)
-uses.  This command does also has limited support for setting using the
-symbolic attributes for chmod(1), of the form [ugo]?[[+\-=][rwxst],[...]],
-where multiple symbolic attributes can be separated by commas (example:
-\fBu+s,go\-rw\fR add sticky bit for user, remove read and write
-permissions for group and other).  A simplified \fBls\fR style string,
-of the form rwxrwxrwx (must be 9 characters), is also supported
-(example: \fBrwxr\-xr\-t\fR is equivalent to 01755).
-On versions of Unix supporting file flags, \fB\-readonly\fR gives the
-value or sets or clears the readonly attribute of the file,
-i.e. the user immutable flag \fBuchg\fR to chflags(1).
+On Unix, \fB\-group\fR gets or sets the group name for the file. A
+group id can be given to the command, but it returns a group name.
+\fB\-owner\fR gets or sets the user name of the owner of the file. The
+command returns the owner name, but the numerical id can be passed when
+setting the owner. \fB\-permissions\fR retrieves or sets a file's
+access permissions, using octal notation by default. This option also
+provides limited support for setting permissions using the symbolic
+notation accepted by the \fBchmod\fR command, following the form
+[\fBugo\fR]?[[\fB+-=\fR][\fBrwxst\fR]\fB,\fR[...]]. Multiple permission
+specifications may be given, separated by commas. E.g., \fBu+s,go-rw\fR
+would set the setuid bit for a file's owner as well as remove read and
+write permission for the file's group and other users. An
+\fBls\fR-style string of the form \fBrwxrwxrwx\fR is also accepted but
+must always be 9 characters long. E.g., \fBrwxr-xr-t\fR is equivalent
+to \fB01755\fR. On versions of Unix supporting file flags,
+\fB-readonly\fR returns the value of, or sets, or clears the readonly
+attribute of a file, i.e., the user immutable flag (\fBuchg\fR) to the
+\fBchflags\fR command.
 .PP
 On Windows, \fB\-archive\fR gives the value or sets or clears the
 archive attribute of the file. \fB\-hidden\fR gives the value or sets

doc/filename.n

@@ -150,9 +150,7 @@ The safest approach is to use names consisting of
 alphanumeric characters only.  Care should be taken with filenames
 which contain spaces (common on Windows systems) and
 filenames where the backslash is the directory separator (Windows
-native path names).  Also Windows 3.1 only supports file
-names with a root of no more than 8 characters and an extension of no
-more than 3 characters.
+native path names).
 .PP
 On Windows platforms there are file and path length restrictions.
 Complete paths or filenames longer than about 260 characters will lead

doc/load.n

@@ -13,22 +13,21 @@ load \- Load machine code and initialize new commands
 .SH SYNOPSIS
 \fBload\fR ?\fB\-global\fR? ?\fB\-lazy\fR? ?\fB\-\-\fR? \fIfileName\fR
 .br
-\fBload\fR ?\fB\-global\fR? ?\fB\-lazy\fR? ?\fB\-\-\fR? \fIfileName packageName\fR
+\fBload\fR ?\fB\-global\fR? ?\fB\-lazy\fR? ?\fB\-\-\fR? \fIfileName prefix\fR
 .br
-\fBload\fR ?\fB\-global\fR? ?\fB\-lazy\fR? ?\fB\-\-\fR? \fIfileName packageName interp\fR
+\fBload\fR ?\fB\-global\fR? ?\fB\-lazy\fR? ?\fB\-\-\fR? \fIfileName prefix interp\fR
 .BE
 .SH DESCRIPTION
 .PP
 This command loads binary code from a file into the
 application's address space and calls an initialization procedure
-in the package to incorporate it into an interpreter.  \fIfileName\fR
+in the library to incorporate it into an interpreter.  \fIfileName\fR
 is the name of the file containing the code;  its exact form varies
 from system to system but on most systems it is a shared library,
 such as a \fB.so\fR file under Solaris or a DLL under Windows.
-\fIpackageName\fR is the name of the package, and is used to
-compute the name of an initialization procedure.
+\fIprefix\fR is used to compute the name of an initialization procedure.
 \fIinterp\fR is the path name of the interpreter into which to load
-the package (see the \fBinterp\fR manual entry for details);
+the library (see the \fBinterp\fR manual entry for details);
 if \fIinterp\fR is omitted, it defaults to the
 interpreter in which the \fBload\fR command was invoked.
 .PP
@@ -37,32 +36,32 @@ one of two initialization procedures will be invoked in the new code.
 Typically the initialization procedure will add new commands to a
 Tcl interpreter.
 The name of the initialization procedure is determined by
-\fIpackageName\fR and whether or not the target interpreter
+\fIprefix\fR and whether or not the target interpreter
 is a safe one.  For normal interpreters the name of the initialization
-procedure will have the form \fIpkg\fB_Init\fR, where \fIpkg\fR
-is the same as \fIpackageName\fR except that the first letter is
+procedure will have the form \fIpfx\fB_Init\fR, where \fIpfx\fR
+is the same as \fIprefix\fR except that the first letter is
 converted to upper case and all other letters
-are converted to lower case.  For example, if \fIpackageName\fR is
+are converted to lower case.  For example, if \fIprefix\fR is
 \fBfoo\fR or \fBFOo\fR, the initialization procedure's name will
 be \fBFoo_Init\fR.
 .PP
 If the target interpreter is a safe interpreter, then the name
-of the initialization procedure will be \fIpkg\fB_SafeInit\fR
-instead of \fIpkg\fB_Init\fR.
-The \fIpkg\fB_SafeInit\fR function should be written carefully, so that it
+of the initialization procedure will be \fIpfx\fB_SafeInit\fR
+instead of \fIpfx\fB_Init\fR.
+The \fIpfx\fB_SafeInit\fR function should be written carefully, so that it
 initializes the safe interpreter only with partial functionality provided
-by the package that is safe for use by untrusted code. For more information
+by the library that is safe for use by untrusted code. For more information
 on Safe\-Tcl, see the \fBsafe\fR manual entry.
 .PP
 The initialization procedure must match the following prototype:
 .PP
 .CS
-typedef int \fBTcl_PackageInitProc\fR(
+typedef int \fBTcl_LibraryInitProc\fR(
         Tcl_Interp *\fIinterp\fR);
 .CE
 .PP
 The \fIinterp\fR argument identifies the interpreter in which the
-package is to be loaded.  The initialization procedure must return
+library is to be loaded.  The initialization procedure must return
 \fBTCL_OK\fR or \fBTCL_ERROR\fR to indicate whether or not it completed
 successfully;  in the event of an error it should set the interpreter's result
 to point to an error message.  The result of the \fBload\fR command
@@ -74,37 +73,37 @@ interpreters, then the first \fBload\fR will load the code and
 call the initialization procedure;  subsequent \fBload\fRs will
 call the initialization procedure without loading the code again.
 For Tcl versions lower than 8.5, it is not possible to unload or reload a
-package. From version 8.5 however, the \fBunload\fR command allows the unloading
+library. From version 8.5 however, the \fBunload\fR command allows the unloading
 of libraries loaded with \fBload\fR, for libraries that are aware of the
 Tcl's unloading mechanism.
 .PP
-The \fBload\fR command also supports packages that are statically
-linked with the application, if those packages have been registered
-by calling the \fBTcl_StaticPackage\fR procedure.
-If \fIfileName\fR is an empty string, then \fIpackageName\fR must
+The \fBload\fR command also supports libraries that are statically
+linked with the application, if those libraries have been registered
+by calling the \fBTcl_StaticLibrary\fR procedure.
+If \fIfileName\fR is an empty string, then \fIprefix\fR must
 be specified.
 .PP
-If \fIpackageName\fR is omitted or specified as an empty string,
-Tcl tries to guess the name of the package.
-This may be done differently on different platforms.
-The default guess, which is used on most UNIX platforms, is to
-take the last element of \fIfileName\fR, strip off the first
-three characters if they are \fBlib\fR, then strip off the next
-three characters if they are \fBtcl\fR, and use any following
-alphabetic and underline characters as the module name.
-For example, the command \fBload libtclxyz4.2.so\fR uses the module
-name \fBxyz\fR and the command \fBload bin/last.so {}\fR uses the
-module name \fBlast\fR.
+If \fIprefix\fR is omitted or specified as an empty string,
+Tcl tries to guess the prefix. This may be done differently on
+different platforms. The default guess, which is used on most
+UNIX platforms, is to take the last element of
+\fIfileName\fR, strip off the first three characters if they
+are \fBlib\fR, then strip off the next three characters if they
+are \fBtcl\fR, and use any following alphabetic and
+underline characters, converted to titlecase as the prefix.
+For example, the command \fBload libxyz4.2.so\fR uses the prefix
+\fBXyz\fR and the command \fBload bin/last.so {}\fR uses the
+prefix \fBLast\fR.
 .PP
-If \fIfileName\fR is an empty string, then \fIpackageName\fR must
+If \fIfileName\fR is an empty string, then \fIprefix\fR must
 be specified.
-The \fBload\fR command first searches for a statically loaded package
-(one that has been registered by calling the \fBTcl_StaticPackage\fR
+The \fBload\fR command first searches for a statically loaded library
+(one that has been registered by calling the \fBTcl_StaticLibrary\fR
 procedure) by that name; if one is found, it is used.
 Otherwise, the \fBload\fR command searches for a dynamically loaded
-package by that name, and uses it if it is found.  If several
+library by that name, and uses it if it is found.  If several
 different files have been \fBload\fRed with different versions of
-the package, Tcl picks the file that was loaded first.
+the library, Tcl picks the file that was loaded first.
 .PP
 If \fB\-global\fR is specified preceding the filename, all symbols
 found in the shared library are exported for global use by other
@@ -112,7 +111,7 @@ libraries. The option \fB\-lazy\fR delays the actual loading of
 symbols until their first actual use. The options may be abbreviated.
 The option \fB\-\-\fR indicates the end of the options, and should
 be used if you wish to use a filename which starts with \fB\-\fR
-and you provide a packageName to the \fBload\fR command.
+and you provide a prefix to the \fBload\fR command.
 .PP
 On platforms which do not support the \fB\-global\fR or \fB\-lazy\fR
 options, the options still exist but have no effect. Note that use
@@ -155,7 +154,7 @@ The following is a minimal extension:
 .CS
 #include <tcl.h>
 #include <stdio.h>
-static int fooCmd(ClientData clientData,
+static int fooCmd(void *clientData,
         Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) {
     printf("called with %d arguments\en", objc);
     return TCL_OK;
@@ -189,7 +188,7 @@ switch $tcl_platform(platform) {
 foo
 .CE
 .SH "SEE ALSO"
-info sharedlibextension, package(n), Tcl_StaticPackage(3), safe(n)
+info sharedlibextension, package(n), Tcl_StaticLibrary(3), safe(n)
 .SH KEYWORDS
 binary code, dynamic library, load, safe interpreter, shared library
 '\"Local Variables:

doc/msgcat.n

@@ -219,7 +219,7 @@ As an example, the user may prefer French or English text. This may be configure
 .PP
 .VS "TIP 499"
 .TP
-\fB::msgcat:mcloadedlocales subcommand\fR ?\fIlocale\fR?
+\fB::msgcat::mcloadedlocales subcommand\fR ?\fIlocale\fR?
 .
 This group of commands manage the list of loaded locales for packages not setting a package locale.
 .PP

doc/open.n

@@ -72,7 +72,7 @@ indicate that the opened channel should be configured as if with the
 reading or writing of binary data.
 .PP
 In the second form, \fIaccess\fR consists of a list of any of the
-following flags, all of which have the standard POSIX meanings.
+following flags, most of which have the standard POSIX meanings.
 One of the flags must be either \fBRDONLY\fR, \fBWRONLY\fR or \fBRDWR\fR.
 .TP 15
 \fBRDONLY\fR
@@ -453,6 +453,12 @@ application are competing for the console at the same time.  If the command
 pipeline is started from a script, so that Tcl is not accessing the console,
 or if the command pipeline does not use standard input or output, but is
 redirected from or to a file, then the above problems do not occur.
+.PP
+Files opened in the
+.QW \fBa\fR
+mode or with the \fBAPPEND\fR flag set are implemented by seeking immediately
+before each write, which is not an atomic operation and does not carry the
+guarantee of strict appending that is present on POSIX platforms.
 .RE
 .TP
 \fBUnix\fR\0\0\0\0\0\0\0
@@ -527,6 +533,19 @@ Note that the equivalent options exist on Unix, but are on the serial channel
 type.
 .VE "8.7, TIP 160"
 .SH "EXAMPLES"
+Open a file for writing, forcing it to be created and raising an error if it
+already exists.
+.PP
+.CS
+set myNewFile [\fBopen\fR filename.txt {WRONLY CREAT EXCL}]
+.CE
+.PP
+Open a file for writing as a log file.
+.PP
+.CS
+set myLogFile [\fBopen\fR filename.log "a"]
+fconfigure $myLogFile -buffering line
+.CE
 .PP
 Open a command pipeline and catch any errors:
 .PP
@@ -538,6 +557,18 @@ if {[catch {close $fl} err]} {
 }
 .CE
 .PP
+Open a command pipeline and read binary data from it. Note the unusual form
+with
+.QW |[list
+that handles non-trivial edge cases with arguments that potentially have
+spaces in.
+.PP
+.CS
+set fl [\fBopen\fR |[list create_image_data $input] "rb"]
+set binData [read $fl]
+close $fl
+.CE
+.PP
 .VS "8.7, TIP 160"
 Read a password securely from the user (assuming that the script is being run
 interactively):

doc/packagens.n

@@ -29,7 +29,7 @@ This parameter specifies the name of the package.  It is required.
 This parameter specifies the version of the package.  It is required.
 .TP
 \fB\-load \fIfilespec\fR
-This parameter specifies a binary library that must be loaded with the
+This parameter specifies a library that must be loaded with the
 \fBload\fR command.  \fIfilespec\fR is a list with two elements.  The
 first element is the name of the file to load.  The second, optional
 element is a list of commands supplied by loading that file.  If the

doc/re_syntax.n

@@ -137,11 +137,26 @@ later, under \fBESCAPES\fR.
 .TP 8
 \fB^\fR
 .
-matches at the beginning of a line
+matches at the beginning of the string or a line (according to whether
+matching is newline-sensitive or not, as described in \fBMATCHING\fR,
+below).
 .TP
 \fB$\fR
 .
-matches at the end of a line
+matches at the end of the string or a line (according to whether
+matching is newline-sensitive or not, as described in \fBMATCHING\fR,
+below).
+.RS
+.PP
+The difference between string and line matching modes is immaterial
+when the string does not contain a newline character.  The \fB\eA\fR
+and \fB\eZ\fR constraint escapes have a similar purpose but are
+always constraints for the overall string.
+.PP
+The default newline-sensitivity depends on the command that uses the
+regular expression, and can be overridden as described in
+\fBMETASYNTAX\fR, below.
+.RE
 .TP
 \fB(?=\fIre\fB)\fR
 .
@@ -431,7 +446,7 @@ commonly-used character classes:
 .TP
 \fB\ew\fR
 .
-\fB[[:alnum:]_]\fR (note underscore)
+\fB[[:alnum:]_\eu203F\eu2040\eu2054\euFE33\euFE34\euFE4D\euFE4E\euFE4F\euFF3F]\fR (including punctuation connector characters)
 .TP
 \fB\eD\fR
 .
@@ -443,7 +458,7 @@ commonly-used character classes:
 .TP
 \fB\eW\fR
 .
-\fB[^[:alnum:]_]\fR (note underscore)
+\fB[^[:alnum:]_\eu203F\eu2040\eu2054\euFE33\euFE34\euFE4D\euFE4E\euFE4F\euFF3F]\fR (including punctuation connector characters)
 .RE
 .PP
 Within bracket expressions,

doc/refchan.n

@@ -322,6 +322,19 @@ invocation (usually \fBfconfigure\fR or \fBchan configure\fR) will appear to
 have thrown this error. Any exception beyond \fBerror\fR (e.g.,\ \fBbreak\fR,
 etc.) is treated as and converted to an error.
 .RE
+.TP
+\fIcmdPrefix \fBtruncate\fR \fIchannelId length\fR
+.
+This \fIoptional\fR subcommand handles changing the length of the
+underlying data stream for the channel \fIchannelId\fR. Its length
+gets set to \fIlength\fR.
+.RS
+.PP
+If the subcommand throws an error the command which caused its
+invocation (usually \fBchan truncate\fR) will appear to have thrown
+this error. Any exception beyond \fBerror\fR (e.g.,\ \fBbreak\fR,
+etc.) is treated as and converted to an error.
+.RE
 .SH NOTES
 Some of the functions supported in channels defined in Tcl's C
 interface are not available to channels reflected to the Tcl level.

doc/string.n

@@ -404,7 +404,7 @@ Formally, the \fBstring bytelength\fR operation returns the content of
 the \fIlength\fR field of the \fBTcl_Obj\fR structure, after calling
 \fBTcl_GetString\fR to ensure that the \fIbytes\fR field is populated.
 This is highly unlikely to be useful to Tcl scripts, as Tcl's internal
-encoding is not strict UTF\-8, but rather a modified CESU\-8 with a
+encoding is not strict UTF\-8, but rather a modified WTF\-8 with a
 denormalized NUL (identical to that used in a number of places by
 Java's serialization mechanism) to enable basic processing with
 non-Unicode-aware C functions.  As this representation should only

doc/unload.n

@@ -13,9 +13,9 @@ unload \- Unload machine code
 .SH SYNOPSIS
 \fBunload \fR?\fIswitches\fR? \fIfileName\fR
 .br
-\fBunload \fR?\fIswitches\fR? \fIfileName packageName\fR
+\fBunload \fR?\fIswitches\fR? \fIfileName prefix\fR
 .br
-\fBunload \fR?\fIswitches\fR? \fIfileName packageName interp\fR
+\fBunload \fR?\fIswitches\fR? \fIfileName prefix interp\fR
 .BE
 .SH DESCRIPTION
 .PP
@@ -24,7 +24,7 @@ with \fBload\fR from the application's address space.  \fIfileName\fR
 is the name of the file containing the library file to be unload;  it
 must be the same as the filename provided to \fBload\fR for
 loading the library.
-The \fIpackageName\fR argument is the name of the package (as
+The \fIprefix\fR argument is the prefix (as
 determined by or passed to \fBload\fR), and is used to
 compute the name of the unload procedure; if not supplied, it is
 computed from \fIfileName\fR in the same manner as \fBload\fR.
@@ -66,12 +66,12 @@ proper reference count.
 \fBunload\fR works in the opposite direction. As a first step, \fBunload\fR
 will check whether the library is unloadable: an unloadable library exports
 a special unload procedure. The name of the unload procedure is determined by
-\fIpackageName\fR and whether or not the target interpreter
+\fIprefix\fR and whether or not the target interpreter
 is a safe one.  For normal interpreters the name of the initialization
-procedure will have the form \fIpkg\fB_Unload\fR, where \fIpkg\fR
-is the same as \fIpackageName\fR except that the first letter is
+procedure will have the form \fIpfx\fB_Unload\fR, where \fIpfx\fR
+is the same as \fIprefix\fR except that the first letter is
 converted to upper case and all other letters
-are converted to lower case.  For example, if \fIpackageName\fR is
+are converted to lower case.  For example, if \fIprefix\fR is
 \fBfoo\fR or \fBFOo\fR, the initialization procedure's name will
 be \fBFoo_Unload\fR.
 If the target interpreter is a safe interpreter, then the name
@@ -90,7 +90,7 @@ detached from the process.
 The unload procedure must match the following prototype:
 .PP
 .CS
-typedef int \fBTcl_PackageUnloadProc\fR(
+typedef int \fBTcl_LibraryUnloadProc\fR(
         Tcl_Interp *\fIinterp\fR,
         int \fIflags\fR);
 .CE
@@ -114,19 +114,20 @@ the \fIflags\fR argument will be set to \fBTCL_UNLOAD_DETACH_FROM_PROCESS\fR.
 .PP
 The \fBunload\fR command cannot unload libraries that are statically
 linked with the application.
-If \fIfileName\fR is an empty string, then the \fIpackageName\fR argument must
+If \fIfileName\fR is an empty string, then the \fIprefix\fR argument must
 be specified.
 .PP
-If \fIpackageName\fR is omitted or specified as an empty string,
-Tcl tries to guess the name of the package.
-This may be done differently on different platforms.
-The default guess, which is used on most UNIX platforms, is to
-take the last element of \fIfileName\fR, strip off the first
-three characters if they are \fBlib\fR, and use any following
-alphabetic and underline characters as the module name.
-For example, the command \fBunload libxyz4.2.so\fR uses the module
-name \fBxyz\fR and the command \fBunload bin/last.so {}\fR uses the
-module name \fBlast\fR.
+If \fIprefix\fR is omitted or specified as an empty string,
+Tcl tries to guess the prefix. This may be done differently on
+different platforms. The default guess, which is used on most
+UNIX platforms, is to take the last element of
+\fIfileName\fR, strip off the first three characters if they
+are \fBlib\fR, then strip off the next three characters if they
+are \fBtcl\fR, and use any following alphabetic and
+underline characters, converted to titlecase as the prefix.
+For example, the command \fBunload libxyz4.2.so\fR uses the prefix
+\fBXyz\fR and the command \fBunload bin/last.so {}\fR uses the
+prefix \fBLast\fR.
 .SH "PORTABILITY ISSUES"
 .TP
 \fBUnix\fR\0\0\0\0\0

doc/zipfs.n

@@ -84,7 +84,7 @@ Return a list of all files in the mounted zipfs, or just those matching
 \fIpattern\fR (optionally controlled by the option parameters).  The order of
 the names in the list is arbitrary.
 .TP
-\fBzipfs mount ?\fImountpoint\fR? ?\fIzipfile\fR? ?\fIpassword\fR?
+\fBzipfs mount\fR ?\fImountpoint\fR? ?\fIzipfile\fR? ?\fIpassword\fR?
 .
 The \fBzipfs mount\fR command mounts a ZIP archive file as a Tcl virtual
 filesystem at \fImountpoint\fR.  After this command executes, files contained
@@ -146,6 +146,8 @@ the ZIP archive, otherwise the file returned by \fBinfo nameofexecutable\fR
 (see \fBzipfs mkkey\fR) is placed between the image and ZIP chunks of the
 output file and the contents of the ZIP chunk are protected with that
 password.
+If the starting image has a ZIP archive already attached to it, it is removed
+from the copy in \fIoutfile\fR before the new ZIP archive is added.
 .PP
 If there is a file, \fBmain.tcl\fR, in the root directory of the resulting
 archive and the image file that the archive is attached to is a \fBtclsh\fR

generic/regc_lex.c

@@ -427,7 +427,7 @@ next(
 	    if (INCON(L_BBND) && NEXT1('}')) {
 		v->now++;
 		INTOCON(L_BRE);
-		RET('}');
+		RETV('}', 1);
 	    } else {
 		FAILW(REG_BADBR);
 	    }
@@ -1005,7 +1005,7 @@ brenext(
 	if (LASTTYPE(EMPTY) || LASTTYPE('(') || LASTTYPE('^')) {
 	    RETV(PLAIN, c);
 	}
-	RET('*');
+	RETV('*', 1);
 	break;
     case CHR('['):
 	if (HAVE(6) &&	*(v->now+0) == CHR('[') &&

generic/tcl.decls

@@ -860,8 +860,8 @@ declare 243 {
     void Tcl_SplitPath(const char *path, int *argcPtr, const char ***argvPtr)
 }
 declare 244 {nostub {Don't use this function in a stub-enabled extension}} {
-    void Tcl_StaticPackage(Tcl_Interp *interp, const char *pkgName,
-	    Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc)
+    void Tcl_StaticLibrary(Tcl_Interp *interp, const char *prefix,
+	    Tcl_LibraryInitProc *initProc, Tcl_LibraryInitProc *safeInitProc)
 }
 declare 245 {deprecated {No longer in use, changed to macro}} {
     int Tcl_StringMatch(const char *str, const char *pattern)
@@ -1163,7 +1163,7 @@ declare 325 {
     const char *Tcl_UtfAtIndex(const char *src, int index)
 }
 declare 326 {
-    int Tcl_UtfCharComplete(const char *src, int length)
+    int TclUtfCharComplete(const char *src, int length)
 }
 declare 327 {
     int Tcl_UtfBackslash(const char *src, int *readPtr, char *dst)
@@ -1175,10 +1175,10 @@ declare 329 {
     const char *Tcl_UtfFindLast(const char *src, int ch)
 }
 declare 330 {
-    const char *Tcl_UtfNext(const char *src)
+    const char *TclUtfNext(const char *src)
 }
 declare 331 {
-    const char *Tcl_UtfPrev(const char *src, const char *start)
+    const char *TclUtfPrev(const char *src, const char *start)
 }
 declare 332 {
     int Tcl_UtfToExternal(Tcl_Interp *interp, Tcl_Encoding encoding,
@@ -1581,8 +1581,8 @@ declare 443 {
 }
 declare 444 {
     int	Tcl_FSLoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *sym1,
-	    const char *sym2, Tcl_PackageInitProc **proc1Ptr,
-	    Tcl_PackageInitProc **proc2Ptr, Tcl_LoadHandle *handlePtr,
+	    const char *sym2, Tcl_LibraryInitProc **proc1Ptr,
+	    Tcl_LibraryInitProc **proc2Ptr, Tcl_LoadHandle *handlePtr,
 	    Tcl_FSUnloadFileProc **unloadProcPtr)
 }
 declare 445 {
@@ -1751,10 +1751,10 @@ declare 490 {
     Tcl_StatBuf *Tcl_AllocStatBuf(void)
 }
 declare 491 {
-    Tcl_WideInt Tcl_Seek(Tcl_Channel chan, Tcl_WideInt offset, int mode)
+    long long Tcl_Seek(Tcl_Channel chan, long long offset, int mode)
 }
 declare 492 {
-    Tcl_WideInt Tcl_Tell(Tcl_Channel chan)
+    long long Tcl_Tell(Tcl_Channel chan)
 }
 
 # TIP#91 (back-compat enhancements for channels) dkf
@@ -2026,7 +2026,7 @@ declare 559 {
 
 # TIP #208 ('chan' command) jeffh
 declare 560 {
-    int Tcl_TruncateChannel(Tcl_Channel chan, Tcl_WideInt length)
+    int Tcl_TruncateChannel(Tcl_Channel chan, long long length)
 }
 declare 561 {
     Tcl_DriverTruncateProc *Tcl_ChannelTruncateProc(
@@ -2177,19 +2177,19 @@ declare 595 {
     int Tcl_GetDeviceTypeFromStat(const Tcl_StatBuf *statPtr)
 }
 declare 596 {
-    Tcl_WideInt Tcl_GetAccessTimeFromStat(const Tcl_StatBuf *statPtr)
+    long long Tcl_GetAccessTimeFromStat(const Tcl_StatBuf *statPtr)
 }
 declare 597 {
-    Tcl_WideInt Tcl_GetModificationTimeFromStat(const Tcl_StatBuf *statPtr)
+    long long Tcl_GetModificationTimeFromStat(const Tcl_StatBuf *statPtr)
 }
 declare 598 {
-    Tcl_WideInt Tcl_GetChangeTimeFromStat(const Tcl_StatBuf *statPtr)
+    long long Tcl_GetChangeTimeFromStat(const Tcl_StatBuf *statPtr)
 }
 declare 599 {
-    Tcl_WideUInt Tcl_GetSizeFromStat(const Tcl_StatBuf *statPtr)
+    unsigned long long Tcl_GetSizeFromStat(const Tcl_StatBuf *statPtr)
 }
 declare 600 {
-    Tcl_WideUInt Tcl_GetBlocksFromStat(const Tcl_StatBuf *statPtr)
+    unsigned long long Tcl_GetBlocksFromStat(const Tcl_StatBuf *statPtr)
 }
 declare 601 {
     unsigned Tcl_GetBlockSizeFromStat(const Tcl_StatBuf *statPtr)
@@ -2413,6 +2413,17 @@ declare 653 {
     unsigned char *TclGetByteArrayFromObj(Tcl_Obj *objPtr, size_t *lengthPtr)
 }
 
+# TIP #575
+declare 654 {
+    int Tcl_UtfCharComplete(const char *src, int length)
+}
+declare 655 {
+    const char *Tcl_UtfNext(const char *src)
+}
+declare 656 {
+    const char *Tcl_UtfPrev(const char *src, const char *start)
+}
+
 # ----- BASELINE -- FOR -- 8.7.0 ----- #
 
 ##############################################################################
@@ -2437,6 +2448,9 @@ declare 0 win {
 declare 1 win {
     char *Tcl_WinTCharToUtf(const TCHAR *str, int len, Tcl_DString *dsPtr)
 }
+declare 3 win {
+    void Tcl_WinConvertError(unsigned errCode)
+}
 
 ################################
 # Mac OS X specific functions
@@ -2451,6 +2465,9 @@ declare 1 macosx {
 	    const char *bundleName, const char *bundleVersion,
 	    int hasResourceFile, int maxPathLen, char *libraryPath)
 }
+declare 2 macosx {
+    void Tcl_MacOSXNotifierAddRunLoopMode(const void *runLoopMode)
+}
 
 ##############################################################################
 
@@ -2464,8 +2481,8 @@ export {
     Tcl_Interp *interp)
 }
 export {
-    void Tcl_StaticPackage(Tcl_Interp *interp, const char *pkgName,
-	    Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc)
+    void Tcl_StaticLibrary(Tcl_Interp *interp, const char *prefix,
+	    Tcl_LibraryInitProc *initProc, Tcl_LibraryInitProc *safeInitProc)
 }
 export {
     void Tcl_SetPanicProc(TCL_NORETURN1 Tcl_PanicProc *panicProc)
@@ -2494,6 +2511,9 @@ export {
 export {
     void Tcl_InitSubsystems(void)
 }
+export {
+    int TclZipfs_AppHook(int *argc, char ***argv)
+}
 
 # Local Variables:
 # mode: tcl

generic/tcl.h

@@ -137,7 +137,11 @@ extern "C" {
 #    define TCL_VARARGS_START(type, name, list) (va_start(list, name), name)
 #endif /* !TCL_NO_DEPRECATED */
 #if defined(__GNUC__) && (__GNUC__ > 2)
-#   define TCL_FORMAT_PRINTF(a,b) __attribute__ ((__format__ (__printf__, a, b)))
+#   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)))
+#   else
+#	define TCL_FORMAT_PRINTF(a,b) __attribute__ ((__format__ (__printf__, a, b)))
+#   endif
 #   define TCL_NORETURN __attribute__ ((noreturn))
 #   define TCL_NOINLINE __attribute__ ((noinline))
 #   if defined(BUILD_tcl) || defined(BUILD_tk)
@@ -188,8 +192,7 @@ extern "C" {
  *       MSVCRT.
  */
 
-#if (defined(_WIN32) && (defined(_MSC_VER) || (defined(__BORLANDC__) && (__BORLANDC__ >= 0x0550)) || defined(__LCC__) || defined(__WATCOMC__) || (defined(__GNUC__) && defined(__declspec))))
-#   define HAVE_DECLSPEC 1
+#ifdef _WIN32
 #   ifdef STATIC_BUILD
 #       define DLLIMPORT
 #       define DLLEXPORT
@@ -327,17 +330,22 @@ typedef long LONG;
 
 #ifdef __APPLE__
 #   ifdef __LP64__
-#	undef TCL_WIDE_INT_TYPE
 #	define TCL_WIDE_INT_IS_LONG 1
 #	define TCL_CFG_DO64BIT 1
 #    else /* !__LP64__ */
-#	define TCL_WIDE_INT_TYPE long long
 #	undef TCL_WIDE_INT_IS_LONG
 #	undef TCL_CFG_DO64BIT
 #    endif /* __LP64__ */
 #    undef HAVE_STRUCT_STAT64
 #endif /* __APPLE__ */
 
+/* Cross-compiling 32-bit on a 64-bit platform? Then our
+ * configure script does the wrong thing. Correct that here.
+ */
+#if defined(__GNUC__) && !defined(_WIN32) && !defined(__LP64__)
+#   undef TCL_WIDE_INT_IS_LONG
+#endif
+
 /*
  * Define Tcl_WideInt to be a type that is (at least) 64-bits wide, and define
  * Tcl_WideUInt to be the unsigned variant of that type (assuming that where
@@ -353,32 +361,18 @@ typedef long LONG;
  *
  * The following invariant should hold for any long value 'longVal':
  *	longVal == Tcl_WideAsLong(Tcl_LongAsWide(longVal))
- *
- * Note on converting between Tcl_WideInt and strings. This implementation (in
- * tclObj.c) depends on the function
- * sprintf(...,"%" TCL_LL_MODIFIER "d",...).
  */
 
-#if !defined(TCL_WIDE_INT_TYPE)&&!defined(TCL_WIDE_INT_IS_LONG)
-#   if defined(_WIN32) && (!defined(__USE_MINGW_ANSI_STDIO) || !__USE_MINGW_ANSI_STDIO)
-#      define TCL_WIDE_INT_TYPE __int64
-#      define TCL_LL_MODIFIER	"I64"
-#      if defined(_WIN64)
-#         define TCL_Z_MODIFIER	"I"
-#      endif
-#   elif defined(__GNUC__)
-#      define TCL_Z_MODIFIER	"z"
-#   else /* ! _WIN32 && ! __GNUC__ */
+#if !defined(TCL_WIDE_INT_TYPE) && !defined(TCL_WIDE_INT_IS_LONG) && !defined(_WIN32) && !defined(__GNUC__)
 /*
  * Don't know what platform it is and configure hasn't discovered what is
  * going on for us. Try to guess...
  */
-#      include <limits.h>
-#      if defined(LLONG_MAX) && (LLONG_MAX == LONG_MAX)
-#         define TCL_WIDE_INT_IS_LONG	1
-#      endif
-#   endif /* _WIN32 */
-#endif /* !TCL_WIDE_INT_TYPE & !TCL_WIDE_INT_IS_LONG */
+#   include <limits.h>
+#   if defined(LLONG_MAX) && (LLONG_MAX == LONG_MAX)
+#	define TCL_WIDE_INT_IS_LONG	1
+#   endif
+#endif
 
 #ifndef TCL_WIDE_INT_TYPE
 #   define TCL_WIDE_INT_TYPE		long long
@@ -388,11 +382,17 @@ typedef TCL_WIDE_INT_TYPE		Tcl_WideInt;
 typedef unsigned TCL_WIDE_INT_TYPE	Tcl_WideUInt;
 
 #ifndef TCL_LL_MODIFIER
-#   define TCL_LL_MODIFIER	"ll"
+#   if defined(_WIN32) && (!defined(__USE_MINGW_ANSI_STDIO) || !__USE_MINGW_ANSI_STDIO)
+#	define TCL_LL_MODIFIER	"I64"
+#   else
+#	define TCL_LL_MODIFIER	"ll"
+#   endif
 #endif /* !TCL_LL_MODIFIER */
 #ifndef TCL_Z_MODIFIER
 #   if defined(__GNUC__) && !defined(_WIN32)
 #	define TCL_Z_MODIFIER	"z"
+#   elif defined(_WIN64)
+#	define TCL_Z_MODIFIER	TCL_LL_MODIFIER
 #   else
 #	define TCL_Z_MODIFIER	""
 #   endif
@@ -402,10 +402,8 @@ typedef unsigned TCL_WIDE_INT_TYPE	Tcl_WideUInt;
 #define Tcl_WideAsDouble(val)	((double)((Tcl_WideInt)(val)))
 #define Tcl_DoubleAsWide(val)	((Tcl_WideInt)((double)(val)))
 
-#if defined(_WIN32)
-#   ifdef __BORLANDC__
-	typedef struct stati64 Tcl_StatBuf;
-#   elif defined(_WIN64) || defined(_USE_64BIT_TIME_T)
+#ifdef _WIN32
+#   if defined(_WIN64) || defined(_USE_64BIT_TIME_T)
 	typedef struct __stat64 Tcl_StatBuf;
 #   elif (defined(_MSC_VER) && (_MSC_VER < 1400)) || defined(_USE_32BIT_TIME_T)
 	typedef struct _stati64	Tcl_StatBuf;
@@ -699,8 +697,8 @@ typedef int (Tcl_MathProc) (ClientData clientData, Tcl_Interp *interp,
 typedef void (Tcl_NamespaceDeleteProc) (ClientData clientData);
 typedef int (Tcl_ObjCmdProc) (ClientData clientData, Tcl_Interp *interp,
 	int objc, struct Tcl_Obj *const *objv);
-typedef int (Tcl_PackageInitProc) (Tcl_Interp *interp);
-typedef int (Tcl_PackageUnloadProc) (Tcl_Interp *interp, int flags);
+typedef int (Tcl_LibraryInitProc) (Tcl_Interp *interp);
+typedef int (Tcl_LibraryUnloadProc) (Tcl_Interp *interp, int flags);
 typedef void (Tcl_PanicProc) (const char *format, ...);
 typedef void (Tcl_TcpAcceptProc) (ClientData callbackData, Tcl_Channel chan,
 	char *address, int port);
@@ -719,7 +717,12 @@ typedef void (Tcl_ServiceModeHookProc) (int mode);
 typedef ClientData (Tcl_InitNotifierProc) (void);
 typedef void (Tcl_FinalizeNotifierProc) (ClientData clientData);
 typedef void (Tcl_MainLoopProc) (void);
-
+
+#ifndef TCL_NO_DEPRECATED
+#   define Tcl_PackageInitProc Tcl_LibraryInitProc
+#   define Tcl_PackageUnloadProc Tcl_LibraryUnloadProc
+#endif
+
 /*
  *----------------------------------------------------------------------------
  * The following structure represents a type of object, which is a particular
@@ -956,7 +959,7 @@ typedef struct Tcl_DString {
  * 64-bit integers).
  */
 
-#define TCL_INTEGER_SPACE	24
+#define TCL_INTEGER_SPACE	(3*(int)sizeof(Tcl_WideInt))
 
 /*
  * Flag values passed to Tcl_ConvertElement.
@@ -1444,8 +1447,8 @@ typedef int	(Tcl_DriverGetHandleProc) (ClientData instanceData,
 typedef int	(Tcl_DriverFlushProc) (ClientData instanceData);
 typedef int	(Tcl_DriverHandlerProc) (ClientData instanceData,
 			int interestMask);
-typedef Tcl_WideInt (Tcl_DriverWideSeekProc) (ClientData instanceData,
-			Tcl_WideInt offset, int mode, int *errorCodePtr);
+typedef long long (Tcl_DriverWideSeekProc) (ClientData instanceData,
+			long long offset, int mode, int *errorCodePtr);
 /*
  * TIP #218, Channel Thread Actions
  */
@@ -1454,8 +1457,8 @@ typedef void	(Tcl_DriverThreadActionProc) (ClientData instanceData,
 /*
  * TIP #208, File Truncation (etc.)
  */
-typedef int	(Tcl_DriverTruncateProc) (ClientData instanceData,
-			Tcl_WideInt length);
+typedef int	(Tcl_DriverTruncateProc) (void *instanceData,
+			long long length);
 
 /*
  * struct Tcl_ChannelType:
@@ -2382,6 +2385,9 @@ EXTERN const char *	Tcl_PkgInitStubsCheck(Tcl_Interp *interp,
 			    const char *version, int exact);
 EXTERN void		Tcl_InitSubsystems(void);
 EXTERN void		Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
+#ifndef TCL_NO_DEPRECATED
+#   define Tcl_StaticPackage Tcl_StaticLibrary
+#endif
 #ifdef _WIN32
 EXTERN int		TclZipfs_AppHook(int *argc, wchar_t ***argv);
 #else

generic/tclAlloc.c

@@ -31,7 +31,7 @@
  * until Tcl uses config.h properly.
  */
 
-#if defined(_MSC_VER) || defined(__MSVCRT__) || defined(__BORLANDC__)
+#if defined(_MSC_VER) || defined(__MSVCRT__)
 typedef size_t caddr_t;
 #endif
 
@@ -94,7 +94,7 @@ union overhead {
 
 #define MINBLOCK	((sizeof(union overhead) + (TCL_ALLOCALIGN-1)) & ~(TCL_ALLOCALIGN-1))
 #define NBUCKETS	(13 - (MINBLOCK >> 4))
-#define MAXMALLOC	(1<<(NBUCKETS+2))
+#define MAXMALLOC	((size_t)1 << (NBUCKETS+2))
 static union overhead *nextf[NBUCKETS];
 
 /*
@@ -583,7 +583,7 @@ TclpRealloc(
 	Tcl_MutexUnlock(allocMutexPtr);
 	return (void *)(overPtr+1);
     }
-    maxSize = 1 << (i+3);
+    maxSize = (size_t)1 << (i+3);
     expensive = 0;
     if (numBytes+OVERHEAD > maxSize) {
 	expensive = 1;
@@ -656,18 +656,18 @@ mstats(
 	for (j=0, overPtr=nextf[i]; overPtr; overPtr=overPtr->next, j++) {
 	    fprintf(stderr, " %u", j);
 	}
-	totalFree += ((size_t)j) * (1 << (i + 3));
+	totalFree += ((size_t)j) * ((size_t)1 << (i + 3));
     }
 
     fprintf(stderr, "\nused:\t");
     for (i = 0; i < NBUCKETS; i++) {
 	fprintf(stderr, " %" TCL_Z_MODIFIER "u", numMallocs[i]);
-	totalUsed += numMallocs[i] * (1 << (i + 3));
+	totalUsed += numMallocs[i] * ((size_t)1 << (i + 3));
     }
 
     fprintf(stderr, "\n\tTotal small in use: %" TCL_Z_MODIFIER "u, total free: %" TCL_Z_MODIFIER "u\n",
 	totalUsed, totalFree);
-    fprintf(stderr, "\n\tNumber of big (>%d) blocks in use: %" TCL_Z_MODIFIER "u\n",
+    fprintf(stderr, "\n\tNumber of big (>%" TCL_Z_MODIFIER "u) blocks in use: %" TCL_Z_MODIFIER "u\n",
 	    MAXMALLOC, numMallocs[NBUCKETS]);
 
     Tcl_MutexUnlock(allocMutexPtr);
@@ -748,6 +748,8 @@ TclpRealloc(
 }
 
 #endif /* !USE_TCLALLOC */
+#else
+TCL_MAC_EMPTY_FILE(generic_tclAlloc_c)
 #endif /* !TCL_THREADS */
 
 /*

generic/tclBasic.c

@@ -774,6 +774,10 @@ Tcl_CreateInterp(void)
     Tcl_InitHashTable(&iPtr->packageTable, TCL_STRING_KEYS);
     iPtr->packageUnknown = NULL;
 
+#ifdef _WIN32
+#   define getenv(x) _wgetenv(L##x) /* On Windows, use _wgetenv below */
+#endif
+
     /* TIP #268 */
 #if (TCL_RELEASE_LEVEL == TCL_FINAL_RELEASE)
     if (getenv("TCL_PKG_PREFER_LATEST") == NULL) {
@@ -3509,6 +3513,8 @@ Tcl_DeleteCommandFromToken(
 
     if (cmdPtr->tracePtr != NULL) {
 	CommandTrace *tracePtr;
+	/* Note that CallCommandTraces() never frees cmdPtr, that's
+	 * done just before Tcl_DeleteCommandFromToken() returns  */
 	CallCommandTraces(iPtr,cmdPtr,NULL,NULL,TCL_TRACE_DELETE);
 
 	/*
@@ -3678,7 +3684,6 @@ CallCommandTraces(
 	}
     }
     cmdPtr->flags |= CMD_TRACE_ACTIVE;
-    cmdPtr->refCount++;
 
     result = NULL;
     active.nextPtr = iPtr->activeCmdTracePtr;
@@ -3736,7 +3741,6 @@ CallCommandTraces(
      */
 
     cmdPtr->flags &= ~CMD_TRACE_ACTIVE;
-    cmdPtr->refCount--;
     iPtr->activeCmdTracePtr = active.nextPtr;
     Tcl_Release(iPtr);
     return result;
@@ -7906,7 +7910,16 @@ ExprAbsFunc(
 	    }
 	    goto unChanged;
 	} else if (l == WIDE_MIN) {
-	    if (mp_init_i64(&big, l) != MP_OKAY) {
+	    if (sizeof(Tcl_WideInt) > sizeof(int64_t)) {
+		Tcl_WideUInt ul = -(Tcl_WideUInt)WIDE_MIN;
+		if (mp_init(&big) != MP_OKAY || mp_unpack(&big, 1, 1,
+			sizeof(Tcl_WideInt), 0, 0, &ul) != MP_OKAY) {
+		    return TCL_ERROR;
+		}
+		if (mp_neg(&big, &big) != MP_OKAY) {
+		    return TCL_ERROR;
+		}
+	    } else if (mp_init_i64(&big, l) != MP_OKAY) {
 		return TCL_ERROR;
 	    }
 	    goto tooLarge;

generic/tclBinary.c

@@ -274,16 +274,19 @@ typedef struct ByteArray {
 				 * array. */
     unsigned int allocated;	/* The amount of space actually allocated
 				 * minus 1 byte. */
-    unsigned char bytes[TCLFLEXARRAY];	/* The array of bytes. The actual size of this
+    unsigned char bytes[TCLFLEXARRAY];
+				/* The array of bytes. The actual size of this
 				 * field depends on the 'allocated' field
 				 * above. */
 } ByteArray;
 
 #define BYTEARRAY_SIZE(len) \
-		(offsetof(ByteArray, bytes) + (len))
+    (offsetof(ByteArray, bytes) + (len))
 #define GET_BYTEARRAY(irPtr) ((ByteArray *) (irPtr)->twoPtrValue.ptr1)
 #define SET_BYTEARRAY(irPtr, baPtr) \
-		(irPtr)->twoPtrValue.ptr1 = (void *) (baPtr)
+    do {						\
+	(irPtr)->twoPtrValue.ptr1 = (void *) (baPtr);	\
+    } while (0)
 
 int
 TclIsPureByteArray(

generic/tclClock.c

@@ -1650,19 +1650,37 @@ ClockGetenvObjCmd(
     int objc,
     Tcl_Obj *const objv[])
 {
+#ifdef _WIN32
+    const WCHAR *varName;
+    const WCHAR *varValue;
+    Tcl_DString ds;
+#else
     const char *varName;
     const char *varValue;
+#endif
 
     if (objc != 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "name");
 	return TCL_ERROR;
     }
+#ifdef _WIN32
+    Tcl_DStringInit(&ds);
+    varName = Tcl_UtfToWCharDString(TclGetString(objv[1]), -1, &ds);
+    varValue = _wgetenv(varName);
+    if (varValue == NULL) {
+	Tcl_DStringFree(&ds);
+    } else {
+	Tcl_DStringSetLength(&ds, 0);
+	Tcl_WCharToUtfDString(varValue, -1, &ds);
+	Tcl_DStringResult(interp, &ds);
+    }
+#else
     varName = TclGetString(objv[1]);
     varValue = getenv(varName);
-    if (varValue == NULL) {
-	varValue = "";
+    if (varValue != NULL) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(varValue, -1));
     }
-    Tcl_SetObjResult(interp, Tcl_NewStringObj(varValue, -1));
+#endif
     return TCL_OK;
 }
 
@@ -2021,26 +2039,52 @@ ClockSecondsObjCmd(
  *----------------------------------------------------------------------
  */
 
+#ifdef _WIN32
+#define getenv(x) _wgetenv(L##x)
+#else
+#define WCHAR char
+#define wcslen strlen
+#define wcscmp strcmp
+#define wcscpy strcpy
+#endif
+
 static void
 TzsetIfNecessary(void)
 {
-    static char* tzWas = (char *)INT2PTR(-1);	/* Previous value of TZ, protected by
-				 * clockMutex. */
-    const char *tzIsNow;	/* Current value of TZ */
+    static WCHAR* tzWas = (WCHAR *)INT2PTR(-1);	 /* Previous value of TZ, protected by
+					  * clockMutex. */
+    static long	 tzLastRefresh = 0;	 /* Used for latency before next refresh */
+    static size_t tzEnvEpoch = 0;        /* Last env epoch, for faster signaling,
+					    that TZ changed via TCL */
+    const WCHAR *tzIsNow;		 /* Current value of TZ */
+
+    /*
+     * Prevent performance regression on some platforms by resolving of system time zone:
+     * small latency for check whether environment was changed (once per second)
+     * no latency if environment was changed with tcl-env (compare both epoch values)
+     */
+    Tcl_Time now;
+    Tcl_GetTime(&now);
+    if (now.sec == tzLastRefresh && tzEnvEpoch == TclEnvEpoch) {
+	return;
+    }
+
+    tzEnvEpoch = TclEnvEpoch;
+    tzLastRefresh = now.sec;
 
     Tcl_MutexLock(&clockMutex);
     tzIsNow = getenv("TZ");
-    if (tzIsNow != NULL && (tzWas == NULL || tzWas == INT2PTR(-1)
-	    || strcmp(tzIsNow, tzWas) != 0)) {
+    if (tzIsNow != NULL && (tzWas == NULL || tzWas == (WCHAR *)INT2PTR(-1)
+	    || wcscmp(tzIsNow, tzWas) != 0)) {
 	tzset();
-	if (tzWas != NULL && tzWas != INT2PTR(-1)) {
+	if (tzWas != NULL && tzWas != (WCHAR *)INT2PTR(-1)) {
 	    ckfree(tzWas);
 	}
-	tzWas = (char *)ckalloc(strlen(tzIsNow) + 1);
-	strcpy(tzWas, tzIsNow);
+	tzWas = (WCHAR *)ckalloc(sizeof(WCHAR) * (wcslen(tzIsNow) + 1));
+	wcscpy(tzWas, tzIsNow);
     } else if (tzIsNow == NULL && tzWas != NULL) {
 	tzset();
-	if (tzWas != INT2PTR(-1)) ckfree(tzWas);
+	if (tzWas != (WCHAR *)INT2PTR(-1)) ckfree(tzWas);
 	tzWas = NULL;
     }
     Tcl_MutexUnlock(&clockMutex);

generic/tclCmdIL.c

@@ -86,12 +86,14 @@ typedef struct {
  * following values.
  */
 
-#define SORTMODE_ASCII		0
-#define SORTMODE_INTEGER	1
-#define SORTMODE_REAL		2
-#define SORTMODE_COMMAND	3
-#define SORTMODE_DICTIONARY	4
-#define SORTMODE_ASCII_NC	8
+enum {
+    SORTMODE_ASCII = 0,
+    SORTMODE_INTEGER = 1,
+    SORTMODE_REAL = 2,
+    SORTMODE_COMMAND = 3,
+    SORTMODE_DICTIONARY = 4,
+    SORTMODE_ASCII_NC = 8
+};
 
 /*
  * Forward declarations for procedures defined in this file:
@@ -1700,7 +1702,7 @@ InfoLoadedCmd(
     } else {			/* Get pkgs just in specified interp. */
 	packageName = TclGetString(objv[2]);
     }
-    return TclGetLoadedPackagesEx(interp, interpName, packageName);
+    return TclGetLoadedLibraries(interp, interpName, packageName);
 }
 
 /*

generic/tclCmdMZ.c

@@ -4148,14 +4148,14 @@ Tcl_TimeRateObjCmd(
     Tcl_Obj *objPtr;
     int result, i;
     Tcl_Obj *calibrate = NULL, *direct = NULL;
-    TclWideMUInt count = 0;	/* Holds repetition count */
+    Tcl_WideUInt count = 0;	/* Holds repetition count */
     Tcl_WideInt maxms = WIDE_MIN;
 				/* Maximal running time (in milliseconds) */
-    TclWideMUInt maxcnt = WIDE_MAX;
+    Tcl_WideUInt maxcnt = WIDE_MAX;
 				/* Maximal count of iterations. */
-    TclWideMUInt threshold = 1;	/* Current threshold for check time (faster
+    Tcl_WideUInt threshold = 1;	/* Current threshold for check time (faster
 				 * repeat count without time check) */
-    TclWideMUInt maxIterTm = 1;	/* Max time of some iteration as max
+    Tcl_WideUInt maxIterTm = 1;	/* Max time of some iteration as max
 				 * threshold, additionally avoiding divide to
 				 * zero (i.e., never < 1) */
     unsigned short factor = 50;	/* Factor (4..50) limiting threshold to avoid
@@ -4529,13 +4529,13 @@ Tcl_TimeRateObjCmd(
 
     {
 	Tcl_Obj *objarr[8], **objs = objarr;
-	TclWideMUInt usec, val;
+	Tcl_WideUInt usec, val;
 	int digits;
 
 	/*
 	 * Absolute execution time in microseconds or in wide clicks.
 	 */
-	usec = (TclWideMUInt)(middle - start);
+	usec = (Tcl_WideUInt)(middle - start);
 
 #ifdef TCL_WIDE_CLICKS
 	/*
@@ -4565,7 +4565,7 @@ Tcl_TimeRateObjCmd(
 		 * Estimate the time of overhead (microsecs).
 		 */
 
-		TclWideMUInt curOverhead = overhead * count;
+		Tcl_WideUInt curOverhead = overhead * count;
 
 		if (usec > curOverhead) {
 		    usec -= curOverhead;

generic/tclCompCmdsGR.c

@@ -27,6 +27,31 @@ static void		CompileReturnInternal(CompileEnv *envPtr,
 			    Tcl_Obj *returnOpts);
 static int		IndexTailVarIfKnown(Tcl_Interp *interp,
 			    Tcl_Token *varTokenPtr, CompileEnv *envPtr);
+
+/*
+ * Shorthand macros for instruction issuing.
+ */
+
+#define OP(name)	TclEmitOpcode(INST_##name, envPtr)
+#define OP1(name,val)	TclEmitInstInt1(INST_##name,(val),envPtr)
+#define OP4(name,val)	TclEmitInstInt4(INST_##name,(val),envPtr)
+#define OP11(name,val1,val2) TclEmitInstInt11(INST_##name,(val1),(val2),envPtr)
+#define OP14(name,val1,val2) TclEmitInstInt14(INST_##name,(val1),(val2),envPtr)
+#define OP44(name,val1,val2) TclEmitInstInt44(INST_##name,(val1),(val2),envPtr)
+#define PUSH(str)	PushStringLiteral(envPtr, str)
+#define JUMP4(name,var) \
+    (var) = CurrentOffset(envPtr);TclEmitInstInt4(INST_##name##4,0,envPtr)
+#define FIXJUMP4(var) \
+    TclStoreInt4AtPtr(CurrentOffset(envPtr)-(var),envPtr->codeStart+(var)+1)
+#define JUMP1(name,var) \
+    (var) = CurrentOffset(envPtr);TclEmitInstInt1(INST_##name##1,0,envPtr)
+#define FIXJUMP1(var) \
+    TclStoreInt1AtPtr(CurrentOffset(envPtr)-(var),envPtr->codeStart+(var)+1)
+#define LOAD(idx) \
+    if ((idx)<256) {OP1(LOAD_SCALAR1,(idx));} else {OP4(LOAD_SCALAR4,(idx));}
+#define STORE(idx) \
+    if ((idx)<256) {OP1(STORE_SCALAR1,(idx));} else {OP4(STORE_SCALAR4,(idx));}
+#define INVOKE(name)	TclEmitInvoke(envPtr,INST_##name)
 
 /*
  *----------------------------------------------------------------------
@@ -112,7 +137,7 @@ TclCompileGlobalCmd(
      * Push the namespace
      */
 
-    PushStringLiteral(envPtr, "::");
+    PUSH(		"::");
 
     /*
      * Loop over the variables.
@@ -133,15 +158,15 @@ TclCompileGlobalCmd(
 	 */
 
 	CompileWord(envPtr, varTokenPtr, interp, i);
-	TclEmitInstInt4(	INST_NSUPVAR, localIndex,	envPtr);
+	OP4(		NSUPVAR, localIndex);
     }
 
     /*
      * Pop the namespace, and set the result to empty
      */
 
-    TclEmitOpcode(		INST_POP,			envPtr);
-    PushStringLiteral(envPtr, "");
+    OP(			POP);
+    PUSH(		"");
     return TCL_OK;
 }
 
@@ -163,6 +188,30 @@ TclCompileGlobalCmd(
  *----------------------------------------------------------------------
  */
 
+static inline int
+IsElseToken(
+    const Tcl_Token *tokenPtr)
+{
+    return (tokenPtr->size == 4) &&
+	    (strncmp(tokenPtr->start, "else", 4) == 0);
+}
+
+static inline int
+IsElseifToken(
+    const Tcl_Token *tokenPtr)
+{
+    return (tokenPtr->size == 6) &&
+	    (strncmp(tokenPtr->start, "elseif", 6) == 0);
+}
+
+static inline int
+IsThenToken(
+    const Tcl_Token *tokenPtr)
+{
+    return (tokenPtr->size == 4) &&
+	    (strncmp(tokenPtr->start, "then", 4) == 0);
+}
+
 int
 TclCompileIfCmd(
     Tcl_Interp *interp,		/* Used for error reporting. */
@@ -181,8 +230,7 @@ TclCompileIfCmd(
 				 * determined. */
     Tcl_Token *tokenPtr, *testTokenPtr;
     int jumpIndex = 0;		/* Avoid compiler warning. */
-    int jumpFalseDist, numWords, wordIdx, numBytes, j, code;
-    const char *word;
+    int jumpFalseDist, numWords, wordIdx, j, code;
     int realCond = 1;		/* Set to 0 for static conditions:
 				 * "if 0 {..}" */
     int boolVal;		/* Value of static condition. */
@@ -220,10 +268,7 @@ TclCompileIfCmd(
 	 * Stop looping if the token isn't "if" or "elseif".
 	 */
 
-	word = tokenPtr[1].start;
-	numBytes = tokenPtr[1].size;
-	if ((tokenPtr == parsePtr->tokenPtr)
-		|| ((numBytes == 6) && (strncmp(word, "elseif", 6) == 0))) {
+	if ((tokenPtr == parsePtr->tokenPtr) || IsElseifToken(&tokenPtr[1])) {
 	    tokenPtr = TokenAfter(tokenPtr);
 	    wordIdx++;
 	} else {
@@ -286,16 +331,12 @@ TclCompileIfCmd(
 	    code = TCL_ERROR;
 	    goto done;
 	}
-	if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
-	    word = tokenPtr[1].start;
-	    numBytes = tokenPtr[1].size;
-	    if ((numBytes == 4) && (strncmp(word, "then", 4) == 0)) {
-		tokenPtr = TokenAfter(tokenPtr);
-		wordIdx++;
-		if (wordIdx >= numWords) {
-		    code = TCL_ERROR;
-		    goto done;
-		}
+	if (IsThenToken(&tokenPtr[1])) {
+	    tokenPtr = TokenAfter(tokenPtr);
+	    wordIdx++;
+	    if (wordIdx >= numWords) {
+		code = TCL_ERROR;
+		goto done;
 	    }
 	}
 
@@ -363,14 +404,12 @@ TclCompileIfCmd(
      * an "if 1 {...}" case.
      */
 
-    if ((wordIdx < numWords) && (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD)) {
+    if (wordIdx < numWords) {
 	/*
 	 * There is an else clause. Skip over the optional "else" word.
 	 */
 
-	word = tokenPtr[1].start;
-	numBytes = tokenPtr[1].size;
-	if ((numBytes == 4) && (strncmp(word, "else", 4) == 0)) {
+	if (IsElseToken(&tokenPtr[1])) {
 	    tokenPtr = TokenAfter(tokenPtr);
 	    wordIdx++;
 	    if (wordIdx >= numWords) {
@@ -402,7 +441,7 @@ TclCompileIfCmd(
 	 */
 
 	if (compileScripts) {
-	    PushStringLiteral(envPtr, "");
+	    PUSH("");
 	}
     }
 
@@ -525,31 +564,29 @@ TclCompileIncrCmd(
     if (isScalar) {	/* Simple scalar variable. */
 	if (localIndex >= 0) {
 	    if (haveImmValue) {
-		TclEmitInstInt1(INST_INCR_SCALAR1_IMM, localIndex, envPtr);
-		TclEmitInt1(immValue, envPtr);
+		OP11(	INCR_SCALAR1_IMM, localIndex, immValue);
 	    } else {
-		TclEmitInstInt1(INST_INCR_SCALAR1, localIndex,	envPtr);
+		OP1(	INCR_SCALAR1, localIndex);
 	    }
 	} else {
 	    if (haveImmValue) {
-		TclEmitInstInt1(INST_INCR_STK_IMM, immValue, envPtr);
+		OP1(	INCR_STK_IMM, immValue);
 	    } else {
-		TclEmitOpcode(	INST_INCR_STK,		envPtr);
+		OP(	INCR_STK);
 	    }
 	}
     } else {			/* Simple array variable. */
 	if (localIndex >= 0) {
 	    if (haveImmValue) {
-		TclEmitInstInt1(INST_INCR_ARRAY1_IMM, localIndex, envPtr);
-		TclEmitInt1(immValue, envPtr);
+		OP11(	INCR_ARRAY1_IMM, localIndex, immValue);
 	    } else {
-		TclEmitInstInt1(INST_INCR_ARRAY1, localIndex,	envPtr);
+		OP1(	INCR_ARRAY1, localIndex);
 	    }
 	} else {
 	    if (haveImmValue) {
-		TclEmitInstInt1(INST_INCR_ARRAY_STK_IMM, immValue, envPtr);
+		OP1(	INCR_ARRAY_STK_IMM, immValue);
 	    } else {
-		TclEmitOpcode(	INST_INCR_ARRAY_STK,		envPtr);
+		OP(	INCR_ARRAY_STK);
 	    }
 	}
     }
@@ -624,11 +661,11 @@ TclCompileInfoCommandsCmd(
 
     /* TODO: Just push the known value */
     CompileWord(envPtr, tokenPtr,		interp, 1);
-    TclEmitOpcode(	INST_RESOLVE_COMMAND,	envPtr);
-    TclEmitOpcode(	INST_DUP,		envPtr);
-    TclEmitOpcode(	INST_STR_LEN,		envPtr);
-    TclEmitInstInt1(	INST_JUMP_FALSE1, 7,	envPtr);
-    TclEmitInstInt4(	INST_LIST, 1,		envPtr);
+    OP(		RESOLVE_COMMAND);
+    OP(		DUP);
+    OP(		STR_LEN);
+    OP1(	JUMP_FALSE1, 7);
+    OP4(	LIST, 1);
     return TCL_OK;
 
   notCompilable:
@@ -656,7 +693,7 @@ TclCompileInfoCoroutineCmd(
      * Not much to do; we compile to a single instruction...
      */
 
-    TclEmitOpcode(		INST_COROUTINE_NAME,		envPtr);
+    OP(		COROUTINE_NAME);
     return TCL_OK;
 }
 
@@ -693,15 +730,15 @@ TclCompileInfoExistsCmd(
 
     if (isScalar) {
 	if (localIndex < 0) {
-	    TclEmitOpcode(	INST_EXIST_STK,			envPtr);
+	    OP(		EXIST_STK);
 	} else {
-	    TclEmitInstInt4(	INST_EXIST_SCALAR, localIndex,	envPtr);
+	    OP4(	EXIST_SCALAR, localIndex);
 	}
     } else {
 	if (localIndex < 0) {
-	    TclEmitOpcode(	INST_EXIST_ARRAY_STK,		envPtr);
+	    OP(		EXIST_ARRAY_STK);
 	} else {
-	    TclEmitInstInt4(	INST_EXIST_ARRAY, localIndex,	envPtr);
+	    OP4(	EXIST_ARRAY, localIndex);
 	}
     }
 
@@ -725,7 +762,7 @@ TclCompileInfoLevelCmd(
 	 * Not much to do; we compile to a single instruction...
 	 */
 
-	TclEmitOpcode(		INST_INFO_LEVEL_NUM,		envPtr);
+	OP(		INFO_LEVEL_NUM);
     } else if (parsePtr->numWords != 2) {
 	return TCL_ERROR;
     } else {
@@ -737,7 +774,7 @@ TclCompileInfoLevelCmd(
 	 */
 
 	CompileWord(envPtr, TokenAfter(parsePtr->tokenPtr), interp, 1);
-	TclEmitOpcode(		INST_INFO_LEVEL_ARGS,		envPtr);
+	OP(		INFO_LEVEL_ARGS);
     }
     return TCL_OK;
 }
@@ -757,7 +794,7 @@ TclCompileInfoObjectClassCmd(
 	return TCL_ERROR;
     }
     CompileWord(envPtr,		tokenPtr,		interp, 1);
-    TclEmitOpcode(		INST_TCLOO_CLASS,	envPtr);
+    OP(			TCLOO_CLASS);
     return TCL_OK;
 }
 
@@ -792,7 +829,7 @@ TclCompileInfoObjectIsACmd(
      */
 
     CompileWord(envPtr,		tokenPtr,		interp, 2);
-    TclEmitOpcode(		INST_TCLOO_IS_OBJECT,	envPtr);
+    OP(			TCLOO_IS_OBJECT);
     return TCL_OK;
 }
 
@@ -811,7 +848,7 @@ TclCompileInfoObjectNamespaceCmd(
 	return TCL_ERROR;
     }
     CompileWord(envPtr,		tokenPtr,		interp, 1);
-    TclEmitOpcode(		INST_TCLOO_NS,		envPtr);
+    OP(			TCLOO_NS);
     return TCL_OK;
 }
 
@@ -890,15 +927,15 @@ TclCompileLappendCmd(
 
     if (isScalar) {
 	if (localIndex < 0) {
-	    TclEmitOpcode(	INST_LAPPEND_STK,		envPtr);
+	    OP(		LAPPEND_STK);
 	} else {
-	    Emit14Inst(		INST_LAPPEND_SCALAR, localIndex, envPtr);
+	    Emit14Inst(	INST_LAPPEND_SCALAR, localIndex, envPtr);
 	}
     } else {
 	if (localIndex < 0) {
-	    TclEmitOpcode(	INST_LAPPEND_ARRAY_STK,		envPtr);
+	    OP(		LAPPEND_ARRAY_STK);
 	} else {
-	    Emit14Inst(		INST_LAPPEND_ARRAY, localIndex,	envPtr);
+	    Emit14Inst(	INST_LAPPEND_ARRAY, localIndex,	envPtr);
 	}
     }
 
@@ -913,18 +950,18 @@ TclCompileLappendCmd(
 	CompileWord(envPtr, valueTokenPtr, interp, i);
 	valueTokenPtr = TokenAfter(valueTokenPtr);
     }
-    TclEmitInstInt4(	    INST_LIST, numWords - 2,		envPtr);
+    OP4(		LIST, numWords - 2);
     if (isScalar) {
 	if (localIndex < 0) {
-	    TclEmitOpcode(  INST_LAPPEND_LIST_STK,		envPtr);
+	    OP(		LAPPEND_LIST_STK);
 	} else {
-	    TclEmitInstInt4(INST_LAPPEND_LIST, localIndex,	envPtr);
+	    OP4(	LAPPEND_LIST, localIndex);
 	}
     } else {
 	if (localIndex < 0) {
-	    TclEmitOpcode(  INST_LAPPEND_LIST_ARRAY_STK,	envPtr);
+	    OP(		LAPPEND_LIST_ARRAY_STK);
 	} else {
-	    TclEmitInstInt4(INST_LAPPEND_LIST_ARRAY, localIndex,envPtr);
+	    OP4(	LAPPEND_LIST_ARRAY, localIndex);
 	}
     }
     return TCL_OK;
@@ -998,27 +1035,27 @@ TclCompileLassignCmd(
 
 	if (isScalar) {
 	    if (localIndex >= 0) {
-		TclEmitOpcode(	INST_DUP,			envPtr);
-		TclEmitInstInt4(INST_LIST_INDEX_IMM, idx,	envPtr);
+		OP(		DUP);
+		OP4(		LIST_INDEX_IMM, idx);
 		Emit14Inst(	INST_STORE_SCALAR, localIndex,	envPtr);
-		TclEmitOpcode(	INST_POP,			envPtr);
+		OP(		POP);
 	    } else {
-		TclEmitInstInt4(INST_OVER, 1,			envPtr);
-		TclEmitInstInt4(INST_LIST_INDEX_IMM, idx,	envPtr);
-		TclEmitOpcode(	INST_STORE_STK,			envPtr);
-		TclEmitOpcode(	INST_POP,			envPtr);
+		OP4(		OVER, 1);
+		OP4(		LIST_INDEX_IMM, idx);
+		OP(		STORE_STK);
+		OP(		POP);
 	    }
 	} else {
 	    if (localIndex >= 0) {
-		TclEmitInstInt4(INST_OVER, 1,			envPtr);
-		TclEmitInstInt4(INST_LIST_INDEX_IMM, idx,	envPtr);
+		OP4(		OVER, 1);
+		OP4(		LIST_INDEX_IMM, idx);
 		Emit14Inst(	INST_STORE_ARRAY, localIndex,	envPtr);
-		TclEmitOpcode(	INST_POP,			envPtr);
+		OP(		POP);
 	    } else {
-		TclEmitInstInt4(INST_OVER, 2,			envPtr);
-		TclEmitInstInt4(INST_LIST_INDEX_IMM, idx,	envPtr);
-		TclEmitOpcode(	INST_STORE_ARRAY_STK,		envPtr);
-		TclEmitOpcode(	INST_POP,			envPtr);
+		OP4(		OVER, 2);
+		OP4(		LIST_INDEX_IMM, idx);
+		OP(		STORE_ARRAY_STK);
+		OP(		POP);
 	    }
 	}
     }
@@ -1027,8 +1064,7 @@ TclCompileLassignCmd(
      * Generate code to leave the rest of the list on the stack.
      */
 
-    TclEmitInstInt4(		INST_LIST_RANGE_IMM, idx,	envPtr);
-    TclEmitInt4(			(int)TCL_INDEX_END,		envPtr);
+    OP44(			LIST_RANGE_IMM, idx, (int) TCL_INDEX_END);
 
     return TCL_OK;
 }
@@ -1089,7 +1125,7 @@ TclCompileLindexCmd(
 	 */
 
 	CompileWord(envPtr, valTokenPtr, interp, 1);
-	TclEmitInstInt4(	INST_LIST_INDEX_IMM, idx,	envPtr);
+	OP4(			LIST_INDEX_IMM, idx);
 	return TCL_OK;
     }
 
@@ -1115,9 +1151,9 @@ TclCompileLindexCmd(
      */
 
     if (numWords == 3) {
-	TclEmitOpcode(		INST_LIST_INDEX,		envPtr);
+	OP(			LIST_INDEX);
     } else {
-	TclEmitInstInt4(	INST_LIST_INDEX_MULTI, numWords-1, envPtr);
+	OP4(			LIST_INDEX_MULTI, numWords - 1);
     }
 
     return TCL_OK;
@@ -1159,7 +1195,7 @@ TclCompileListCmd(
 	 * [list] without arguments just pushes an empty object.
 	 */
 
-	PushStringLiteral(envPtr, "");
+	PUSH("");
 	return TCL_OK;
     }
 
@@ -1196,9 +1232,9 @@ TclCompileListCmd(
     concat = build = 0;
     for (i = 1; i < numWords; i++) {
 	if (valueTokenPtr->type == TCL_TOKEN_EXPAND_WORD && build > 0) {
-	    TclEmitInstInt4(	INST_LIST, build,	envPtr);
+	    OP4(	LIST, build);
 	    if (concat) {
-		TclEmitOpcode(	INST_LIST_CONCAT,	envPtr);
+		OP(	LIST_CONCAT);
 	    }
 	    build = 0;
 	    concat = 1;
@@ -1206,7 +1242,7 @@ TclCompileListCmd(
 	CompileWord(envPtr, valueTokenPtr, interp, i);
 	if (valueTokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
 	    if (concat) {
-		TclEmitOpcode(	INST_LIST_CONCAT,	envPtr);
+		OP(	LIST_CONCAT);
 	    } else {
 		concat = 1;
 	    }
@@ -1216,9 +1252,9 @@ TclCompileListCmd(
 	valueTokenPtr = TokenAfter(valueTokenPtr);
     }
     if (build > 0) {
-	TclEmitInstInt4(	INST_LIST, build,	envPtr);
+	OP4(		LIST, build);
 	if (concat) {
-	    TclEmitOpcode(	INST_LIST_CONCAT,	envPtr);
+	    OP(		LIST_CONCAT);
 	}
     }
 
@@ -1230,8 +1266,7 @@ TclCompileListCmd(
      */
 
     if (concat && numWords == 2) {
-	TclEmitInstInt4(	INST_LIST_RANGE_IMM, 0,	envPtr);
-	TclEmitInt4(			(int)TCL_INDEX_END,	envPtr);
+	OP44(		LIST_RANGE_IMM, 0, (int) TCL_INDEX_END);
     }
     return TCL_OK;
 }
@@ -1271,7 +1306,7 @@ TclCompileLlengthCmd(
     varTokenPtr = TokenAfter(parsePtr->tokenPtr);
 
     CompileWord(envPtr, varTokenPtr, interp, 1);
-    TclEmitOpcode(		INST_LIST_LENGTH,		envPtr);
+    OP(		LIST_LENGTH);
     return TCL_OK;
 }
 
@@ -1309,8 +1344,8 @@ TclCompileLrangeCmd(
 	return TCL_ERROR;
     }
     /*
-     * Token was an index value, and we treat all "first" indices
-     * before the list same as the start of the list.
+     * Token was an index value, and we treat all "first" indices before the
+     * list same as the start of the list.
      */
 
     tokenPtr = TokenAfter(tokenPtr);
@@ -1318,9 +1353,10 @@ TclCompileLrangeCmd(
 	    &idx2) != TCL_OK) {
 	return TCL_ERROR;
     }
+
     /*
-     * Token was an index value, and we treat all "last" indices
-     * after the list same as the end of the list.
+     * Token was an index value, and we treat all "last" indices after the
+     * list same as the end of the list.
      */
 
     /*
@@ -1330,8 +1366,7 @@ TclCompileLrangeCmd(
      */
 
     CompileWord(envPtr, listTokenPtr, interp, 1);
-    TclEmitInstInt4(		INST_LIST_RANGE_IMM, idx1,	envPtr);
-    TclEmitInt4(		idx2,				envPtr);
+    OP44(		LIST_RANGE_IMM, idx1, idx2);
     return TCL_OK;
 }
 
@@ -1372,11 +1407,11 @@ TclCompileLinsertCmd(
     tokenPtr = TokenAfter(listTokenPtr);
 
     /*
-     * NOTE: This command treats all inserts at indices before the list
-     * the same as inserts at the start of the list, and all inserts
-     * after the list the same as inserts at the end of the list. We
-     * make that transformation here so we can use the optimized bytecode
-     * as much as possible.
+     * NOTE: This command treats all inserts at indices before the list the
+     * same as inserts at the start of the list, and all inserts after the
+     * list the same as inserts at the end of the list. We make that
+     * transformation here so we can use the optimized bytecode as much as
+     * possible.
      */
     if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_START, TCL_INDEX_END,
 	    &idx) != TCL_OK) {
@@ -1392,8 +1427,7 @@ TclCompileLinsertCmd(
 
     CompileWord(envPtr, listTokenPtr, interp, 1);
     if (parsePtr->numWords == 3) {
-	TclEmitInstInt4(	INST_LIST_RANGE_IMM, 0,		envPtr);
-	TclEmitInt4(			(int)TCL_INDEX_END,		envPtr);
+	OP44(		LIST_RANGE_IMM, 0, (int) TCL_INDEX_END);
 	return TCL_OK;
     }
 
@@ -1401,13 +1435,13 @@ TclCompileLinsertCmd(
 	tokenPtr = TokenAfter(tokenPtr);
 	CompileWord(envPtr, tokenPtr, interp, i);
     }
-    TclEmitInstInt4(		INST_LIST, i - 3,		envPtr);
+    OP4(		LIST, i - 3);
 
-    if (idx == (int)TCL_INDEX_START) {
-	TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
-	TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
-    } else if (idx == (int)TCL_INDEX_END) {
-	TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
+    if (idx == (int) TCL_INDEX_START) {
+	OP4(		REVERSE, 2);
+	OP(		LIST_CONCAT);
+    } else if (idx == (int) TCL_INDEX_END) {
+	OP(		LIST_CONCAT);
     } else {
 	/*
 	 * Here we handle two ranges for idx. First when idx > 0, we
@@ -1424,14 +1458,12 @@ TclCompileLinsertCmd(
 	if (idx < (int)TCL_INDEX_END) {
 	    idx++;
 	}
-	TclEmitInstInt4(	INST_OVER, 1,			envPtr);
-	TclEmitInstInt4(	INST_LIST_RANGE_IMM, 0,		envPtr);
-	TclEmitInt4(			idx - 1,		envPtr);
-	TclEmitInstInt4(	INST_REVERSE, 3,		envPtr);
-	TclEmitInstInt4(	INST_LIST_RANGE_IMM, idx,	envPtr);
-	TclEmitInt4(			(int)TCL_INDEX_END,		envPtr);
-	TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
-	TclEmitOpcode(		INST_LIST_CONCAT,		envPtr);
+	OP4(		OVER, 1);
+	OP44(		LIST_RANGE_IMM, 0, idx - 1);
+	OP4(		REVERSE, 3);
+	OP44(		LIST_RANGE_IMM, idx, (int) TCL_INDEX_END);
+	OP(		LIST_CONCAT);
+	OP(		LIST_CONCAT);
     }
 
     return TCL_OK;
@@ -1502,13 +1534,17 @@ TclCompileLreplaceCmd(
 	return TCL_ERROR;
     }
 
-    /* All paths start with computing/pushing the original value. */
+    /*
+     * All paths start with computing/pushing the original value.
+     */
+
     CompileWord(envPtr, listTokenPtr, interp, 1);
 
     /*
-     * Push all the replacement values next so any errors raised in
-     * creating them get raised first.
+     * Push all the replacement values next so any errors raised in creating
+     * them get raised first.
      */
+
     if (parsePtr->numWords > 4) {
 	/* Push the replacement arguments */
 	tokenPtr = TokenAfter(tokenPtr);
@@ -1518,7 +1554,7 @@ TclCompileLreplaceCmd(
 	}
 
 	/* Make a list of them... */
-	TclEmitInstInt4(	INST_LIST, i - 4,		envPtr);
+	OP4(		LIST, i - 4);
 
 	emptyPrefix = 0;
     }
@@ -1526,45 +1562,42 @@ TclCompileLreplaceCmd(
     if ((idx1 == suffixStart) && (parsePtr->numWords == 4)) {
 	/*
 	 * This is a "no-op". Example: [lreplace {a b c} 2 0]
-	 * We still do a list operation to get list-verification
-	 * and canonicalization side effects.
+	 * We still do a list operation to get list-verification and
+	 * canonicalization side effects.
 	 */
-	TclEmitInstInt4(	INST_LIST_RANGE_IMM, 0,		envPtr);
-	TclEmitInt4(			(int)TCL_INDEX_END,		envPtr);
+	OP44(		LIST_RANGE_IMM, 0, (int) TCL_INDEX_END);
 	return TCL_OK;
     }
 
-    if (idx1 != (int)TCL_INDEX_START) {
+    if (idx1 != (int) TCL_INDEX_START) {
 	/* Prefix may not be empty; generate bytecode to push it */
 	if (emptyPrefix) {
-	    TclEmitOpcode(	INST_DUP,			envPtr);
+	    OP(		DUP);
 	} else {
-	    TclEmitInstInt4(	INST_OVER, 1,			envPtr);
+	    OP4(	OVER, 1);
 	}
-	TclEmitInstInt4(	INST_LIST_RANGE_IMM, 0,		envPtr);
-	TclEmitInt4(			idx1 - 1,		envPtr);
+	OP44(		LIST_RANGE_IMM, 0, idx1 - 1);
 	if (!emptyPrefix) {
-	    TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
-	    TclEmitOpcode(	INST_LIST_CONCAT,		envPtr);
+	    OP4(	REVERSE, 2);
+	    OP(		LIST_CONCAT);
 	}
 	emptyPrefix = 0;
     }
 
     if (!emptyPrefix) {
-	TclEmitInstInt4(	INST_REVERSE, 2,		envPtr);
+	OP4(		REVERSE, 2);
     }
 
-    if (suffixStart == (int)TCL_INDEX_NONE) {
-	TclEmitOpcode(		INST_POP,			envPtr);
+    if (suffixStart == (int) TCL_INDEX_NONE) {
+	OP(		POP);
 	if (emptyPrefix) {
-	    PushStringLiteral(envPtr, "");
+	    PUSH(	"");
 	}
     } else {
 	/* Suffix may not be empty; generate bytecode to push it */
-	TclEmitInstInt4(	INST_LIST_RANGE_IMM, suffixStart, envPtr);
-	TclEmitInt4(			(int)TCL_INDEX_END,		envPtr);
+	OP44(		LIST_RANGE_IMM, suffixStart, (int) TCL_INDEX_END);
 	if (!emptyPrefix) {
-	    TclEmitOpcode(	INST_LIST_CONCAT,		envPtr);
+	    OP(		LIST_CONCAT);
 	}
     }
 
@@ -1672,7 +1705,7 @@ TclCompileLsetCmd(
 	} else {
 	    tempDepth = parsePtr->numWords - 1;
 	}
-	TclEmitInstInt4(	INST_OVER, tempDepth,		envPtr);
+	OP4(			OVER, tempDepth);
     }
 
     /*
@@ -1685,7 +1718,7 @@ TclCompileLsetCmd(
 	} else {
 	    tempDepth = parsePtr->numWords - 2;
 	}
-	TclEmitInstInt4(	INST_OVER, tempDepth,		envPtr);
+	OP4(			OVER, tempDepth);
     }
 
     /*
@@ -1694,13 +1727,13 @@ TclCompileLsetCmd(
 
     if (isScalar) {
 	if (localIndex < 0) {
-	    TclEmitOpcode(	INST_LOAD_STK,			envPtr);
+	    OP(			LOAD_STK);
 	} else {
-	    Emit14Inst(		INST_LOAD_SCALAR, localIndex,	envPtr);
+	    LOAD(		localIndex);
 	}
     } else {
 	if (localIndex < 0) {
-	    TclEmitOpcode(	INST_LOAD_ARRAY_STK,		envPtr);
+	    OP(			LOAD_ARRAY_STK);
 	} else {
 	    Emit14Inst(		INST_LOAD_ARRAY, localIndex,	envPtr);
 	}
@@ -1711,9 +1744,9 @@ TclCompileLsetCmd(
      */
 
     if (parsePtr->numWords == 4) {
-	TclEmitOpcode(		INST_LSET_LIST,			envPtr);
+	OP(			LSET_LIST);
     } else {
-	TclEmitInstInt4(	INST_LSET_FLAT, parsePtr->numWords-1, envPtr);
+	OP4(			LSET_FLAT, parsePtr->numWords - 1);
     }
 
     /*
@@ -1722,13 +1755,13 @@ TclCompileLsetCmd(
 
     if (isScalar) {
 	if (localIndex < 0) {
-	    TclEmitOpcode(	INST_STORE_STK,			envPtr);
+	    OP(			STORE_STK);
 	} else {
-	    Emit14Inst(		INST_STORE_SCALAR, localIndex,	envPtr);
+	    STORE(		localIndex);
 	}
     } else {
 	if (localIndex < 0) {
-	    TclEmitOpcode(	INST_STORE_ARRAY_STK,		envPtr);
+	    OP(			STORE_ARRAY_STK);
 	} else {
 	    Emit14Inst(		INST_STORE_ARRAY, localIndex,	envPtr);
 	}
@@ -1777,7 +1810,7 @@ TclCompileNamespaceCurrentCmd(
      * Not much to do; we compile to a single instruction...
      */
 
-    TclEmitOpcode(		INST_NS_CURRENT,		envPtr);
+    OP(NS_CURRENT);
     return TCL_OK;
 }
 
@@ -1822,11 +1855,11 @@ TclCompileNamespaceCodeCmd(
      * the value needs to be determined at runtime for safety.
      */
 
-    PushStringLiteral(envPtr,		"::namespace");
-    PushStringLiteral(envPtr,		"inscope");
-    TclEmitOpcode(		INST_NS_CURRENT,	envPtr);
+    PUSH(			"::namespace");
+    PUSH(			"inscope");
+    OP(				NS_CURRENT);
     CompileWord(envPtr,		tokenPtr,		interp, 1);
-    TclEmitInstInt4(		INST_LIST, 4,		envPtr);
+    OP4(			LIST, 4);
     return TCL_OK;
 }
 
@@ -1847,7 +1880,7 @@ TclCompileNamespaceOriginCmd(
     tokenPtr = TokenAfter(parsePtr->tokenPtr);
 
     CompileWord(envPtr,	tokenPtr,			interp, 1);
-    TclEmitOpcode(	INST_ORIGIN_COMMAND,		envPtr);
+    OP(ORIGIN_COMMAND);
     return TCL_OK;
 }
 
@@ -1868,21 +1901,21 @@ TclCompileNamespaceQualifiersCmd(
     }
 
     CompileWord(envPtr, tokenPtr, interp, 1);
-    PushStringLiteral(envPtr, "0");
-    PushStringLiteral(envPtr, "::");
-    TclEmitInstInt4(	INST_OVER, 2,			envPtr);
-    TclEmitOpcode(	INST_STR_FIND_LAST,		envPtr);
+    PUSH(		"0");
+    PUSH(		"::");
+    OP4(		OVER, 2);
+    OP(			STR_FIND_LAST);
     off = CurrentOffset(envPtr);
-    PushStringLiteral(envPtr, "1");
-    TclEmitOpcode(	INST_SUB,			envPtr);
-    TclEmitInstInt4(	INST_OVER, 2,			envPtr);
-    TclEmitInstInt4(	INST_OVER, 1,			envPtr);
-    TclEmitOpcode(	INST_STR_INDEX,			envPtr);
-    PushStringLiteral(envPtr, ":");
-    TclEmitOpcode(	INST_STR_EQ,			envPtr);
+    PUSH(		"1");
+    OP(			SUB);
+    OP4(		OVER, 2);
+    OP4(		OVER, 1);
+    OP(			STR_INDEX);
+    PUSH(		":");
+    OP(			STR_EQ);
     off = off - CurrentOffset(envPtr);
-    TclEmitInstInt1(	INST_JUMP_TRUE1, off,		envPtr);
-    TclEmitOpcode(	INST_STR_RANGE,			envPtr);
+    OP1(		JUMP_TRUE1, off);
+    OP(			STR_RANGE);
     return TCL_OK;
 }
 
@@ -1907,18 +1940,18 @@ TclCompileNamespaceTailCmd(
      */
 
     CompileWord(envPtr, tokenPtr, interp, 1);
-    PushStringLiteral(envPtr, "::");
-    TclEmitInstInt4(	INST_OVER, 1,			envPtr);
-    TclEmitOpcode(	INST_STR_FIND_LAST,		envPtr);
-    TclEmitOpcode(	INST_DUP,			envPtr);
-    PushStringLiteral(envPtr, "0");
-    TclEmitOpcode(	INST_GE,			envPtr);
+    PUSH(		"::");
+    OP4(		OVER, 1);
+    OP(			STR_FIND_LAST);
+    OP(			DUP);
+    PUSH(		"0");
+    OP(			GE);
     TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpFixup);
-    PushStringLiteral(envPtr, "2");
-    TclEmitOpcode(	INST_ADD,			envPtr);
+    PUSH(		"2");
+    OP(			ADD);
     TclFixupForwardJumpToHere(envPtr, &jumpFixup, 127);
-    PushStringLiteral(envPtr, "end");
-    TclEmitOpcode(	INST_STR_RANGE,			envPtr);
+    PUSH(		"end");
+    OP(			STR_RANGE);
     return TCL_OK;
 }
 
@@ -1970,15 +2003,15 @@ TclCompileNamespaceUpvarCmd(
 	if (localIndex < 0) {
 	    return TCL_ERROR;
 	}
-	TclEmitInstInt4(	INST_NSUPVAR, localIndex,	envPtr);
+	OP4(		NSUPVAR, localIndex);
     }
 
     /*
      * Pop the namespace, and set the result to empty
      */
 
-    TclEmitOpcode(		INST_POP,			envPtr);
-    PushStringLiteral(envPtr, "");
+    OP(			POP);
+    PUSH(		"");
     return TCL_OK;
 }
 
@@ -2023,7 +2056,7 @@ TclCompileNamespaceWhichCmd(
      */
 
     CompileWord(envPtr,		tokenPtr,		interp, idx);
-    TclEmitOpcode(		INST_RESOLVE_COMMAND,	envPtr);
+    OP(			RESOLVE_COMMAND);
     return TCL_OK;
 }
 
@@ -2142,7 +2175,7 @@ TclCompileRegexpCmd(
 	     * The semantics of regexp are always match on re == "".
 	     */
 
-	    PushStringLiteral(envPtr, "1");
+	    PUSH(	"1");
 	    return TCL_OK;
 	}
 
@@ -2172,9 +2205,9 @@ TclCompileRegexpCmd(
 
     if (simple) {
 	if (exact && !nocase) {
-	    TclEmitOpcode(	INST_STR_EQ,			envPtr);
+	    OP(		STR_EQ);
 	} else {
-	    TclEmitInstInt1(	INST_STR_MATCH, nocase,		envPtr);
+	    OP1(	STR_MATCH, nocase);
 	}
     } else {
 	/*
@@ -2185,7 +2218,7 @@ TclCompileRegexpCmd(
 
 	int cflags = TCL_REG_ADVANCED | (nocase ? TCL_REG_NOCASE : 0);
 
-	TclEmitInstInt1(	INST_REGEXP, cflags,		envPtr);
+	OP1(		REGEXP, cflags);
     }
 
     return TCL_OK;
@@ -2352,7 +2385,7 @@ TclCompileRegsubCmd(
     bytes = TclGetStringFromObj(replacementObj, &len);
     PushLiteral(envPtr,	bytes, len);
     CompileWord(envPtr,	stringTokenPtr, interp, parsePtr->numWords - 2);
-    TclEmitOpcode(	INST_STR_MAP,	envPtr);
+    OP(		STR_MAP);
 
   done:
     Tcl_DStringFree(&pattern);
@@ -2485,7 +2518,7 @@ TclCompileReturnCmd(
 	 * No explict result argument, so default result is empty string.
 	 */
 
-	PushStringLiteral(envPtr, "");
+	PUSH(	"");
     }
 
     /*
@@ -2519,7 +2552,7 @@ TclCompileReturnCmd(
 	     */
 
 	    Tcl_DecrRefCount(returnOpts);
-	    TclEmitOpcode(INST_DONE, envPtr);
+	    OP(		DONE);
 	    TclAdjustStackDepth(1, envPtr);
 	    return TCL_OK;
 	}
@@ -2550,7 +2583,7 @@ TclCompileReturnCmd(
 	CompileWord(envPtr, wordTokenPtr, interp, objc);
 	wordTokenPtr = TokenAfter(wordTokenPtr);
     }
-    TclEmitInstInt4(INST_LIST, numOptionWords, envPtr);
+    OP4(		LIST, numOptionWords);
 
     /*
      * Push the result.
@@ -2559,14 +2592,14 @@ TclCompileReturnCmd(
     if (explicitResult) {
 	CompileWord(envPtr, wordTokenPtr, interp, numWords - 1);
     } else {
-	PushStringLiteral(envPtr, "");
+	PUSH(		"");
     }
 
     /*
      * Issue the RETURN itself.
      */
 
-    TclEmitInvoke(envPtr, INST_RETURN_STK);
+    INVOKE(		RETURN_STK);
     return TCL_OK;
 }
 
@@ -2596,8 +2629,7 @@ CompileReturnInternal(
     }
 
     TclEmitPush(TclAddLiteralObj(envPtr, returnOpts, NULL), envPtr);
-    TclEmitInstInt4(op, code, envPtr);
-    TclEmitInt4(level, envPtr);
+    TclEmitInstInt44(op, code, level, envPtr);
 }
 
 void
@@ -2676,7 +2708,7 @@ TclCompileUpvarCmd(
 	Tcl_DecrRefCount(objPtr);
 
 	if (newTypePtr != typePtr) {
-	    if (numWords%2) {
+	    if (numWords % 2) {
 		return TCL_ERROR;
 	    }
 	    /* TODO: Push the known value instead? */
@@ -2684,10 +2716,10 @@ TclCompileUpvarCmd(
 	    otherTokenPtr = TokenAfter(tokenPtr);
 	    i = 2;
 	} else {
-	    if (!(numWords%2)) {
+	    if (!(numWords % 2)) {
 		return TCL_ERROR;
 	    }
-	    PushStringLiteral(envPtr, "1");
+	    PUSH("1");
 	    otherTokenPtr = tokenPtr;
 	    i = 1;
 	}
@@ -2710,15 +2742,15 @@ TclCompileUpvarCmd(
 	if (localIndex < 0) {
 	    return TCL_ERROR;
 	}
-	TclEmitInstInt4(	INST_UPVAR, localIndex,		envPtr);
+	OP4(	UPVAR, localIndex);
     }
 
     /*
      * Pop the frame index, and set the result to empty
      */
 
-    TclEmitOpcode(		INST_POP,			envPtr);
-    PushStringLiteral(envPtr, "");
+    OP(		POP);
+    PUSH(	"");
     return TCL_OK;
 }
 
@@ -2784,7 +2816,7 @@ TclCompileVariableCmd(
 	 * IndexTailVarIfKnown() screen.  Full CompileWord()
 	 * likely does not apply here.  Push known value instead. */
 	CompileWord(envPtr, varTokenPtr, interp, i);
-	TclEmitInstInt4(	INST_VARIABLE, localIndex,	envPtr);
+	OP4(		VARIABLE, localIndex);
 
 	if (i + 1 < numWords) {
 	    /*
@@ -2792,8 +2824,8 @@ TclCompileVariableCmd(
 	     */
 
 	    CompileWord(envPtr, valueTokenPtr, interp, i + 1);
-	    Emit14Inst(		INST_STORE_SCALAR, localIndex,	envPtr);
-	    TclEmitOpcode(	INST_POP,			envPtr);
+	    STORE(	localIndex);
+	    OP(		POP);
 	}
     }
 
@@ -2801,7 +2833,7 @@ TclCompileVariableCmd(
      * Set the result to empty
      */
 
-    PushStringLiteral(envPtr, "");
+    PUSH(		"");
     return TCL_OK;
 }
 
@@ -2933,7 +2965,7 @@ TclCompileObjectNextCmd(
 	CompileWord(envPtr, tokenPtr, interp, i);
 	tokenPtr = TokenAfter(tokenPtr);
     }
-    TclEmitInstInt1(	INST_TCLOO_NEXT, i,		envPtr);
+    OP1(	TCLOO_NEXT, i);
     return TCL_OK;
 }
 
@@ -2957,7 +2989,7 @@ TclCompileObjectNextToCmd(
 	CompileWord(envPtr, tokenPtr, interp, i);
 	tokenPtr = TokenAfter(tokenPtr);
     }
-    TclEmitInstInt1(	INST_TCLOO_NEXT_CLASS, i,	envPtr);
+    OP1(	TCLOO_NEXT_CLASS, i);
     return TCL_OK;
 }
 
@@ -2970,9 +3002,9 @@ TclCompileObjectSelfCmd(
     CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
     /*
-     * We only handle [self] and [self object] (which is the same operation).
-     * These are the only very common operations on [self] for which
-     * bytecoding is at all reasonable.
+     * We only handle [self], [self object] (which is the same operation) and
+     * [self namespace].  These are the only very common operations on [self]
+     * for which bytecoding is at all reasonable.
      */
 
     if (parsePtr->numWords == 1) {
@@ -3004,7 +3036,7 @@ TclCompileObjectSelfCmd(
      * This delegates the entire problem to a single opcode.
      */
 
-    TclEmitOpcode(		INST_TCLOO_SELF,		envPtr);
+    OP(		TCLOO_SELF);
     return TCL_OK;
 
   compileSelfNamespace:
@@ -3017,9 +3049,9 @@ TclCompileObjectSelfCmd(
      * avoids creating another opcode, so that's all good!
      */
 
-    TclEmitOpcode(		INST_TCLOO_SELF,		envPtr);
-    TclEmitOpcode(		INST_POP,			envPtr);
-    TclEmitOpcode(		INST_NS_CURRENT,		envPtr);
+    OP(		TCLOO_SELF);
+    OP(		POP);
+    OP(		NS_CURRENT);
     return TCL_OK;
 }
 

generic/tclCompCmdsSZ.c

@@ -81,12 +81,9 @@ const AuxDataType tclJumptableInfoType = {
 #define OP(name)	TclEmitOpcode(INST_##name, envPtr)
 #define OP1(name,val)	TclEmitInstInt1(INST_##name,(val),envPtr)
 #define OP4(name,val)	TclEmitInstInt4(INST_##name,(val),envPtr)
-#define OP14(name,val1,val2) \
-    TclEmitInstInt1(INST_##name,(val1),envPtr);TclEmitInt4((val2),envPtr)
-#define OP44(name,val1,val2) \
-    TclEmitInstInt4(INST_##name,(val1),envPtr);TclEmitInt4((val2),envPtr)
-#define PUSH(str) \
-    PushStringLiteral(envPtr, str)
+#define OP14(name,val1,val2) TclEmitInstInt14(INST_##name,(val1),(val2),envPtr)
+#define OP44(name,val1,val2) TclEmitInstInt44(INST_##name,(val1),(val2),envPtr)
+#define PUSH(str)	PushStringLiteral(envPtr, str)
 #define JUMP4(name,var) \
     (var) = CurrentOffset(envPtr);TclEmitInstInt4(INST_##name##4,0,envPtr)
 #define FIXJUMP4(var) \
@@ -99,9 +96,60 @@ const AuxDataType tclJumptableInfoType = {
     if ((idx)<256) {OP1(LOAD_SCALAR1,(idx));} else {OP4(LOAD_SCALAR4,(idx));}
 #define STORE(idx) \
     if ((idx)<256) {OP1(STORE_SCALAR1,(idx));} else {OP4(STORE_SCALAR4,(idx));}
-#define INVOKE(name) \
-    TclEmitInvoke(envPtr,INST_##name)
+#define INVOKE(name)	TclEmitInvoke(envPtr,INST_##name)
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * IsContinuationBody, IsDefaultToken, IsFinallyToken, IsOnToken,
+ * IsTrapToken --
+ *
+ *	Helpers for TclCompileSwitchCmd and TclCompileTryCmd to compare tokens
+ *	to key literals.
+ *
+ * Results:
+ *	Returns 1 if they're equal, 0 if not.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
 
+static inline int
+IsContinuationBody(
+    const Tcl_Token *tokenPtr)
+{
+    return tokenPtr->size == 1 && tokenPtr->start[0] == '-';
+}
+
+static inline int
+IsDefaultToken(
+    const Tcl_Token *tokenPtr)
+{
+    return tokenPtr->size == 7 && memcmp(tokenPtr->start, "default", 7) == 0;
+}
+
+static inline int
+IsFinallyToken(
+    const Tcl_Token *tokenPtr)
+{
+    return tokenPtr->size == 7 && memcmp(tokenPtr->start, "finally", 7) == 0;
+}
+
+static inline int
+IsOnToken(
+    const Tcl_Token *tokenPtr)
+{
+    return tokenPtr->size == 2 && memcmp(tokenPtr->start, "on", 2) == 0;
+}
+
+static inline int
+IsTrapToken(
+    const Tcl_Token *tokenPtr)
+{
+    return tokenPtr->size == 4 && memcmp(tokenPtr->start, "trap", 4) == 0;
+}
 
 /*
  *----------------------------------------------------------------------
@@ -164,33 +212,33 @@ TclCompileSetCmd(
      * Emit instructions to set/get the variable.
      */
 
-	if (isScalar) {
-	    if (localIndex < 0) {
-		TclEmitOpcode((isAssignment?
-			INST_STORE_STK : INST_LOAD_STK), envPtr);
-	    } else if (localIndex <= 255) {
-		TclEmitInstInt1((isAssignment?
-			INST_STORE_SCALAR1 : INST_LOAD_SCALAR1),
-			localIndex, envPtr);
-	    } else {
-		TclEmitInstInt4((isAssignment?
-			INST_STORE_SCALAR4 : INST_LOAD_SCALAR4),
-			localIndex, envPtr);
-	    }
+    if (isScalar) {
+	if (localIndex < 0) {
+	    TclEmitOpcode((isAssignment?
+		    INST_STORE_STK : INST_LOAD_STK), envPtr);
+	} else if (localIndex <= 255) {
+	    TclEmitInstInt1((isAssignment?
+		    INST_STORE_SCALAR1 : INST_LOAD_SCALAR1),
+		    localIndex, envPtr);
 	} else {
-	    if (localIndex < 0) {
-		TclEmitOpcode((isAssignment?
-			INST_STORE_ARRAY_STK : INST_LOAD_ARRAY_STK), envPtr);
-	    } else if (localIndex <= 255) {
-		TclEmitInstInt1((isAssignment?
-			INST_STORE_ARRAY1 : INST_LOAD_ARRAY1),
-			localIndex, envPtr);
-	    } else {
-		TclEmitInstInt4((isAssignment?
-			INST_STORE_ARRAY4 : INST_LOAD_ARRAY4),
-			localIndex, envPtr);
-	    }
+	    TclEmitInstInt4((isAssignment?
+		    INST_STORE_SCALAR4 : INST_LOAD_SCALAR4),
+		    localIndex, envPtr);
 	}
+    } else {
+	if (localIndex < 0) {
+	    TclEmitOpcode((isAssignment?
+		    INST_STORE_ARRAY_STK : INST_LOAD_ARRAY_STK), envPtr);
+	} else if (localIndex <= 255) {
+	    TclEmitInstInt1((isAssignment?
+		    INST_STORE_ARRAY1 : INST_LOAD_ARRAY1),
+		    localIndex, envPtr);
+	} else {
+	    TclEmitInstInt4((isAssignment?
+		    INST_STORE_ARRAY4 : INST_LOAD_ARRAY4),
+		    localIndex, envPtr);
+	}
+    }
 
     return TCL_OK;
 }
@@ -229,13 +277,15 @@ TclCompileStringCatCmd(
 
     /* Trivial case, no arg */
 
-    if (numWords<2) {
-	PushStringLiteral(envPtr, "");
+    if (numWords < 2) {
+	PUSH(		"");
 	return TCL_OK;
     }
 
-    /* General case: issue CONCAT1's (by chunks of 254 if needed), folding
-       contiguous constants along the way */
+    /*
+     * General case: issue CONCAT1's (by chunks of 254 if needed), folding
+     * contiguous constants along the way.
+     */
 
     numArgs = 0;
     folded = NULL;
@@ -263,7 +313,7 @@ TclCompileStringCatCmd(
 	    CompileWord(envPtr, wordTokenPtr, interp, i);
 	    numArgs ++;
 	    if (numArgs >= 254) { /* 254 to take care of the possible +1 of "folded" above */
-		TclEmitInstInt1(INST_STR_CONCAT1, numArgs, envPtr);
+		OP1(	STR_CONCAT1, numArgs);
 		numArgs = 1;	/* concat pushes 1 obj, the result */
 	    }
 	}
@@ -279,7 +329,7 @@ TclCompileStringCatCmd(
 	numArgs ++;
     }
     if (numArgs > 1) {
-	TclEmitInstInt1(INST_STR_CONCAT1, numArgs, envPtr);
+	OP1(		STR_CONCAT1, numArgs);
     }
 
     return TCL_OK;
@@ -312,7 +362,7 @@ TclCompileStringCmpCmd(
     CompileWord(envPtr, tokenPtr, interp, 1);
     tokenPtr = TokenAfter(tokenPtr);
     CompileWord(envPtr, tokenPtr, interp, 2);
-    TclEmitOpcode(INST_STR_CMP, envPtr);
+    OP(		STR_CMP);
     return TCL_OK;
 }
 
@@ -343,7 +393,7 @@ TclCompileStringEqualCmd(
     CompileWord(envPtr, tokenPtr, interp, 1);
     tokenPtr = TokenAfter(tokenPtr);
     CompileWord(envPtr, tokenPtr, interp, 2);
-    TclEmitOpcode(INST_STR_EQ, envPtr);
+    OP(		STR_EQ);
     return TCL_OK;
 }
 
@@ -374,7 +424,7 @@ TclCompileStringFirstCmd(
     CompileWord(envPtr, tokenPtr, interp, 1);
     tokenPtr = TokenAfter(tokenPtr);
     CompileWord(envPtr, tokenPtr, interp, 2);
-    OP(STR_FIND);
+    OP(		STR_FIND);
     return TCL_OK;
 }
 
@@ -405,7 +455,7 @@ TclCompileStringLastCmd(
     CompileWord(envPtr, tokenPtr, interp, 1);
     tokenPtr = TokenAfter(tokenPtr);
     CompileWord(envPtr, tokenPtr, interp, 2);
-    OP(STR_FIND_LAST);
+    OP(		STR_FIND_LAST);
     return TCL_OK;
 }
 
@@ -432,7 +482,7 @@ TclCompileStringIndexCmd(
     CompileWord(envPtr, tokenPtr, interp, 1);
     tokenPtr = TokenAfter(tokenPtr);
     CompileWord(envPtr, tokenPtr, interp, 2);
-    TclEmitOpcode(INST_STR_INDEX, envPtr);
+    OP(		STR_INDEX);
     return TCL_OK;
 }
 
@@ -452,20 +502,28 @@ TclCompileStringInsertCmd(
 	return TCL_ERROR;
     }
 
-    /* Compute and push the string in which to insert */
+    /*
+     * Compute and push the string in which to insert.
+     */
+
     tokenPtr = TokenAfter(parsePtr->tokenPtr);
     CompileWord(envPtr, tokenPtr, interp, 1);
 
-    /* See what can be discovered about index at compile time */
+    /*
+     * See what can be discovered about index at compile time.
+     */
+
     tokenPtr = TokenAfter(tokenPtr);
     if (TCL_OK != TclGetIndexFromToken(tokenPtr, TCL_INDEX_START,
 	    TCL_INDEX_END, &idx)) {
-
 	/* Nothing useful knowable - cease compile; let it direct eval */
 	return TCL_ERROR;
     }
 
-    /* Compute and push the string to be inserted */
+    /*
+     * Compute and push the string to be inserted.
+     */
+
     tokenPtr = TokenAfter(tokenPtr);
     CompileWord(envPtr, tokenPtr, interp, 3);
 
@@ -492,6 +550,17 @@ TclCompileStringInsertCmd(
     return TCL_OK;
 }
 
+static inline int
+GotLiteral(
+    const Tcl_Token *tokenPtr,
+    const char *word)
+{
+    return (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD &&
+	    tokenPtr[1].size > 1 &&
+	    tokenPtr[1].start[0] == word[0] &&
+	    strncmp(tokenPtr[1].start, word, tokenPtr[1].size) == 0);
+}
+
 int
 TclCompileStringIsCmd(
     Tcl_Interp *interp,		/* Used for error reporting. */
@@ -538,12 +607,6 @@ TclCompileStringIsCmd(
     }
     Tcl_DecrRefCount(isClass);
 
-#define GotLiteral(tokenPtr, word) \
-    ((tokenPtr)->type == TCL_TOKEN_SIMPLE_WORD &&			\
-     (tokenPtr)[1].size > 1 &&						\
-     (tokenPtr)[1].start[0] == word[0] &&				\
-     strncmp((tokenPtr)[1].start, (word), (tokenPtr)[1].size) == 0)
-
     /*
      * Cannot handle the -failindex option at all, and that's the only legal
      * way to have more than 4 arguments.
@@ -562,7 +625,6 @@ TclCompileStringIsCmd(
 	}
 	tokenPtr = TokenAfter(tokenPtr);
     }
-#undef GotLiteral
 
     /*
      * Compile the code. There are several main classes of check here.
@@ -804,12 +866,7 @@ TclCompileStringMatchCmd(
      */
 
     if (parsePtr->numWords == 4) {
-	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-	    return TclCompileBasic3ArgCmd(interp, parsePtr, cmdPtr, envPtr);
-	}
-	str = tokenPtr[1].start;
-	length = tokenPtr[1].size;
-	if ((length <= 1) || strncmp(str, "-nocase", length)) {
+	if (!GotLiteral(tokenPtr, "-nocase")) {
 	    /*
 	     * Fail at run time, not in compilation.
 	     */
@@ -843,7 +900,7 @@ TclCompileStringMatchCmd(
 	    }
 	    PushLiteral(envPtr, str, length);
 	} else {
-	    SetLineInformation(i+1+nocase);
+	    SetLineInformation(i + 1 + nocase);
 	    CompileTokens(envPtr, tokenPtr, interp);
 	}
 	tokenPtr = TokenAfter(tokenPtr);
@@ -854,9 +911,9 @@ TclCompileStringMatchCmd(
      */
 
     if (exactMatch) {
-	TclEmitOpcode(INST_STR_EQ, envPtr);
+	OP(	STR_EQ);
     } else {
-	TclEmitInstInt1(INST_STR_MATCH, nocase, envPtr);
+	OP1(	STR_MATCH, nocase);
     }
     return TCL_OK;
 }
@@ -894,7 +951,7 @@ TclCompileStringLenCmd(
     } else {
 	SetLineInformation(1);
 	CompileTokens(envPtr, tokenPtr, interp);
-	TclEmitOpcode(INST_STR_LEN, envPtr);
+	OP(	STR_LEN);
     }
     TclDecrRefCount(objPtr);
     return TCL_OK;
@@ -993,6 +1050,7 @@ TclCompileStringRangeCmd(
 	    &idx1) != TCL_OK) {
 	goto nonConstantIndices;
     }
+
     /*
      * Token parsed as an index expression. We treat all indices before
      * the string the same as the start of the string.
@@ -1009,10 +1067,12 @@ TclCompileStringRangeCmd(
 	    &idx2) != TCL_OK) {
 	goto nonConstantIndices;
     }
+
     /*
      * Token parsed as an index expression. We treat all indices after
      * the string the same as the end of the string.
      */
+
     if (idx2 == (int)TCL_INDEX_NONE) {
 	/* [string range $s $first -1] must be empty string */
 	OP(		POP);
@@ -1061,6 +1121,7 @@ TclCompileStringReplaceCmd(
     /*
      * Check for first index known and useful at compile time.
      */
+
     tokenPtr = TokenAfter(valueTokenPtr);
     if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_START, TCL_INDEX_NONE,
 	    &first) != TCL_OK) {
@@ -1070,6 +1131,7 @@ TclCompileStringReplaceCmd(
     /*
      * Check for last index known and useful at compile time.
      */
+
     tokenPtr = TokenAfter(tokenPtr);
     if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_NONE, TCL_INDEX_END,
 	    &last) != TCL_OK) {
@@ -1077,26 +1139,25 @@ TclCompileStringReplaceCmd(
     }
 
     /*
-     * [string replace] is an odd bird.  For many arguments it is
-     * a conventional substring replacer.  However it also goes out
-     * of its way to become a no-op for many cases where it would be
-     * replacing an empty substring.  Precisely, it is a no-op when
+     * [string replace] is an odd bird.  For many arguments it is a
+     * conventional substring replacer.  However it also goes out of its way
+     * to become a no-op for many cases where it would be replacing an empty
+     * substring.  Precisely, it is a no-op when
      *
      *		(last < first)		OR
      *		(last < 0)		OR
      *		(end < first)
      *
-     * For some compile-time values we can detect these cases, and
-     * compile direct to bytecode implementing the no-op.
+     * For some compile-time values we can detect these cases, and compile
+     * direct to bytecode implementing the no-op.
      */
 
     if ((last == (int)TCL_INDEX_NONE)		/* Know (last < 0) */
 	    || (first == (int)TCL_INDEX_NONE)	/* Know (first > end) */
 
 	/*
-	 * Tricky to determine when runtime (last < first) can be
-	 * certainly known based on the encoded values. Consider the
-	 * cases...
+	 * Tricky to determine when runtime (last < first) can be certainly
+	 * known based on the encoded values. Consider the cases...
 	 *
 	 * (first <= TCL_INDEX_END) &&
 	 *	(last <= TCL_INDEX END) && (last < first) => ACCEPT
@@ -1125,74 +1186,72 @@ TclCompileStringReplaceCmd(
     }
 
     if (parsePtr->numWords == 5) {
-    /*
-     * When we have a string replacement, we have to take care about
-     * not replacing empty substrings that [string replace] promises
-     * not to replace
-     *
-     * The remaining index values might be suitable for conventional
-     * string replacement, but only if they cannot possibly meet the
-     * conditions described above at runtime. If there's a chance they
-     * might, we would have to emit bytecode to check and at that point
-     * we're paying more in bytecode execution time than would make
-     * things worthwhile. Trouble is we are very limited in
-     * how much we can detect that at compile time. After decoding,
-     * we need, first:
-     *
-     *		(first <= end)
-     *
-     * The encoded indices (first <= TCL_INDEX END) and
-     * (first == TCL_INDEX_NONE) always meets this condition, but
-     * any other encoded first index has some list for which it fails.
-     *
-     * We also need, second:
-     *
-     *		(last >= 0)
-     *
-     * The encoded index (last >= TCL_INDEX_START) always meet this
-     * condition but any other encoded last index has some list for
-     * which it fails.
-     *
-     * Finally we need, third:
-     *
-     *		(first <= last)
-     *
-     * Considered in combination with the constraints we already have,
-     * we see that we can proceed when (first == TCL_INDEX_NONE).
-     * These also permit simplification of the prefix|replace|suffix
-     * construction. The other constraints, though, interfere with
-     * getting a guarantee that first <= last.
-     */
+	/*
+	 * When we have a string replacement, we have to take care about not
+	 * replacing empty substrings that [string replace] promises not to
+	 * replace.
+	 *
+	 * The remaining index values might be suitable for conventional
+	 * string replacement, but only if they cannot possibly meet the
+	 * conditions described above at runtime. If there's a chance they
+	 * might, we would have to emit bytecode to check and at that point
+	 * we're paying more in bytecode execution time than would make things
+	 * worthwhile. Trouble is we are very limited in how much we can
+	 * detect that at compile time. After decoding, we need, first:
+	 *
+	 *		(first <= end)
+	 *
+	 * The encoded indices (first <= TCL_INDEX END) and (first ==
+	 * TCL_INDEX_NONE) always meets this condition, but any other encoded
+	 * first index has some list for which it fails.
+	 *
+	 * We also need, second:
+	 *
+	 *		(last >= 0)
+	 *
+	 * The encoded index (last >= TCL_INDEX_START) always meet this
+	 * condition but any other encoded last index has some list for which
+	 * it fails.
+	 *
+	 * Finally we need, third:
+	 *
+	 *		(first <= last)
+	 *
+	 * Considered in combination with the constraints we already have, we
+	 * see that we can proceed when (first == TCL_INDEX_NONE).  These also
+	 * permit simplification of the prefix|replace|suffix construction.
+	 * The other constraints, though, interfere with getting a guarantee
+	 * that first <= last.
+	 */
 
-    if ((first == (int)TCL_INDEX_START) && (last >= (int)TCL_INDEX_START)) {
-	/* empty prefix */
-	tokenPtr = TokenAfter(tokenPtr);
-	CompileWord(envPtr, tokenPtr, interp, 4);
-	OP4(		REVERSE, 2);
-	if (last == INT_MAX) {
-	    OP(		POP);		/* Pop  original */
-	} else {
-	    OP44(	STR_RANGE_IMM, last + 1, (int)TCL_INDEX_END);
-	    OP1(	STR_CONCAT1, 2);
+	if ((first == (int)TCL_INDEX_START) && (last >= (int)TCL_INDEX_START)) {
+	    /* empty prefix */
+	    tokenPtr = TokenAfter(tokenPtr);
+	    CompileWord(envPtr, tokenPtr, interp, 4);
+	    OP4(	REVERSE, 2);
+	    if (last == INT_MAX) {
+		OP(	POP);		/* Pop  original */
+	    } else {
+		OP44(	STR_RANGE_IMM, last + 1, (int)TCL_INDEX_END);
+		OP1(	STR_CONCAT1, 2);
+	    }
+	    return TCL_OK;
 	}
-	return TCL_OK;
-    }
 
-    if ((last == (int)TCL_INDEX_NONE) && (first <= (int)TCL_INDEX_END)) {
-	OP44(		STR_RANGE_IMM, 0, first-1);
-	tokenPtr = TokenAfter(tokenPtr);
-	CompileWord(envPtr, tokenPtr, interp, 4);
-	OP1(		STR_CONCAT1, 2);
-	return TCL_OK;
-    }
+	if ((last == (int)TCL_INDEX_NONE) && (first <= (int)TCL_INDEX_END)) {
+	    OP44(	STR_RANGE_IMM, 0, first-1);
+	    tokenPtr = TokenAfter(tokenPtr);
+	    CompileWord(envPtr, tokenPtr, interp, 4);
+	    OP1(	STR_CONCAT1, 2);
+	    return TCL_OK;
+	}
 
 	/* FLOW THROUGH TO genericReplace */
-
     } else {
 	/*
-	 * When we have no replacement string to worry about, we may
-	 * have more luck, because the forbidden empty string replacements
-	 * are harmless when they are replaced by another empty string.
+	 * When we have no replacement string to worry about, we may have more
+	 * luck, because the forbidden empty string replacements are harmless
+	 * when they are replaced by another empty string.
 	 */
 
 	if (first == (int)TCL_INDEX_START) {
@@ -1201,7 +1260,7 @@ TclCompileStringReplaceCmd(
 	    if (last == (int)TCL_INDEX_END) {
 		/* empty suffix too => empty result */
 		OP(	POP);		/* Pop  original */
-		PUSH	(	"");
+		PUSH(	"");
 		return TCL_OK;
 	    }
 	    OP44(	STR_RANGE_IMM, last + 1, (int)TCL_INDEX_END);
@@ -1221,19 +1280,19 @@ TclCompileStringReplaceCmd(
 	}
     }
 
-    genericReplace:
-	tokenPtr = TokenAfter(valueTokenPtr);
-	CompileWord(envPtr, tokenPtr, interp, 2);
+  genericReplace:
+    tokenPtr = TokenAfter(valueTokenPtr);
+    CompileWord(envPtr, tokenPtr, interp, 2);
+    tokenPtr = TokenAfter(tokenPtr);
+    CompileWord(envPtr, tokenPtr, interp, 3);
+    if (parsePtr->numWords == 5) {
 	tokenPtr = TokenAfter(tokenPtr);
-	CompileWord(envPtr, tokenPtr, interp, 3);
-	if (parsePtr->numWords == 5) {
-	    tokenPtr = TokenAfter(tokenPtr);
-	    CompileWord(envPtr, tokenPtr, interp, 4);
-	} else {
-	    PUSH(	"");
-	}
-	OP(		STR_REPLACE);
-	return TCL_OK;
+	CompileWord(envPtr, tokenPtr, interp, 4);
+    } else {
+	PUSH(		"");
+    }
+    OP(			STR_REPLACE);
+    return TCL_OK;
 }
 
 int
@@ -1477,12 +1536,14 @@ TclCompileSubstCmd(
     }
 */
 
-    /* TODO: Figure out expansion to cover WordKnownAtCompileTime
-     *	The difficulty is that WKACT makes a copy, and if TclSubstParse
-     *	below parses the copy of the original source string, some deep
-     *	parts of the compile machinery get upset.  They want all pointers
-     *	stored in Tcl_Tokens to point back to the same original string.
+    /*
+     * TODO: Figure out expansion to cover WordKnownAtCompileTime. The
+     * difficulty is that WKACT makes a copy, and if TclSubstParse below
+     * parses the copy of the original source string, some deep parts of the
+     * compile machinery get upset. They want all pointers stored in
+     * Tcl_Tokens to point back to the same original string.
      */
+
     if (wordTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
 	code = TclSubstOptions(NULL, numOpts, objv, &flags);
     }
@@ -1539,16 +1600,14 @@ TclSubstCompile(
 
     for (endTokenPtr = tokenPtr + parse.numTokens;
 	    tokenPtr < endTokenPtr; tokenPtr = TokenAfter(tokenPtr)) {
-	int length, literal, catchRange, breakJump;
+	int length, catchRange, breakJump;
 	char buf[4] = "";
 	JumpFixup startFixup, okFixup, returnFixup, breakFixup;
 	JumpFixup continueFixup, otherFixup, endFixup;
 
 	switch (tokenPtr->type) {
 	case TCL_TOKEN_TEXT:
-	    literal = TclRegisterLiteral(envPtr,
-		    tokenPtr->start, tokenPtr->size, 0);
-	    TclEmitPush(literal, envPtr);
+	    PushLiteral(envPtr, tokenPtr->start, tokenPtr->size);
 	    TclAdvanceLines(&bline, tokenPtr->start,
 		    tokenPtr->start + tokenPtr->size);
 	    count++;
@@ -1556,8 +1615,7 @@ TclSubstCompile(
 	case TCL_TOKEN_BS:
 	    length = TclParseBackslash(tokenPtr->start, tokenPtr->size,
 		    NULL, buf);
-	    literal = TclRegisterLiteral(envPtr, buf, length, 0);
-	    TclEmitPush(literal, envPtr);
+	    PushLiteral(envPtr, buf, length);
 	    count++;
 	    continue;
 	case TCL_TOKEN_VARIABLE:
@@ -1604,8 +1662,7 @@ TclSubstCompile(
 	    TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &startFixup);
 
 	    /* Jump to the end (all BREAKs land here) */
-	    breakOffset = CurrentOffset(envPtr);
-	    TclEmitInstInt4(INST_JUMP4, 0, envPtr);
+	    JUMP4(		JUMP, breakOffset);
 
 	    /* Start */
 	    if (TclFixupForwardJumpToHere(envPtr, &startFixup, 127)) {
@@ -1616,7 +1673,7 @@ TclSubstCompile(
 
 	envPtr->line = bline;
 	catchRange = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
-	OP4(	BEGIN_CATCH4, catchRange);
+	OP4(			BEGIN_CATCH4, catchRange);
 	ExceptionRangeStarts(envPtr, catchRange);
 
 	switch (tokenPtr->type) {
@@ -1637,21 +1694,21 @@ TclSubstCompile(
 	ExceptionRangeEnds(envPtr, catchRange);
 
 	/* Substitution produced TCL_OK */
-	OP(	END_CATCH);
+	OP(			END_CATCH);
 	TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &okFixup);
 	TclAdjustStackDepth(-1, envPtr);
 
 	/* Exceptional return codes processed here */
 	ExceptionRangeTarget(envPtr, catchRange, catchOffset);
-	OP(	PUSH_RETURN_OPTIONS);
-	OP(	PUSH_RESULT);
-	OP(	PUSH_RETURN_CODE);
-	OP(	END_CATCH);
-	OP(	RETURN_CODE_BRANCH);
+	OP(			PUSH_RETURN_OPTIONS);
+	OP(			PUSH_RESULT);
+	OP(			PUSH_RETURN_CODE);
+	OP(			END_CATCH);
+	OP(			RETURN_CODE_BRANCH);
 
 	/* ERROR -> reraise it; NB: can't require BREAK/CONTINUE handling */
-	OP(	RETURN_STK);
-	OP(	NOP);
+	OP(			RETURN_STK);
+	OP(			NOP);
 
 	/* RETURN */
 	TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &returnFixup);
@@ -1671,14 +1728,14 @@ TclSubstCompile(
 	    Tcl_Panic("TclCompileSubstCmd: bad break jump distance %d",
 		    (int) (CurrentOffset(envPtr) - breakFixup.codeOffset));
 	}
-	OP(	POP);
-	OP(	POP);
+	OP(			POP);
+	OP(			POP);
 
 	breakJump = CurrentOffset(envPtr) - breakOffset;
 	if (breakJump > 127) {
-	    OP4(JUMP4, -breakJump);
+	    OP4(		JUMP4, -breakJump);
 	} else {
-	    OP1(JUMP1, -breakJump);
+	    OP1(		JUMP1, -breakJump);
 	}
 
 	TclAdjustStackDepth(2, envPtr);
@@ -1745,8 +1802,7 @@ TclSubstCompile(
 
     /* Final target of the multi-jump from all BREAKs */
     if (breakOffset > 0) {
-	TclUpdateInstInt4AtPc(INST_JUMP4, CurrentOffset(envPtr) - breakOffset,
-		envPtr->codeStart + breakOffset);
+	FIXJUMP4(breakOffset);
     }
 }
 
@@ -2043,8 +2099,7 @@ TclCompileSwitchCmd(
      * illegal, but this makes the error happen at the right time).
      */
 
-    if (bodyToken[numWords-1]->size == 1 &&
-	    bodyToken[numWords-1]->start[0] == '-') {
+    if (IsContinuationBody(bodyToken[numWords-1])) {
 	goto freeTemporaries;
     }
 
@@ -2056,7 +2111,10 @@ TclCompileSwitchCmd(
      * but it handles the most common case well enough.
      */
 
-    /* Both methods push the value to match against onto the stack. */
+    /*
+     * Both methods push the value to match against onto the stack.
+     */
+
     CompileWord(envPtr, valueTokenPtr, interp, valueIndex);
 
     if (mode == Switch_Exact) {
@@ -2140,8 +2198,8 @@ IssueSwitchChainedTests(
     foundDefault = 0;
     for (i=0 ; i<numBodyTokens ; i+=2) {
 	nextArmFixupIndex = -1;
-	if (i!=numBodyTokens-2 || bodyToken[numBodyTokens-2]->size != 7 ||
-		memcmp(bodyToken[numBodyTokens-2]->start, "default", 7)) {
+	if (i != numBodyTokens - 2 ||
+		!IsDefaultToken(bodyToken[numBodyTokens - 2])) {
 	    /*
 	     * Generate the test for the arm.
 	     */
@@ -2223,7 +2281,7 @@ IssueSwitchChainedTests(
 	     * ensured earlier; the final body is never a fall-through).
 	     */
 
-	    if (bodyToken[i+1]->size==1 && bodyToken[i+1]->start[0]=='-') {
+	    if (IsContinuationBody(bodyToken[i + 1])) {
 		if (contFixIndex == -1) {
 		    contFixIndex = fixupCount;
 		    contFixCount = 0;
@@ -2403,8 +2461,8 @@ IssueSwitchJumpTable(
 	 * term.
 	 */
 
-	if (i!=numBodyTokens-2 || bodyToken[numBodyTokens-2]->size != 7 ||
-		memcmp(bodyToken[numBodyTokens-2]->start, "default", 7)) {
+	if (i != numBodyTokens - 2 ||
+		!IsDefaultToken(bodyToken[numBodyTokens - 2])) {
 	    /*
 	     * This is not a default clause, so insert the current location as
 	     * a target in the jump table (assuming it isn't already there,
@@ -2423,7 +2481,8 @@ IssueSwitchJumpTable(
 		 * point to here.
 		 */
 
-		Tcl_SetHashValue(hPtr, CurrentOffset(envPtr) - jumpLocation);
+		Tcl_SetHashValue(hPtr, (ptrdiff_t) 
+			(CurrentOffset(envPtr) - jumpLocation));
 	    }
 	    Tcl_DStringFree(&buffer);
 	} else {
@@ -2434,8 +2493,8 @@ IssueSwitchJumpTable(
 
 	    foundDefault = 1;
 	    isNew = 1;
-	    TclStoreInt4AtPtr(CurrentOffset(envPtr)-jumpToDefault,
-		    envPtr->codeStart+jumpToDefault+1);
+	    TclStoreInt4AtPtr(CurrentOffset(envPtr) - jumpToDefault,
+		    envPtr->codeStart + jumpToDefault + 1);
 	}
 
 	/*
@@ -2446,7 +2505,7 @@ IssueSwitchJumpTable(
 	 * will also point here, so we advance to the next clause.
 	 */
 
-	if (bodyToken[i+1]->size == 1 && bodyToken[i+1]->start[0] == '-') {
+	if (IsContinuationBody(bodyToken[i + 1])) {
 	    mustGenerate = 1;
 	    continue;
 	}
@@ -2498,7 +2557,7 @@ IssueSwitchJumpTable(
      */
 
     if (!foundDefault) {
-	TclStoreInt4AtPtr(CurrentOffset(envPtr)-jumpToDefault,
+	TclStoreInt4AtPtr(CurrentOffset(envPtr) - jumpToDefault,
 		envPtr->codeStart+jumpToDefault+1);
 	PUSH("");
     }
@@ -2509,8 +2568,8 @@ IssueSwitchJumpTable(
      */
 
     for (i=0 ; i<numRealBodies ; i++) {
-	TclStoreInt4AtPtr(CurrentOffset(envPtr)-finalFixups[i],
-		envPtr->codeStart+finalFixups[i]+1);
+	TclStoreInt4AtPtr(CurrentOffset(envPtr) - finalFixups[i],
+		envPtr->codeStart + finalFixups[i] + 1);
     }
 
     /*
@@ -2669,7 +2728,7 @@ TclCompileTailcallCmd(
 	tokenPtr = TokenAfter(tokenPtr);
 	CompileWord(envPtr, tokenPtr, interp, i);
     }
-    TclEmitInstInt1(	INST_TAILCALL, parsePtr->numWords,	envPtr);
+    OP1(	TAILCALL, parsePtr->numWords);
     return TCL_OK;
 }
 
@@ -2717,9 +2776,10 @@ TclCompileThrowCmd(
     codeKnown = TclWordKnownAtCompileTime(codeToken, objPtr);
 
     /*
-     * First we must emit the code to substitute the arguments.  This
-     * must come first in case substitution raises errors.
+     * First we must emit the code to substitute the arguments.  This must
+     * come first in case substitution raises errors.
      */
+
     if (!codeKnown) {
 	CompileWord(envPtr, codeToken, interp, 1);
 	PUSH(			"-errorcode");
@@ -2743,6 +2803,7 @@ TclCompileThrowCmd(
     /*
      * Simpler bytecodes when we detect invalid arguments at compile time.
      */
+
     if (codeKnown && !codeIsValid) {
 	OP(			POP);
 	if (codeIsList) {
@@ -2755,9 +2816,9 @@ TclCompileThrowCmd(
 
     if (!codeKnown) {
 	/*
-	 * Argument validity checking has to be done by bytecode at
-	 * run time.
+	 * Argument validity checking has to be done by bytecode at run time.
 	 */
+
 	OP4(			REVERSE, 3);
 	OP(			DUP);
 	OP(			LIST_LENGTH);
@@ -2849,8 +2910,7 @@ TclCompileTryCmd(
 	    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
 		goto failedToCompile;
 	    }
-	    if (tokenPtr[1].size == 4
-		    && !strncmp(tokenPtr[1].start, "trap", 4)) {
+	    if (IsTrapToken(&tokenPtr[1])) {
 		/*
 		 * Parse the list of errorCode words to match against.
 		 */
@@ -2867,8 +2927,7 @@ TclCompileTryCmd(
 		}
 		Tcl_ListObjReplace(NULL, tmpObj, 0, 0, 0, NULL);
 		matchClauses[i] = tmpObj;
-	    } else if (tokenPtr[1].size == 2
-		    && !strncmp(tokenPtr[1].start, "on", 2)) {
+	    } else if (IsOnToken(&tokenPtr[1])) {
 		int code;
 
 		/*
@@ -2942,7 +3001,7 @@ TclCompileTryCmd(
 	    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
 		goto failedToCompile;
 	    }
-	    if (tokenPtr[1].size == 1 && tokenPtr[1].start[0] == '-') {
+	    if (IsContinuationBody(&tokenPtr[1])) {
 		handlerTokens[i] = NULL;
 	    } else {
 		handlerTokens[i] = tokenPtr;
@@ -2963,8 +3022,8 @@ TclCompileTryCmd(
     if (numWords == 0) {
 	finallyToken = NULL;
     } else if (numWords == 2) {
-	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD || tokenPtr[1].size != 7
-		|| strncmp(tokenPtr[1].start, "finally", 7)) {
+	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD ||
+		!IsFinallyToken(&tokenPtr[1])) {
 	    goto failedToCompile;
 	}
 	finallyToken = TokenAfter(tokenPtr);
@@ -3869,16 +3928,16 @@ TclCompileWhileCmd(
 
 	jumpDist = CurrentOffset(envPtr) - bodyCodeOffset;
 	if (jumpDist > 127) {
-	    TclEmitInstInt4(INST_JUMP_TRUE4, -jumpDist, envPtr);
+	    OP4(JUMP_TRUE4, -jumpDist);
 	} else {
-	    TclEmitInstInt1(INST_JUMP_TRUE1, -jumpDist, envPtr);
+	    OP1(JUMP_TRUE1, -jumpDist);
 	}
     } else {
 	jumpDist = CurrentOffset(envPtr) - bodyCodeOffset;
 	if (jumpDist > 127) {
-	    TclEmitInstInt4(INST_JUMP4, -jumpDist, envPtr);
+	    OP4(JUMP4, -jumpDist);
 	} else {
-	    TclEmitInstInt1(INST_JUMP1, -jumpDist, envPtr);
+	    OP1(JUMP1, -jumpDist);
 	}
     }
 
@@ -4167,16 +4226,16 @@ CompileComparisonOpCmd(
 	STORE(tmpIndex);
 	TclEmitOpcode(instruction, envPtr);
 	for (words=3 ; words<parsePtr->numWords ;) {
-	    LOAD(tmpIndex);
+	    LOAD(	tmpIndex);
 	    tokenPtr = TokenAfter(tokenPtr);
 	    CompileWord(envPtr, tokenPtr, interp, words);
 	    if (++words < parsePtr->numWords) {
-		STORE(tmpIndex);
+		STORE(	tmpIndex);
 	    }
 	    TclEmitOpcode(instruction, envPtr);
 	}
 	for (; words>3 ; words--) {
-	    OP(	BITAND);
+	    OP(		BITAND);
 	}
 
 	/*
@@ -4184,7 +4243,7 @@ CompileComparisonOpCmd(
 	 * might be expensive elsewhere.
 	 */
 
-	OP14(	UNSET_SCALAR, 0, tmpIndex);
+	OP14(		UNSET_SCALAR, 0, tmpIndex);
     }
     return TCL_OK;
 }
@@ -4310,7 +4369,7 @@ TclCompilePowOpCmd(
 	words++;
     }
     while (--words > 1) {
-	TclEmitOpcode(INST_EXPON, envPtr);
+	OP(	EXPON);
     }
     return TCL_OK;
 }
@@ -4510,11 +4569,11 @@ TclCompileMinusOpCmd(
 	CompileWord(envPtr, tokenPtr, interp, words);
     }
     if (words == 2) {
-	TclEmitOpcode(INST_UMINUS, envPtr);
+	OP(	UMINUS);
 	return TCL_OK;
     }
     if (words == 3) {
-	TclEmitOpcode(INST_SUB, envPtr);
+	OP(	SUB);
 	return TCL_OK;
     }
 
@@ -4523,10 +4582,10 @@ TclCompileMinusOpCmd(
      * calcuations, including roundoff errors.
      */
 
-    TclEmitInstInt4(INST_REVERSE, words-1, envPtr);
+    OP4(	REVERSE, words - 1);
     while (--words > 1) {
-	TclEmitInstInt4(INST_REVERSE, 2, envPtr);
-	TclEmitOpcode(INST_SUB, envPtr);
+	OP4(	REVERSE, 2);
+	OP(	SUB);
     }
     return TCL_OK;
 }
@@ -4551,14 +4610,14 @@ TclCompileDivOpCmd(
 	return TCL_ERROR;
     }
     if (parsePtr->numWords == 2) {
-	PUSH("1.0");
+	PUSH(	"1.0");
     }
     for (words=1 ; words<parsePtr->numWords ; words++) {
 	tokenPtr = TokenAfter(tokenPtr);
 	CompileWord(envPtr, tokenPtr, interp, words);
     }
     if (words <= 3) {
-	TclEmitOpcode(INST_DIV, envPtr);
+	OP(	DIV);
 	return TCL_OK;
     }
 
@@ -4567,10 +4626,10 @@ TclCompileDivOpCmd(
      * calcuations, including roundoff errors.
      */
 
-    TclEmitInstInt4(INST_REVERSE, words-1, envPtr);
+    OP4(	REVERSE, words - 1);
     while (--words > 1) {
-	TclEmitInstInt4(INST_REVERSE, 2, envPtr);
-	TclEmitOpcode(INST_DIV, envPtr);
+	OP4(	REVERSE, 2);
+	OP(	DIV);
     }
     return TCL_OK;
 }

generic/tclCompExpr.c

@@ -134,15 +134,16 @@ enum Marks {
  * need not take the form of a bit array.
  */
 
-#define BINARY		0x40	/* This lexeme is a binary operator. An OpNode
+enum {
+    BINARY = 0x40,		/* This lexeme is a binary operator. An OpNode
 				 * representing it should go into the parse
 				 * tree, and two operands should be parsed for
 				 * it in the expression. */
-#define UNARY		0x80	/* This lexeme is a unary operator. An OpNode
+    UNARY = 0x80,		/* This lexeme is a unary operator. An OpNode
 				 * representing it should go into the parse
 				 * tree, and one operand should be parsed for
 				 * it in the expression. */
-#define LEAF		0xC0	/* This lexeme is a leaf operand in the parse
+    LEAF = 0xC0			/* This lexeme is a leaf operand in the parse
 				 * tree. No OpNode will be placed in the tree
 				 * for it. Either a literal value will be
 				 * appended to the list of literals in this
@@ -150,47 +151,46 @@ enum Marks {
 				 * be appended in a Tcl_Parse struct to
 				 * represent those leaves that require some
 				 * form of substitution. */
+};
 
 /* Uncategorized lexemes */
 
-#define PLUS		1	/* Ambiguous. Resolves to UNARY_PLUS or
+enum {
+    PLUS = 1,			/* Ambiguous. Resolves to UNARY_PLUS or
 				 * BINARY_PLUS according to context. */
-#define MINUS		2	/* Ambiguous. Resolves to UNARY_MINUS or
+    MINUS = 2,			/* Ambiguous. Resolves to UNARY_MINUS or
 				 * BINARY_MINUS according to context. */
-#define BAREWORD	3	/* Ambigous. Resolves to BOOLEAN or to
+    BAREWORD = 3,		/* Ambigous. Resolves to BOOLEAN or to
 				 * FUNCTION or a parse error according to
 				 * context and value. */
-#define INCOMPLETE	4	/* A parse error. Used only when the single
+    INCOMPLETE = 4,		/* A parse error. Used only when the single
 				 * "=" is encountered.  */
-#define INVALID		5	/* A parse error. Used when any punctuation
+    INVALID = 5,		/* A parse error. Used when any punctuation
 				 * appears that's not a supported operator. */
-#define COMMENT		6	/* Comment. Lasts to end of line or end of
+    COMMENT = 6			/* Comment. Lasts to end of line or end of
 				 * expression, whichever comes first. */
+};
 
 /* Leaf lexemes */
 
-#define NUMBER		(LEAF | 1)
-				/* For literal numbers */
-#define SCRIPT		(LEAF | 2)
-				/* Script substitution; [foo] */
-#define BOOLEAN		(LEAF | BAREWORD)
-				/* For literal booleans */
-#define BRACED		(LEAF | 4)
-				/* Braced string; {foo bar} */
-#define VARIABLE	(LEAF | 5)
-				/* Variable substitution; $x */
-#define QUOTED		(LEAF | 6)
-				/* Quoted string; "foo $bar [soom]" */
-#define EMPTY		(LEAF | 7)
-				/* Used only for an empty argument list to a
+enum {
+    NUMBER = (LEAF | 1),	/* For literal numbers */
+    SCRIPT = (LEAF | 2),	/* Script substitution; [foo] */
+    BOOLEAN = (LEAF | BAREWORD),/* For literal booleans */
+    BRACED = (LEAF | 4),	/* Braced string; {foo bar} */
+    VARIABLE = (LEAF | 5),	/* Variable substitution; $x */
+    QUOTED = (LEAF | 6),	/* Quoted string; "foo $bar [soom]" */
+    EMPTY = (LEAF | 7)		/* Used only for an empty argument list to a
 				 * function. Represents the empty string
 				 * within parens in the expression: rand() */
+};
 
 /* Unary operator lexemes */
 
-#define UNARY_PLUS	(UNARY | PLUS)
-#define UNARY_MINUS	(UNARY | MINUS)
-#define FUNCTION	(UNARY | BAREWORD)
+enum {
+    UNARY_PLUS = (UNARY | PLUS),
+    UNARY_MINUS = (UNARY | MINUS),
+    FUNCTION = (UNARY | BAREWORD),
 				/* This is a bit of "creative interpretation"
 				 * on the part of the parser. A function call
 				 * is parsed into the parse tree according to
@@ -206,69 +206,64 @@ enum Marks {
 				 * include such exceptional handling in the
 				 * code against the need we would otherwise
 				 * have for more lexeme categories. */
-#define START		(UNARY | 4)
-				/* This lexeme isn't parsed from the
+    START = (UNARY | 4),	/* This lexeme isn't parsed from the
 				 * expression text at all. It represents the
 				 * start of the expression and sits at the
 				 * root of the parse tree where it serves as
 				 * the start/end point of traversals. */
-#define OPEN_PAREN	(UNARY | 5)
-				/* Another bit of creative interpretation,
+    OPEN_PAREN = (UNARY | 5),	/* Another bit of creative interpretation,
 				 * where we treat "(" as a unary operator with
 				 * the sub-expression between it and its
 				 * matching ")" as its operand. See
 				 * CLOSE_PAREN below. */
-#define NOT		(UNARY | 6)
-#define BIT_NOT		(UNARY | 7)
+    NOT = (UNARY | 6),
+    BIT_NOT = (UNARY | 7)
+};
 
 /* Binary operator lexemes */
 
-#define BINARY_PLUS	(BINARY |  PLUS)
-#define BINARY_MINUS	(BINARY |  MINUS)
-#define COMMA		(BINARY |  3)
-				/* The "," operator is a low precedence binary
+enum {
+    BINARY_PLUS = (BINARY |  PLUS),
+    BINARY_MINUS = (BINARY |  MINUS),
+    COMMA = (BINARY | 3),	/* The "," operator is a low precedence binary
 				 * operator that separates the arguments in a
 				 * function call. The additional constraint
 				 * that this operator can only legally appear
 				 * at the right places within a function call
 				 * argument list are hard coded within
 				 * ParseExpr().  */
-#define MULT		(BINARY |  4)
-#define DIVIDE		(BINARY |  5)
-#define MOD		(BINARY |  6)
-#define LESS		(BINARY |  7)
-#define GREATER		(BINARY |  8)
-#define BIT_AND		(BINARY |  9)
-#define BIT_XOR		(BINARY | 10)
-#define BIT_OR		(BINARY | 11)
-#define QUESTION	(BINARY | 12)
-				/* These two lexemes make up the */
-#define COLON		(BINARY | 13)
-				/* ternary conditional operator, $x ? $y : $z.
+    MULT = (BINARY | 4),
+    DIVIDE = (BINARY | 5),
+    MOD = (BINARY | 6),
+    LESS = (BINARY | 7),
+    GREATER = (BINARY | 8),
+    BIT_AND = (BINARY | 9),
+    BIT_XOR = (BINARY | 10),
+    BIT_OR = (BINARY | 11),
+    QUESTION = (BINARY | 12),	/* These two lexemes make up the */
+    COLON = (BINARY | 13),	/* ternary conditional operator, $x ? $y : $z.
 				 * We treat them as two binary operators to
 				 * avoid another lexeme category, and code the
 				 * additional constraints directly in
 				 * ParseExpr(). For instance, the right
 				 * operand of a "?" operator must be a ":"
 				 * operator. */
-#define LEFT_SHIFT	(BINARY | 14)
-#define RIGHT_SHIFT	(BINARY | 15)
-#define LEQ		(BINARY | 16)
-#define GEQ		(BINARY | 17)
-#define EQUAL		(BINARY | 18)
-#define NEQ		(BINARY | 19)
-#define AND		(BINARY | 20)
-#define OR		(BINARY | 21)
-#define STREQ		(BINARY | 22)
-#define STRNEQ		(BINARY | 23)
-#define EXPON		(BINARY | 24)
-				/* Unlike the other binary operators, EXPON is
+    LEFT_SHIFT = (BINARY | 14),
+    RIGHT_SHIFT = (BINARY | 15),
+    LEQ = (BINARY | 16),
+    GEQ = (BINARY | 17),
+    EQUAL = (BINARY | 18),
+    NEQ = (BINARY | 19),
+    AND = (BINARY | 20),
+    OR = (BINARY | 21),
+    STREQ = (BINARY | 22),
+    STRNEQ = (BINARY | 23),
+    EXPON = (BINARY | 24),	/* Unlike the other binary operators, EXPON is
 				 * right associative and this distinction is
 				 * coded directly in ParseExpr(). */
-#define IN_LIST		(BINARY | 25)
-#define NOT_IN_LIST	(BINARY | 26)
-#define CLOSE_PAREN	(BINARY | 27)
-				/* By categorizing the CLOSE_PAREN lexeme as a
+    IN_LIST = (BINARY | 25),
+    NOT_IN_LIST = (BINARY | 26),
+    CLOSE_PAREN = (BINARY | 27),/* By categorizing the CLOSE_PAREN lexeme as a
 				 * BINARY operator, the normal parsing rules
 				 * for binary operators assure that a close
 				 * paren will not directly follow another
@@ -283,17 +278,17 @@ enum Marks {
 				 * parse tree. The sub-expression between
 				 * parens becomes the single argument of the
 				 * matching OPEN_PAREN unary operator. */
-#define STR_LT		(BINARY | 28)
-#define STR_GT		(BINARY | 29)
-#define STR_LEQ		(BINARY | 30)
-#define STR_GEQ		(BINARY | 31)
-#define END		(BINARY | 32)
-				/* This lexeme represents the end of the
+    STR_LT = (BINARY | 28),
+    STR_GT = (BINARY | 29),
+    STR_LEQ = (BINARY | 30),
+    STR_GEQ = (BINARY | 31),
+    END = (BINARY | 32)		/* This lexeme represents the end of the
 				 * string being parsed. Treating it as a
 				 * binary operator follows the same logic as
 				 * the CLOSE_PAREN lexeme and END pairs with
 				 * START, in the same way that CLOSE_PAREN
 				 * pairs with OPEN_PAREN. */
+};
 
 /*
  * When ParseExpr() builds the parse tree it must choose which operands to
@@ -2145,7 +2140,7 @@ ParseLexeme(
      */
 
     if (!TclIsBareword(*start) || *start == '_') {
-	if (TclUCS4Complete(start, numBytes)) {
+	if (Tcl_UtfCharComplete(start, numBytes)) {
 	    scanned = TclUtfToUCS4(start, &ch);
 	} else {
 	    char utfBytes[8];
@@ -2680,9 +2675,10 @@ TclSortingOpCmd(
 	Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1));
     } else {
 	TclOpCmdClientData *occdPtr = (TclOpCmdClientData *)clientData;
-	Tcl_Obj **litObjv = (Tcl_Obj **)TclStackAlloc(interp,
+	Tcl_Obj **litObjv = (Tcl_Obj **) TclStackAlloc(interp,
 		2 * (objc-2) * sizeof(Tcl_Obj *));
-	OpNode *nodes = (OpNode *)TclStackAlloc(interp, 2 * (objc-2) * sizeof(OpNode));
+	OpNode *nodes = (OpNode *)
+		TclStackAlloc(interp, 2 * (objc-2) * sizeof(OpNode));
 	unsigned char lexeme;
 	int i, lastAnd = 1;
 	Tcl_Obj *const *litObjPtrPtr = litObjv;

generic/tclConfig.c

@@ -178,7 +178,7 @@ Tcl_RegisterConfig(
  * QueryConfigObjCmd --
  *
  *	Implementation of "::<package>::pkgconfig", the command to query
- *	configuration information embedded into a binary library.
+ *	configuration information embedded into a library.
  *
  * Results:
  *	A standard tcl result.

generic/tclDecls.h

@@ -749,10 +749,10 @@ EXTERN int		Tcl_SplitList(Tcl_Interp *interp,
 EXTERN void		Tcl_SplitPath(const char *path, int *argcPtr,
 				const char ***argvPtr);
 /* 244 */
-EXTERN void		Tcl_StaticPackage(Tcl_Interp *interp,
-				const char *pkgName,
-				Tcl_PackageInitProc *initProc,
-				Tcl_PackageInitProc *safeInitProc);
+EXTERN void		Tcl_StaticLibrary(Tcl_Interp *interp,
+				const char *prefix,
+				Tcl_LibraryInitProc *initProc,
+				Tcl_LibraryInitProc *safeInitProc);
 /* 245 */
 TCL_DEPRECATED("No longer in use, changed to macro")
 int			Tcl_StringMatch(const char *str, const char *pattern);
@@ -999,7 +999,7 @@ EXTERN int		Tcl_UniCharToUtf(int ch, char *buf);
 /* 325 */
 EXTERN const char *	Tcl_UtfAtIndex(const char *src, int index);
 /* 326 */
-EXTERN int		Tcl_UtfCharComplete(const char *src, int length);
+EXTERN int		TclUtfCharComplete(const char *src, int length);
 /* 327 */
 EXTERN int		Tcl_UtfBackslash(const char *src, int *readPtr,
 				char *dst);
@@ -1008,9 +1008,9 @@ EXTERN const char *	Tcl_UtfFindFirst(const char *src, int ch);
 /* 329 */
 EXTERN const char *	Tcl_UtfFindLast(const char *src, int ch);
 /* 330 */
-EXTERN const char *	Tcl_UtfNext(const char *src);
+EXTERN const char *	TclUtfNext(const char *src);
 /* 331 */
-EXTERN const char *	Tcl_UtfPrev(const char *src, const char *start);
+EXTERN const char *	TclUtfPrev(const char *src, const char *start);
 /* 332 */
 EXTERN int		Tcl_UtfToExternal(Tcl_Interp *interp,
 				Tcl_Encoding encoding, const char *src,
@@ -1338,8 +1338,8 @@ EXTERN int		Tcl_FSDeleteFile(Tcl_Obj *pathPtr);
 /* 444 */
 EXTERN int		Tcl_FSLoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
 				const char *sym1, const char *sym2,
-				Tcl_PackageInitProc **proc1Ptr,
-				Tcl_PackageInitProc **proc2Ptr,
+				Tcl_LibraryInitProc **proc1Ptr,
+				Tcl_LibraryInitProc **proc2Ptr,
 				Tcl_LoadHandle *handlePtr,
 				Tcl_FSUnloadFileProc **unloadProcPtr);
 /* 445 */
@@ -1464,10 +1464,10 @@ EXTERN void		Tcl_SetWideIntObj(Tcl_Obj *objPtr,
 /* 490 */
 EXTERN Tcl_StatBuf *	Tcl_AllocStatBuf(void);
 /* 491 */
-EXTERN Tcl_WideInt	Tcl_Seek(Tcl_Channel chan, Tcl_WideInt offset,
+EXTERN long long	Tcl_Seek(Tcl_Channel chan, long long offset,
 				int mode);
 /* 492 */
-EXTERN Tcl_WideInt	Tcl_Tell(Tcl_Channel chan);
+EXTERN long long	Tcl_Tell(Tcl_Channel chan);
 /* 493 */
 EXTERN Tcl_DriverWideSeekProc * Tcl_ChannelWideSeekProc(
 				const Tcl_ChannelType *chanTypePtr);
@@ -1665,7 +1665,7 @@ EXTERN int		Tcl_TakeBignumFromObj(Tcl_Interp *interp,
 				Tcl_Obj *obj, void *value);
 /* 560 */
 EXTERN int		Tcl_TruncateChannel(Tcl_Channel chan,
-				Tcl_WideInt length);
+				long long length);
 /* 561 */
 EXTERN Tcl_DriverTruncateProc * Tcl_ChannelTruncateProc(
 				const Tcl_ChannelType *chanTypePtr);
@@ -1771,16 +1771,16 @@ EXTERN int		Tcl_GetGroupIdFromStat(const Tcl_StatBuf *statPtr);
 /* 595 */
 EXTERN int		Tcl_GetDeviceTypeFromStat(const Tcl_StatBuf *statPtr);
 /* 596 */
-EXTERN Tcl_WideInt	Tcl_GetAccessTimeFromStat(const Tcl_StatBuf *statPtr);
+EXTERN long long	Tcl_GetAccessTimeFromStat(const Tcl_StatBuf *statPtr);
 /* 597 */
-EXTERN Tcl_WideInt	Tcl_GetModificationTimeFromStat(
+EXTERN long long	Tcl_GetModificationTimeFromStat(
 				const Tcl_StatBuf *statPtr);
 /* 598 */
-EXTERN Tcl_WideInt	Tcl_GetChangeTimeFromStat(const Tcl_StatBuf *statPtr);
+EXTERN long long	Tcl_GetChangeTimeFromStat(const Tcl_StatBuf *statPtr);
 /* 599 */
-EXTERN Tcl_WideUInt	Tcl_GetSizeFromStat(const Tcl_StatBuf *statPtr);
+EXTERN unsigned long long Tcl_GetSizeFromStat(const Tcl_StatBuf *statPtr);
 /* 600 */
-EXTERN Tcl_WideUInt	Tcl_GetBlocksFromStat(const Tcl_StatBuf *statPtr);
+EXTERN unsigned long long Tcl_GetBlocksFromStat(const Tcl_StatBuf *statPtr);
 /* 601 */
 EXTERN unsigned		Tcl_GetBlockSizeFromStat(const Tcl_StatBuf *statPtr);
 /* 602 */
@@ -1931,6 +1931,12 @@ EXTERN Tcl_UniChar *	TclGetUnicodeFromObj(Tcl_Obj *objPtr,
 /* 653 */
 EXTERN unsigned char *	TclGetByteArrayFromObj(Tcl_Obj *objPtr,
 				size_t *lengthPtr);
+/* 654 */
+EXTERN int		Tcl_UtfCharComplete(const char *src, int length);
+/* 655 */
+EXTERN const char *	Tcl_UtfNext(const char *src);
+/* 656 */
+EXTERN const char *	Tcl_UtfPrev(const char *src, const char *start);
 
 typedef struct {
     const struct TclPlatStubs *tclPlatStubs;
@@ -2210,7 +2216,7 @@ typedef struct TclStubs {
     void (*tcl_SourceRCFile) (Tcl_Interp *interp); /* 241 */
     int (*tcl_SplitList) (Tcl_Interp *interp, const char *listStr, int *argcPtr, const char ***argvPtr); /* 242 */
     void (*tcl_SplitPath) (const char *path, int *argcPtr, const char ***argvPtr); /* 243 */
-    TCL_DEPRECATED_API("Don't use this function in a stub-enabled extension") void (*tcl_StaticPackage) (Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 244 */
+    TCL_DEPRECATED_API("Don't use this function in a stub-enabled extension") void (*tcl_StaticLibrary) (Tcl_Interp *interp, const char *prefix, Tcl_LibraryInitProc *initProc, Tcl_LibraryInitProc *safeInitProc); /* 244 */
     TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_StringMatch) (const char *str, const char *pattern); /* 245 */
     TCL_DEPRECATED_API("") int (*tcl_TellOld) (Tcl_Channel chan); /* 246 */
     TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_TraceVar) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 247 */
@@ -2292,12 +2298,12 @@ typedef struct TclStubs {
     int (*tcl_UniCharToUpper) (int ch); /* 323 */
     int (*tcl_UniCharToUtf) (int ch, char *buf); /* 324 */
     const char * (*tcl_UtfAtIndex) (const char *src, int index); /* 325 */
-    int (*tcl_UtfCharComplete) (const char *src, int length); /* 326 */
+    int (*tclUtfCharComplete) (const char *src, int length); /* 326 */
     int (*tcl_UtfBackslash) (const char *src, int *readPtr, char *dst); /* 327 */
     const char * (*tcl_UtfFindFirst) (const char *src, int ch); /* 328 */
     const char * (*tcl_UtfFindLast) (const char *src, int ch); /* 329 */
-    const char * (*tcl_UtfNext) (const char *src); /* 330 */
-    const char * (*tcl_UtfPrev) (const char *src, const char *start); /* 331 */
+    const char * (*tclUtfNext) (const char *src); /* 330 */
+    const char * (*tclUtfPrev) (const char *src, const char *start); /* 331 */
     int (*tcl_UtfToExternal) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 332 */
     char * (*tcl_UtfToExternalDString) (Tcl_Encoding encoding, const char *src, int srcLen, Tcl_DString *dsPtr); /* 333 */
     int (*tcl_UtfToLower) (char *src); /* 334 */
@@ -2410,7 +2416,7 @@ typedef struct TclStubs {
     int (*tcl_FSCopyDirectory) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr); /* 441 */
     int (*tcl_FSCreateDirectory) (Tcl_Obj *pathPtr); /* 442 */
     int (*tcl_FSDeleteFile) (Tcl_Obj *pathPtr); /* 443 */
-    int (*tcl_FSLoadFile) (Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *sym1, const char *sym2, Tcl_PackageInitProc **proc1Ptr, Tcl_PackageInitProc **proc2Ptr, Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr); /* 444 */
+    int (*tcl_FSLoadFile) (Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *sym1, const char *sym2, Tcl_LibraryInitProc **proc1Ptr, Tcl_LibraryInitProc **proc2Ptr, Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr); /* 444 */
     int (*tcl_FSMatchInDirectory) (Tcl_Interp *interp, Tcl_Obj *result, Tcl_Obj *pathPtr, const char *pattern, Tcl_GlobTypeData *types); /* 445 */
     Tcl_Obj * (*tcl_FSLink) (Tcl_Obj *pathPtr, Tcl_Obj *toPtr, int linkAction); /* 446 */
     int (*tcl_FSRemoveDirectory) (Tcl_Obj *pathPtr, int recursive, Tcl_Obj **errorPtr); /* 447 */
@@ -2457,8 +2463,8 @@ typedef struct TclStubs {
     Tcl_Obj * (*tcl_NewWideIntObj) (Tcl_WideInt wideValue); /* 488 */
     void (*tcl_SetWideIntObj) (Tcl_Obj *objPtr, Tcl_WideInt wideValue); /* 489 */
     Tcl_StatBuf * (*tcl_AllocStatBuf) (void); /* 490 */
-    Tcl_WideInt (*tcl_Seek) (Tcl_Channel chan, Tcl_WideInt offset, int mode); /* 491 */
-    Tcl_WideInt (*tcl_Tell) (Tcl_Channel chan); /* 492 */
+    long long (*tcl_Seek) (Tcl_Channel chan, long long offset, int mode); /* 491 */
+    long long (*tcl_Tell) (Tcl_Channel chan); /* 492 */
     Tcl_DriverWideSeekProc * (*tcl_ChannelWideSeekProc) (const Tcl_ChannelType *chanTypePtr); /* 493 */
     int (*tcl_DictObjPut) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr, Tcl_Obj *valuePtr); /* 494 */
     int (*tcl_DictObjGet) (Tcl_Interp *interp, Tcl_Obj *dictPtr, Tcl_Obj *keyPtr, Tcl_Obj **valuePtrPtr); /* 495 */
@@ -2526,7 +2532,7 @@ typedef struct TclStubs {
     void (*tcl_SetBignumObj) (Tcl_Obj *obj, void *value); /* 557 */
     int (*tcl_GetBignumFromObj) (Tcl_Interp *interp, Tcl_Obj *obj, void *value); /* 558 */
     int (*tcl_TakeBignumFromObj) (Tcl_Interp *interp, Tcl_Obj *obj, void *value); /* 559 */
-    int (*tcl_TruncateChannel) (Tcl_Channel chan, Tcl_WideInt length); /* 560 */
+    int (*tcl_TruncateChannel) (Tcl_Channel chan, long long length); /* 560 */
     Tcl_DriverTruncateProc * (*tcl_ChannelTruncateProc) (const Tcl_ChannelType *chanTypePtr); /* 561 */
     void (*tcl_SetChannelErrorInterp) (Tcl_Interp *interp, Tcl_Obj *msg); /* 562 */
     void (*tcl_GetChannelErrorInterp) (Tcl_Interp *interp, Tcl_Obj **msg); /* 563 */
@@ -2562,11 +2568,11 @@ typedef struct TclStubs {
     int (*tcl_GetUserIdFromStat) (const Tcl_StatBuf *statPtr); /* 593 */
     int (*tcl_GetGroupIdFromStat) (const Tcl_StatBuf *statPtr); /* 594 */
     int (*tcl_GetDeviceTypeFromStat) (const Tcl_StatBuf *statPtr); /* 595 */
-    Tcl_WideInt (*tcl_GetAccessTimeFromStat) (const Tcl_StatBuf *statPtr); /* 596 */
-    Tcl_WideInt (*tcl_GetModificationTimeFromStat) (const Tcl_StatBuf *statPtr); /* 597 */
-    Tcl_WideInt (*tcl_GetChangeTimeFromStat) (const Tcl_StatBuf *statPtr); /* 598 */
-    Tcl_WideUInt (*tcl_GetSizeFromStat) (const Tcl_StatBuf *statPtr); /* 599 */
-    Tcl_WideUInt (*tcl_GetBlocksFromStat) (const Tcl_StatBuf *statPtr); /* 600 */
+    long long (*tcl_GetAccessTimeFromStat) (const Tcl_StatBuf *statPtr); /* 596 */
+    long long (*tcl_GetModificationTimeFromStat) (const Tcl_StatBuf *statPtr); /* 597 */
+    long long (*tcl_GetChangeTimeFromStat) (const Tcl_StatBuf *statPtr); /* 598 */
+    unsigned long long (*tcl_GetSizeFromStat) (const Tcl_StatBuf *statPtr); /* 599 */
+    unsigned long long (*tcl_GetBlocksFromStat) (const Tcl_StatBuf *statPtr); /* 600 */
     unsigned (*tcl_GetBlockSizeFromStat) (const Tcl_StatBuf *statPtr); /* 601 */
     int (*tcl_SetEnsembleParameterList) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj *paramList); /* 602 */
     int (*tcl_GetEnsembleParameterList) (Tcl_Interp *interp, Tcl_Command token, Tcl_Obj **paramListPtr); /* 603 */
@@ -2620,6 +2626,9 @@ typedef struct TclStubs {
     char * (*tclGetStringFromObj) (Tcl_Obj *objPtr, size_t *lengthPtr); /* 651 */
     Tcl_UniChar * (*tclGetUnicodeFromObj) (Tcl_Obj *objPtr, size_t *lengthPtr); /* 652 */
     unsigned char * (*tclGetByteArrayFromObj) (Tcl_Obj *objPtr, size_t *lengthPtr); /* 653 */
+    int (*tcl_UtfCharComplete) (const char *src, int length); /* 654 */
+    const char * (*tcl_UtfNext) (const char *src); /* 655 */
+    const char * (*tcl_UtfPrev) (const char *src, const char *start); /* 656 */
 } TclStubs;
 
 extern const TclStubs *tclStubsPtr;
@@ -3139,8 +3148,8 @@ extern const TclStubs *tclStubsPtr;
 	(tclStubsPtr->tcl_SplitList) /* 242 */
 #define Tcl_SplitPath \
 	(tclStubsPtr->tcl_SplitPath) /* 243 */
-#define Tcl_StaticPackage \
-	(tclStubsPtr->tcl_StaticPackage) /* 244 */
+#define Tcl_StaticLibrary \
+	(tclStubsPtr->tcl_StaticLibrary) /* 244 */
 #define Tcl_StringMatch \
 	(tclStubsPtr->tcl_StringMatch) /* 245 */
 #define Tcl_TellOld \
@@ -3302,18 +3311,18 @@ extern const TclStubs *tclStubsPtr;
 	(tclStubsPtr->tcl_UniCharToUtf) /* 324 */
 #define Tcl_UtfAtIndex \
 	(tclStubsPtr->tcl_UtfAtIndex) /* 325 */
-#define Tcl_UtfCharComplete \
-	(tclStubsPtr->tcl_UtfCharComplete) /* 326 */
+#define TclUtfCharComplete \
+	(tclStubsPtr->tclUtfCharComplete) /* 326 */
 #define Tcl_UtfBackslash \
 	(tclStubsPtr->tcl_UtfBackslash) /* 327 */
 #define Tcl_UtfFindFirst \
 	(tclStubsPtr->tcl_UtfFindFirst) /* 328 */
 #define Tcl_UtfFindLast \
 	(tclStubsPtr->tcl_UtfFindLast) /* 329 */
-#define Tcl_UtfNext \
-	(tclStubsPtr->tcl_UtfNext) /* 330 */
-#define Tcl_UtfPrev \
-	(tclStubsPtr->tcl_UtfPrev) /* 331 */
+#define TclUtfNext \
+	(tclStubsPtr->tclUtfNext) /* 330 */
+#define TclUtfPrev \
+	(tclStubsPtr->tclUtfPrev) /* 331 */
 #define Tcl_UtfToExternal \
 	(tclStubsPtr->tcl_UtfToExternal) /* 332 */
 #define Tcl_UtfToExternalDString \
@@ -3956,11 +3965,18 @@ extern const TclStubs *tclStubsPtr;
 	(tclStubsPtr->tclGetUnicodeFromObj) /* 652 */
 #define TclGetByteArrayFromObj \
 	(tclStubsPtr->tclGetByteArrayFromObj) /* 653 */
+#define Tcl_UtfCharComplete \
+	(tclStubsPtr->tcl_UtfCharComplete) /* 654 */
+#define Tcl_UtfNext \
+	(tclStubsPtr->tcl_UtfNext) /* 655 */
+#define Tcl_UtfPrev \
+	(tclStubsPtr->tcl_UtfPrev) /* 656 */
 
 #endif /* defined(USE_TCL_STUBS) */
 
 /* !END!: Do not edit above this line. */
 
+#undef TclUnusedStubEntry
 #if defined(USE_TCL_STUBS)
 #   undef Tcl_CreateInterp
 #   undef Tcl_FindExecutable
@@ -3969,7 +3985,7 @@ extern const TclStubs *tclStubsPtr;
 #   undef Tcl_SetPanicProc
 #   undef Tcl_SetExitProc
 #   undef Tcl_ObjSetVar2
-#   undef Tcl_StaticPackage
+#   undef Tcl_StaticLibrary
 #   define Tcl_CreateInterp() (tclStubsPtr->tcl_CreateInterp())
 #   define Tcl_GetStringResult(interp) (tclStubsPtr->tcl_GetStringResult(interp))
 #   define Tcl_Init(interp) (tclStubsPtr->tcl_Init(interp))
@@ -4138,28 +4154,35 @@ extern const TclStubs *tclStubsPtr;
 #   endif
 #endif
 
+#undef Tcl_GetString
+#undef Tcl_GetUnicode
+#define Tcl_GetString(objPtr) \
+	Tcl_GetStringFromObj(objPtr, (int *)NULL)
+#define Tcl_GetUnicode(objPtr) \
+	Tcl_GetUnicodeFromObj(objPtr, (int *)NULL)
+#ifdef TCL_NO_DEPRECATED
 #undef Tcl_GetStringFromObj
 #undef Tcl_GetUnicodeFromObj
 #undef Tcl_GetByteArrayFromObj
-#undef Tcl_GetUnicode
+#endif
 #if defined(USE_TCL_STUBS)
+#ifdef TCL_NO_DEPRECATED
 #define Tcl_GetStringFromObj(objPtr, sizePtr) \
 	(sizeof(*sizePtr) <= sizeof(int) ? tclStubsPtr->tcl_GetStringFromObj(objPtr, (int *)sizePtr) : tclStubsPtr->tclGetStringFromObj(objPtr, (size_t *)sizePtr))
 #define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \
 	(sizeof(*sizePtr) <= sizeof(int) ? tclStubsPtr->tcl_GetByteArrayFromObj(objPtr, (int *)sizePtr) : tclStubsPtr->tclGetByteArrayFromObj(objPtr, (size_t *)sizePtr))
 #define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \
 	(sizeof(*sizePtr) <= sizeof(int) ? tclStubsPtr->tcl_GetUnicodeFromObj(objPtr, (int *)sizePtr) : tclStubsPtr->tclGetUnicodeFromObj(objPtr, (size_t *)sizePtr))
-#define Tcl_GetUnicode(objPtr) \
-	tclStubsPtr->tcl_GetUnicodeFromObj(objPtr, NULL)
+#endif
 #else
+#ifdef TCL_NO_DEPRECATED
 #define Tcl_GetStringFromObj(objPtr, sizePtr) \
 	(sizeof(*sizePtr) <= sizeof(int) ? (Tcl_GetStringFromObj)(objPtr, (int *)sizePtr) : (TclGetStringFromObj)(objPtr, (size_t *)sizePtr))
 #define Tcl_GetByteArrayFromObj(objPtr, sizePtr) \
 	(sizeof(*sizePtr) <= sizeof(int) ? (Tcl_GetByteArrayFromObj)(objPtr, (int *)sizePtr) : TclGetByteArrayFromObj(objPtr, (size_t *)sizePtr))
 #define Tcl_GetUnicodeFromObj(objPtr, sizePtr) \
 	(sizeof(*sizePtr) <= sizeof(int) ? (Tcl_GetUnicodeFromObj)(objPtr, (int *)sizePtr) : TclGetUnicodeFromObj(objPtr, (size_t *)sizePtr))
-#define Tcl_GetUnicode(objPtr) \
-	(Tcl_GetUnicodeFromObj)(objPtr, NULL)
+#endif
 #endif
 
 #undef Tcl_NewLongObj
@@ -4223,10 +4246,16 @@ extern const TclStubs *tclStubsPtr;
 #define Tcl_Close(interp, chan) Tcl_CloseEx(interp, chan, 0)
 #endif
 
-#if defined(USE_TCL_STUBS) && (TCL_UTF_MAX > 3)
+#undef TclUtfCharComplete
+#undef TclUtfNext
+#undef TclUtfPrev
+#if defined(USE_TCL_STUBS) && (TCL_UTF_MAX < 4) && !defined(TCL_NO_DEPRECATED)
 #   undef Tcl_UtfCharComplete
-#   define Tcl_UtfCharComplete(src, length) (((unsigned)((unsigned char)*(src) - 0xF0) < 5) \
-	    ? ((length) >= 4) : tclStubsPtr->tcl_UtfCharComplete((src), (length)))
+#   undef Tcl_UtfNext
+#   undef Tcl_UtfPrev
+#   define Tcl_UtfCharComplete (tclStubsPtr->tclUtfCharComplete)
+#   define Tcl_UtfNext (tclStubsPtr->tclUtfNext)
+#   define Tcl_UtfPrev (tclStubsPtr->tclUtfPrev)
 #endif
 #define Tcl_CreateSlave Tcl_CreateChild
 #define Tcl_GetSlave Tcl_GetChild

generic/tclDictObj.c

@@ -950,7 +950,7 @@ Tcl_DictObjPut(
     TclInvalidateStringRep(dictPtr);
     hPtr = CreateChainEntry(dict, keyPtr, &isNew);
     dict->refCount++;
-    TclFreeIntRep(dictPtr)
+    TclFreeIntRep(dictPtr);
     DictSetIntRep(dictPtr, dict);
     Tcl_IncrRefCount(valuePtr);
     if (!isNew) {

generic/tclDisassemble.c

@@ -53,12 +53,11 @@ static const Tcl_ObjType instNameType = {
 
 #define InstNameGetIntRep(objPtr, inst)				\
     do {							\
-	const Tcl_ObjIntRep *irPtr;				\
-	irPtr = TclFetchIntRep((objPtr), &instNameType);	\
+	const Tcl_ObjIntRep *irPtr =				\
+		TclFetchIntRep((objPtr), &instNameType);	\
 	assert(irPtr != NULL);					\
-	(inst) = (size_t)irPtr->wideValue;			\
+	(inst) = (size_t) irPtr->wideValue;			\
     } while (0)
-
 
 /*
  *----------------------------------------------------------------------

generic/tclEncoding.c

@@ -116,7 +116,8 @@ typedef struct {
 				 * entry in this array is 1, otherwise it is
 				 * 0. */
     int numSubTables;		/* Length of following array. */
-    EscapeSubTable subTables[TCLFLEXARRAY];/* Information about each EscapeSubTable used
+    EscapeSubTable subTables[TCLFLEXARRAY];
+				/* Information about each EscapeSubTable used
 				 * by this encoding type. The actual size is
 				 * as large as necessary to hold all
 				 * EscapeSubTables. */
@@ -127,10 +128,12 @@ typedef struct {
  * file.
  */
 
-#define ENCODING_SINGLEBYTE	0
-#define ENCODING_DOUBLEBYTE	1
-#define ENCODING_MULTIBYTE	2
-#define ENCODING_ESCAPE		3
+enum {
+    ENCODING_SINGLEBYTE = 0,
+    ENCODING_DOUBLEBYTE = 1,
+    ENCODING_MULTIBYTE = 2,
+    ENCODING_ESCAPE = 3
+};
 
 /*
  * A list of directories in which Tcl should look for *.enc files. This list
@@ -220,14 +223,7 @@ static size_t			unilen(const char *src);
 static Tcl_EncodingConvertProc	Utf16ToUtfProc;
 static Tcl_EncodingConvertProc	UtfToUtf16Proc;
 static Tcl_EncodingConvertProc	UtfToUcs2Proc;
-static int              	UtfToUtfProc(ClientData clientData,
-	                            const char *src, int srcLen, int flags,
-       		                    Tcl_EncodingState *statePtr, char *dst,
-				    int dstLen, int *srcReadPtr,
-				    int *dstWrotePtr, int *dstCharsPtr,
-				    int pureNullMode);
-static Tcl_EncodingConvertProc	UtfIntToUtfExtProc;
-static Tcl_EncodingConvertProc	UtfExtToUtfIntProc;
+static Tcl_EncodingConvertProc	UtfToUtfProc;
 static Tcl_EncodingConvertProc	Iso88591FromUtfProc;
 static Tcl_EncodingConvertProc	Iso88591ToUtfProc;
 
@@ -240,7 +236,7 @@ static Tcl_EncodingConvertProc	Iso88591ToUtfProc;
 static const Tcl_ObjType encodingType = {
     "encoding", FreeEncodingIntRep, DupEncodingIntRep, NULL, NULL
 };
-#define EncodingSetIntRep(objPtr, encoding)				\
+#define EncodingSetIntRep(objPtr, encoding) \
     do {								\
 	Tcl_ObjIntRep ir;						\
 	ir.twoPtrValue.ptr1 = (encoding);				\
@@ -248,7 +244,7 @@ static const Tcl_ObjType encodingType = {
 	Tcl_StoreIntRep((objPtr), &encodingType, &ir);			\
     } while (0)
 
-#define EncodingGetIntRep(objPtr, encoding)				\
+#define EncodingGetIntRep(objPtr, encoding) \
     do {								\
 	const Tcl_ObjIntRep *irPtr;					\
 	irPtr = TclFetchIntRep ((objPtr), &encodingType);		\
@@ -517,6 +513,18 @@ FillEncodingFileMap(void)
  *---------------------------------------------------------------------------
  */
 
+enum {
+    /* This flags must not conflict with other TCL_ENCODING_* flags in tcl.h */
+    TCL_ENCODING_MODIFIED = 0x20, /* Converting NULL bytes to 0xC0 0x80 */
+
+    /*
+     * Since TCL_ENCODING_MODIFIED is only used for utf-8 and TCL_ENCODING_LE
+     * is only used for utf-16/ucs-2, re-use the same value
+     */
+
+    TCL_ENCODING_LE = TCL_ENCODING_MODIFIED /* Little-endian encoding */
+};
+
 void
 TclInitEncodingSubsystem(void)
 {
@@ -533,7 +541,7 @@ TclInitEncodingSubsystem(void)
 	return;
     }
 
-    isLe.s = 1;
+    isLe.s = TCL_ENCODING_LE;
     Tcl_MutexLock(&encodingMutex);
     Tcl_InitHashTable(&encodingTable, TCL_STRING_KEYS);
     Tcl_MutexUnlock(&encodingMutex);
@@ -553,8 +561,8 @@ TclInitEncodingSubsystem(void)
     tclIdentityEncoding = Tcl_CreateEncoding(&type);
 
     type.encodingName	= "utf-8";
-    type.toUtfProc	= UtfExtToUtfIntProc;
-    type.fromUtfProc	= UtfIntToUtfExtProc;
+    type.toUtfProc	= UtfToUtfProc;
+    type.fromUtfProc	= UtfToUtfProc;
     type.freeProc	= NULL;
     type.nullSize	= 1;
     type.clientData	= NULL;
@@ -565,7 +573,7 @@ TclInitEncodingSubsystem(void)
     type.freeProc	= NULL;
     type.nullSize	= 2;
     type.encodingName   = "ucs-2le";
-    type.clientData	= INT2PTR(1);
+    type.clientData	= INT2PTR(TCL_ENCODING_LE);
     Tcl_CreateEncoding(&type);
     type.encodingName   = "ucs-2be";
     type.clientData	= INT2PTR(0);
@@ -579,7 +587,7 @@ TclInitEncodingSubsystem(void)
     type.freeProc	= NULL;
     type.nullSize	= 2;
     type.encodingName   = "utf-16le";
-    type.clientData	= INT2PTR(1);
+    type.clientData	= INT2PTR(TCL_ENCODING_LE);
     Tcl_CreateEncoding(&type);
     type.encodingName   = "utf-16be";
     type.clientData	= INT2PTR(0);
@@ -1141,19 +1149,21 @@ Tcl_ExternalToUtfDString(
     }
 
     flags = TCL_ENCODING_START | TCL_ENCODING_END;
+    if (encodingPtr->toUtfProc == UtfToUtfProc) {
+	flags |= TCL_ENCODING_MODIFIED;
+    }
 
     while (1) {
 	result = encodingPtr->toUtfProc(encodingPtr->clientData, src, srcLen,
 		flags, &state, dst, dstLen, &srcRead, &dstWrote, &dstChars);
 	soFar = dst + dstWrote - Tcl_DStringValue(dstPtr);
 
+	src += srcRead;
 	if (result != TCL_CONVERT_NOSPACE) {
 	    Tcl_DStringSetLength(dstPtr, soFar);
 	    return Tcl_DStringValue(dstPtr);
 	}
-
 	flags &= ~TCL_ENCODING_START;
-	src += srcRead;
 	srcLen -= srcRead;
 	if (Tcl_DStringLength(dstPtr) == 0) {
 	    Tcl_DStringSetLength(dstPtr, dstLen);
@@ -1249,15 +1259,17 @@ Tcl_ExternalToUtf(
     if (!noTerminate) {
 	/*
 	 * If there are any null characters in the middle of the buffer,
-	 * they will converted to the UTF-8 null character (\xC080). To get
+	 * they will converted to the UTF-8 null character (\xC0\x80). To get
 	 * the actual \0 at the end of the destination buffer, we need to
 	 * append it manually.  First make room for it...
 	 */
 
 	dstLen--;
     }
+    if (encodingPtr->toUtfProc == UtfToUtfProc) {
+	flags |= TCL_ENCODING_MODIFIED;
+    }
     do {
-	int savedFlags = flags;
 	Tcl_EncodingState savedState = *statePtr;
 
 	result = encodingPtr->toUtfProc(encodingPtr->clientData, src, srcLen,
@@ -1267,7 +1279,6 @@ Tcl_ExternalToUtf(
 	    break;
 	}
 	dstLen = Tcl_UtfAtIndex(dst, maxChars) - dst + (TCL_UTF_MAX - 1);
-	flags = savedFlags;
 	*statePtr = savedState;
     } while (1);
     if (!noTerminate) {
@@ -1331,8 +1342,8 @@ Tcl_UtfToExternalDString(
     flags = TCL_ENCODING_START | TCL_ENCODING_END;
     while (1) {
 	result = encodingPtr->fromUtfProc(encodingPtr->clientData, src,
-		srcLen, flags, &state, dst, dstLen, &srcRead, &dstWrote,
-		&dstChars);
+		srcLen, flags, &state, dst, dstLen,
+		&srcRead, &dstWrote, &dstChars);
 	soFar = dst + dstWrote - Tcl_DStringValue(dstPtr);
 
 	if (result != TCL_CONVERT_NOSPACE) {
@@ -1433,8 +1444,8 @@ Tcl_UtfToExternal(
 
     dstLen -= encodingPtr->nullSize;
     result = encodingPtr->fromUtfProc(encodingPtr->clientData, src, srcLen,
-	    flags, statePtr, dst, dstLen, srcReadPtr, dstWrotePtr,
-	    dstCharsPtr);
+	    flags, statePtr, dst, dstLen, srcReadPtr,
+	    dstWrotePtr, dstCharsPtr);
     if (encodingPtr->nullSize == 2) {
 	dst[*dstWrotePtr + 1] = '\0';
     }
@@ -2153,104 +2164,6 @@ BinaryProc(
     return result;
 }
 
-/*
- *-------------------------------------------------------------------------
- *
- * UtfIntToUtfExtProc --
- *
- *	Convert from UTF-8 to UTF-8. While converting null-bytes from the
- *	Tcl's internal representation (0xC0, 0x80) to the official
- *	representation (0x00). See UtfToUtfProc for details.
- *
- * Results:
- *	Returns TCL_OK if conversion was successful.
- *
- * Side effects:
- *	None.
- *
- *-------------------------------------------------------------------------
- */
-
-static int
-UtfIntToUtfExtProc(
-    ClientData clientData,
-    const char *src,		/* Source string in UTF-8. */
-    int srcLen,			/* Source string length in bytes. */
-    int flags,			/* Conversion control flags. */
-    Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
-				 * information used during a piecewise
-				 * conversion. Contents of statePtr are
-				 * initialized and/or reset by conversion
-				 * routine under control of flags argument. */
-    char *dst,			/* Output buffer in which converted string
-				 * is stored. */
-    int dstLen,			/* The maximum length of output buffer in
-				 * bytes. */
-    int *srcReadPtr,		/* Filled with the number of bytes from the
-				 * source string that were converted. This may
-				 * be less than the original source length if
-				 * there was a problem converting some source
-				 * characters. */
-    int *dstWrotePtr,		/* Filled with the number of bytes that were
-				 * stored in the output buffer as a result of
-				 * the conversion. */
-    int *dstCharsPtr)		/* Filled with the number of characters that
-				 * correspond to the bytes stored in the
-				 * output buffer. */
-{
-    return UtfToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
-	    srcReadPtr, dstWrotePtr, dstCharsPtr, 1);
-}
-
-/*
- *-------------------------------------------------------------------------
- *
- * UtfExtToUtfIntProc --
- *
- *	Convert from UTF-8 to UTF-8 while converting null-bytes from the
- *	official representation (0x00) to Tcl's internal representation (0xC0,
- *	0x80). See UtfToUtfProc for details.
- *
- * Results:
- *	Returns TCL_OK if conversion was successful.
- *
- * Side effects:
- *	None.
- *
- *-------------------------------------------------------------------------
- */
-
-static int
-UtfExtToUtfIntProc(
-    ClientData clientData,
-    const char *src,		/* Source string in UTF-8. */
-    int srcLen,			/* Source string length in bytes. */
-    int flags,			/* Conversion control flags. */
-    Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
-				 * information used during a piecewise
-				 * conversion. Contents of statePtr are
-				 * initialized and/or reset by conversion
-				 * routine under control of flags argument. */
-    char *dst,			/* Output buffer in which converted string is
-				 * stored. */
-    int dstLen,			/* The maximum length of output buffer in
-				 * bytes. */
-    int *srcReadPtr,		/* Filled with the number of bytes from the
-				 * source string that were converted. This may
-				 * be less than the original source length if
-				 * there was a problem converting some source
-				 * characters. */
-    int *dstWrotePtr,		/* Filled with the number of bytes that were
-				 * stored in the output buffer as a result of
-				 * the conversion. */
-    int *dstCharsPtr)		/* Filled with the number of characters that
-				 * correspond to the bytes stored in the
-				 * output buffer. */
-{
-    return UtfToUtfProc(clientData, src, srcLen, flags, statePtr, dst, dstLen,
-	    srcReadPtr, dstWrotePtr, dstCharsPtr, 0);
-}
-
 /*
  *-------------------------------------------------------------------------
  *
@@ -2271,15 +2184,11 @@ UtfExtToUtfIntProc(
 
 static int
 UtfToUtfProc(
-    TCL_UNUSED(ClientData),
+    ClientData clientData,	/* additional flags, e.g. TCL_ENCODING_MODIFIED */
     const char *src,		/* Source string in UTF-8. */
     int srcLen,			/* Source string length in bytes. */
     int flags,			/* Conversion control flags. */
-    Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
-				 * information used during a piecewise
-				 * conversion. Contents of statePtr are
-				 * initialized and/or reset by conversion
-				 * routine under control of flags argument. */
+    TCL_UNUSED(Tcl_EncodingState *),
     char *dst,			/* Output buffer in which converted string is
 				 * stored. */
     int dstLen,			/* The maximum length of output buffer in
@@ -2292,21 +2201,15 @@ UtfToUtfProc(
     int *dstWrotePtr,		/* Filled with the number of bytes that were
 				 * stored in the output buffer as a result of
 				 * the conversion. */
-    int *dstCharsPtr,		/* Filled with the number of characters that
+    int *dstCharsPtr)		/* Filled with the number of characters that
 				 * correspond to the bytes stored in the
 				 * output buffer. */
-    int pureNullMode)		/* Convert embedded nulls from internal
-				 * representation to real null-bytes or vice
-				 * versa. Also combine or separate surrogate pairs */
 {
     const char *srcStart, *srcEnd, *srcClose;
     const char *dstStart, *dstEnd;
     int result, numChars, charLimit = INT_MAX;
-    int *chPtr = (int *) statePtr;
+    int ch;
 
-    if (flags & TCL_ENCODING_START) {
-    	*statePtr = 0;
-    }
     result = TCL_OK;
 
     srcStart = src;
@@ -2320,10 +2223,11 @@ UtfToUtfProc(
     }
 
     dstStart = dst;
+    flags |= PTR2INT(clientData);
     dstEnd = dst + dstLen - TCL_UTF_MAX;
 
     for (numChars = 0; src < srcEnd && numChars <= charLimit; numChars++) {
-	if ((src > srcClose) && (!TclUCS4Complete(src, srcEnd - src))) {
+	if ((src > srcClose) && (!Tcl_UtfCharComplete(src, srcEnd - src))) {
 	    /*
 	     * If there is more string to follow, this will ensure that the
 	     * last UTF-8 character in the source buffer hasn't been cut off.
@@ -2336,50 +2240,69 @@ UtfToUtfProc(
 	    result = TCL_CONVERT_NOSPACE;
 	    break;
 	}
-	if (UCHAR(*src) < 0x80 && !(UCHAR(*src) == 0 && pureNullMode == 0)) {
+	if (UCHAR(*src) < 0x80 && !(UCHAR(*src) == 0 && (flags & TCL_ENCODING_MODIFIED))) {
 	    /*
 	     * Copy 7bit characters, but skip null-bytes when we are in input
 	     * mode, so that they get converted to 0xC080.
 	     */
 
 	    *dst++ = *src++;
-	    *chPtr = 0; /* reset surrogate handling */
-	} else if (pureNullMode == 1 && UCHAR(*src) == 0xC0 &&
-		(src + 1 < srcEnd) && UCHAR(*(src+1)) == 0x80) {
+	} else if (UCHAR(*src) == 0xC0 && (src + 1 < srcEnd)
+		&& UCHAR(src[1]) == 0x80 && !(flags & TCL_ENCODING_MODIFIED)) {
 	    /*
 	     * Convert 0xC080 to real nulls when we are in output mode.
 	     */
 
 	    *dst++ = 0;
-	    *chPtr = 0; /* reset surrogate handling */
 	    src += 2;
-	} else if (!TclUCS4Complete(src, srcEnd - src)) {
+	} else if (!Tcl_UtfCharComplete(src, srcEnd - src)) {
 	    /*
 	     * Always check before using TclUtfToUCS4. Not doing can so
 	     * cause it run beyond the end of the buffer! If we happen such an
-	     * incomplete char its bytes are made to represent themselves.
+	     * incomplete char its bytes are made to represent themselves
+	     * unless the user has explicitly asked to be told.
 	     */
 
-	    *chPtr = UCHAR(*src);
-	    src += 1;
-	    dst += Tcl_UniCharToUtf(*chPtr, dst);
+	    if (flags & TCL_ENCODING_MODIFIED) {
+		if (flags & TCL_ENCODING_STOPONERROR) {
+		    result = TCL_CONVERT_MULTIBYTE;
+		    break;
+		}
+		ch = UCHAR(*src++);
+	    } else {
+		char chbuf[2];
+		chbuf[0] = UCHAR(*src++); chbuf[1] = 0;
+		TclUtfToUCS4(chbuf, &ch);
+	    }
+	    dst += Tcl_UniCharToUtf(ch, dst);
 	} else {
-	    src += TclUtfToUCS4(src, chPtr);
-	    if ((*chPtr | 0x7FF) == 0xDFFF) {
-		/* A surrogate character is detected, handle especially */
-		int low = *chPtr;
-		size_t len = (src <= srcEnd-3) ? TclUtfToUCS4(src, &low) : 0;
-		if (((low & ~0x3FF) != 0xDC00) || (*chPtr & 0x400)) {
-			*dst++ = (char) (((*chPtr >> 12) | 0xE0) & 0xEF);
-			*dst++ = (char) (((*chPtr >> 6) | 0x80) & 0xBF);
-			*dst++ = (char) ((*chPtr | 0x80) & 0xBF);
-			continue;
+	    int low;
+	    size_t len = TclUtfToUCS4(src, &ch);
+	    if ((len < 2) && (ch != 0) && (flags & TCL_ENCODING_STOPONERROR)
+		    && (flags & TCL_ENCODING_MODIFIED)) {
+		result = TCL_CONVERT_SYNTAX;
+		break;
+	    }
+	    src += len;
+	    if ((ch | 0x7FF) == 0xDFFF) {
+		/*
+		 * A surrogate character is detected, handle especially.
+		 */
+
+		low = ch;
+		len = (src <= srcEnd-3) ? TclUtfToUCS4(src, &low) : 0;
+
+		if (((low & ~0x3FF) != 0xDC00) || (ch & 0x400)) {
+		    *dst++ = (char) (((ch >> 12) | 0xE0) & 0xEF);
+		    *dst++ = (char) (((ch >> 6) | 0x80) & 0xBF);
+		    *dst++ = (char) ((ch | 0x80) & 0xBF);
+		    continue;
 		}
 		src += len;
-		dst += Tcl_UniCharToUtf(*chPtr, dst);
-		*chPtr = low;
+		dst += Tcl_UniCharToUtf(ch, dst);
+		ch = low;
 	    }
-	    dst += Tcl_UniCharToUtf(*chPtr, dst);
+	    dst += Tcl_UniCharToUtf(ch, dst);
 	}
     }
 
@@ -2407,7 +2330,7 @@ UtfToUtfProc(
 
 static int
 Utf16ToUtfProc(
-    ClientData clientData,	/* != NULL means LE, == NUL means BE */
+    ClientData clientData,	/* additional flags, e.g. TCL_ENCODING_LE */
     const char *src,		/* Source string in Unicode. */
     int srcLen,			/* Source string length in bytes. */
     int flags,			/* Conversion control flags. */
@@ -2433,18 +2356,27 @@ Utf16ToUtfProc(
     int result, numChars, charLimit = INT_MAX;
     unsigned short ch;
 
+    flags |= PTR2INT(clientData);
     if (flags & TCL_ENCODING_CHAR_LIMIT) {
 	charLimit = *dstCharsPtr;
     }
     result = TCL_OK;
 
-    /* check alignment with utf-16 (2 == sizeof(UTF-16)) */
+    /*
+     * Check alignment with utf-16 (2 == sizeof(UTF-16))
+     */
+
     if ((srcLen % 2) != 0) {
 	result = TCL_CONVERT_MULTIBYTE;
 	srcLen--;
     }
-    /* If last code point is a high surrogate, we cannot handle that yet */
-    if ((srcLen >= 2) && ((src[srcLen - (clientData?1:2)] & 0xFC) == 0xD8)) {
+
+    /*
+     * If last code point is a high surrogate, we cannot handle that yet.
+     */
+
+    if ((srcLen >= 2) &&
+	    ((src[srcLen - ((flags & TCL_ENCODING_LE)?1:2)] & 0xFC) == 0xD8)) {
 	result = TCL_CONVERT_MULTIBYTE;
 	srcLen-= 2;
     }
@@ -2461,15 +2393,17 @@ Utf16ToUtfProc(
 	    break;
 	}
 
-	if (clientData) {
+	if (flags & TCL_ENCODING_LE) {
 	    ch = (src[1] & 0xFF) << 8 | (src[0] & 0xFF);
 	} else {
 	    ch = (src[0] & 0xFF) << 8 | (src[1] & 0xFF);
 	}
+
 	/*
 	 * Special case for 1-byte utf chars for speed. Make sure we work with
 	 * unsigned short-size data.
 	 */
+
 	if (ch && ch < 0x80) {
 	    *dst++ = (ch & 0xFF);
 	} else {
@@ -2502,15 +2436,11 @@ Utf16ToUtfProc(
 
 static int
 UtfToUtf16Proc(
-    ClientData clientData,	/* != NULL means LE, == NUL means BE */
+    ClientData clientData,	/* additional flags, e.g. TCL_ENCODING_LE */
     const char *src,		/* Source string in UTF-8. */
     int srcLen,			/* Source string length in bytes. */
     int flags,			/* Conversion control flags. */
-    Tcl_EncodingState *statePtr,/* Place for conversion routine to store state
-				 * information used during a piecewise
-				 * conversion. Contents of statePtr are
-				 * initialized and/or reset by conversion
-				 * routine under control of flags argument. */
+    TCL_UNUSED(Tcl_EncodingState *),
     char *dst,			/* Output buffer in which converted string is
 				 * stored. */
     int dstLen,			/* The maximum length of output buffer in
@@ -2529,11 +2459,8 @@ UtfToUtf16Proc(
 {
     const char *srcStart, *srcEnd, *srcClose, *dstStart, *dstEnd;
     int result, numChars;
-    Tcl_UniChar *chPtr = (Tcl_UniChar *) statePtr;
+    int ch;
 
-    if (flags & TCL_ENCODING_START) {
-    	*statePtr = 0;
-    }
     srcStart = src;
     srcEnd = src + srcLen;
     srcClose = srcEnd;
@@ -2543,6 +2470,7 @@ UtfToUtf16Proc(
 
     dstStart = dst;
     dstEnd   = dst + dstLen - sizeof(Tcl_UniChar);
+    flags |= PTR2INT(clientData);
 
     result = TCL_OK;
     for (numChars = 0; src < srcEnd; numChars++) {
@@ -2559,38 +2487,27 @@ UtfToUtf16Proc(
 	    result = TCL_CONVERT_NOSPACE;
 	    break;
 	}
-	src += TclUtfToUniChar(src, chPtr);
-
-	if (clientData) {
-#if TCL_UTF_MAX > 3
-	    if (*chPtr <= 0xFFFF) {
-		*dst++ = (*chPtr & 0xFF);
-		*dst++ = (*chPtr >> 8);
+	src += TclUtfToUCS4(src, &ch);
+	if (flags & TCL_ENCODING_LE) {
+	    if (ch <= 0xFFFF) {
+		*dst++ = (ch & 0xFF);
+		*dst++ = (ch >> 8);
 	    } else {
-		*dst++ = (((*chPtr - 0x10000) >> 10) & 0xFF);
-		*dst++ = (((*chPtr - 0x10000) >> 18) & 0x3) | 0xD8;
-		*dst++ = (*chPtr & 0xFF);
-		*dst++ = ((*chPtr >> 8) & 0x3) | 0xDC;
+		*dst++ = (((ch - 0x10000) >> 10) & 0xFF);
+		*dst++ = (((ch - 0x10000) >> 18) & 0x3) | 0xD8;
+		*dst++ = (ch & 0xFF);
+		*dst++ = ((ch >> 8) & 0x3) | 0xDC;
 	    }
-#else
-	    *dst++ = (*chPtr & 0xFF);
-	    *dst++ = (*chPtr >> 8);
-#endif
 	} else {
-#if TCL_UTF_MAX > 3
-	    if (*chPtr <= 0xFFFF) {
-		*dst++ = (*chPtr >> 8);
-		*dst++ = (*chPtr & 0xFF);
+	    if (ch <= 0xFFFF) {
+		*dst++ = (ch >> 8);
+		*dst++ = (ch & 0xFF);
 	    } else {
-		*dst++ = (((*chPtr - 0x10000) >> 18) & 0x3) | 0xD8;
-		*dst++ = (((*chPtr - 0x10000) >> 10) & 0xFF);
-		*dst++ = ((*chPtr >> 8) & 0x3) | 0xDC;
-		*dst++ = (*chPtr & 0xFF);
+		*dst++ = (((ch - 0x10000) >> 18) & 0x3) | 0xD8;
+		*dst++ = (((ch - 0x10000) >> 10) & 0xFF);
+		*dst++ = ((ch >> 8) & 0x3) | 0xDC;
+		*dst++ = (ch & 0xFF);
 	    }
-#else
-	    *dst++ = (*chPtr >> 8);
-	    *dst++ = (*chPtr & 0xFF);
-#endif
 	}
     }
     *srcReadPtr = src - srcStart;
@@ -2617,7 +2534,7 @@ UtfToUtf16Proc(
 
 static int
 UtfToUcs2Proc(
-    ClientData clientData,	/* != NULL means LE, == NUL means BE */
+    ClientData clientData,	/* additional flags, e.g. TCL_ENCODING_LE */
     const char *src,		/* Source string in UTF-8. */
     int srcLen,			/* Source string length in bytes. */
     int flags,			/* Conversion control flags. */
@@ -2645,6 +2562,7 @@ UtfToUcs2Proc(
 #endif
     Tcl_UniChar ch = 0;
 
+    flags |= PTR2INT(clientData);
     srcStart = src;
     srcEnd = src + srcLen;
     srcClose = srcEnd;
@@ -2688,7 +2606,7 @@ UtfToUcs2Proc(
 	 * casting dst to a Tcl_UniChar. [Bug 1122671]
 	 */
 
-	if (clientData) {
+	if (flags & TCL_ENCODING_LE) {
 	    *dst++ = (ch & 0xFF);
 	    *dst++ = (ch >> 8);
 	} else {
@@ -3096,7 +3014,9 @@ Iso88591FromUtfProc(
 		break;
 	    }
 #if TCL_UTF_MAX <= 3
-	    if ((ch >= 0xD800) && (len < 3)) len = 4;
+	    if ((ch >= 0xD800) && (len < 3)) {
+		len = 4;
+	    }
 #endif
 	    /*
 	     * Plunge on, using '?' as a fallback character.
@@ -3141,7 +3061,7 @@ TableFreeProc(
     ClientData clientData)	/* TableEncodingData that specifies
 				 * encoding. */
 {
-    TableEncodingData *dataPtr = (TableEncodingData *)clientData;
+    TableEncodingData *dataPtr = (TableEncodingData *) clientData;
 
     /*
      * Make sure we aren't freeing twice on shutdown. [Bug 219314]
@@ -3199,7 +3119,7 @@ EscapeToUtfProc(
 				 * correspond to the bytes stored in the
 				 * output buffer. */
 {
-    EscapeEncodingData *dataPtr = (EscapeEncodingData *)clientData;
+    EscapeEncodingData *dataPtr = (EscapeEncodingData *) clientData;
     const char *prefixBytes, *tablePrefixBytes, *srcStart, *srcEnd;
     const unsigned short *const *tableToUnicode;
     const Encoding *encodingPtr;

generic/tclEnv.c

@@ -36,6 +36,11 @@ TCL_DECLARE_MUTEX(envMutex)	/* To serialize access to environ. */
 #  define techar char
 #endif
 
+
+/* MODULE_SCOPE */
+size_t TclEnvEpoch = 0;	/* Epoch of the tcl environment
+				 * (if changed with tcl-env). */
+
 static struct {
     int cacheSize;		/* Number of env strings in cache. */
     char **cache;		/* Array containing all of the environment
@@ -417,6 +422,7 @@ Tcl_PutEnv(
 	value[0] = '\0';
 	TclSetEnv(name, value+1);
     }
+    TclEnvEpoch++;
 
     Tcl_DStringFree(&nameString);
     return 0;
@@ -624,6 +630,7 @@ EnvTraceProc(
 
     if (flags & TCL_TRACE_ARRAY) {
 	TclSetupEnv(interp);
+	TclEnvEpoch++;
 	return NULL;
     }
 
@@ -644,6 +651,7 @@ EnvTraceProc(
 
 	value = Tcl_GetVar2(interp, "env", name2, TCL_GLOBAL_ONLY);
 	TclSetEnv(name2, value);
+	TclEnvEpoch++;
     }
 
     /*
@@ -667,6 +675,7 @@ EnvTraceProc(
 
     if (flags & TCL_TRACE_UNSETS) {
 	TclUnsetEnv(name2);
+	TclEnvEpoch++;
     }
     return NULL;
 }

generic/tclEvent.c

@@ -1513,7 +1513,7 @@ Tcl_UpdateObjCmd(
 	}
 	switch ((enum updateOptionsEnum) optionIndex) {
 	case OPT_IDLETASKS:
-	    flags = TCL_WINDOW_EVENTS|TCL_IDLE_EVENTS|TCL_DONT_WAIT;
+	    flags = TCL_IDLE_EVENTS|TCL_DONT_WAIT;
 	    break;
 	default:
 	    Tcl_Panic("Tcl_UpdateObjCmd: bad option index to UpdateOptions");

generic/tclExecute.c

@@ -15,6 +15,7 @@
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  */
 
+#define _BUILD_TCL_EXECUTE 1
 #include "tclInt.h"
 #include "tclCompile.h"
 #include "tclOOInt.h"
@@ -207,11 +208,16 @@ typedef struct TEBCdata {
     } while (0)
 
 /*
- * These variable-access macros have to coincide with those in tclVar.c
+ * These variable-access inline functions have to coincide with those in
+ * tclVar.c
  */
 
-#define VarHashGetValue(hPtr) \
-    ((Var *) ((char *)hPtr - offsetof(VarInHash, entry)))
+static inline Var *
+VarHashGetValue(
+    Tcl_HashEntry *hPtr)
+{
+    return (Var *) ((char *)hPtr - offsetof(VarInHash, entry));
+}
 
 static inline Var *
 VarHashCreateVar(
@@ -228,8 +234,13 @@ VarHashCreateVar(
     return VarHashGetValue(hPtr);
 }
 
-#define VarHashFindVar(tablePtr, key) \
-    VarHashCreateVar((tablePtr), (key), NULL)
+static inline Var *
+VarHashFindVar(
+    TclVarHashTable *tablePtr,
+    Tcl_Obj *key)
+{
+    return VarHashCreateVar((tablePtr), (key), NULL);
+}
 
 /*
  * The new macro for ending an instruction; note that a reasonable C-optimiser
@@ -261,7 +272,7 @@ VarHashCreateVar(
 #define CHECK_STACK()
 #endif
 
-#define NEXT_INST_F(pcAdjustment, nCleanup, resultHandling)	\
+#define NEXT_INST_F(pcAdjustment, nCleanup, resultHandling) \
     do {							\
 	TCL_CT_ASSERT((nCleanup >= 0) && (nCleanup <= 2));	\
 	CHECK_STACK();						\
@@ -343,16 +354,16 @@ VarHashCreateVar(
 	switch (*pc) {							\
 	case INST_JUMP_FALSE1:						\
 	    NEXT_INST_V(((condition)? 2 : TclGetInt1AtPtr(pc+1)), (cleanup), 0); \
-	break; \
+	    break;							\
 	case INST_JUMP_TRUE1:						\
 	    NEXT_INST_V(((condition)? TclGetInt1AtPtr(pc+1) : 2), (cleanup), 0); \
-	break; \
+	    break;							\
 	case INST_JUMP_FALSE4:						\
 	    NEXT_INST_V(((condition)? 5 : TclGetInt4AtPtr(pc+1)), (cleanup), 0); \
-	break; \
+	    break;							\
 	case INST_JUMP_TRUE4:						\
 	    NEXT_INST_V(((condition)? TclGetInt4AtPtr(pc+1) : 5), (cleanup), 0); \
-	break; \
+	    break;							\
 	default:							\
 	    if ((condition) < 0) {					\
 		TclNewIntObj(objResultPtr, -1);				\
@@ -360,12 +371,12 @@ VarHashCreateVar(
 		objResultPtr = TCONST((condition) > 0);			\
 	    }								\
 	    NEXT_INST_V(0, (cleanup), 1);				\
-	break; \
+	    break;							\
 	}								\
     } while (0)
 #else /* TCL_COMPILE_DEBUG */
 #define JUMP_PEEPHOLE_F(condition, pcAdjustment, cleanup) \
-    do{									\
+    do {								\
 	if ((condition) < 0) {						\
 	    TclNewIntObj(objResultPtr, -1);				\
 	} else {							\
@@ -374,7 +385,7 @@ VarHashCreateVar(
 	NEXT_INST_F((pcAdjustment), (cleanup), 1);			\
     } while (0)
 #define JUMP_PEEPHOLE_V(condition, pcAdjustment, cleanup) \
-    do{									\
+    do {								\
 	if ((condition) < 0) {						\
 	    TclNewIntObj(objResultPtr, -1);				\
 	} else {							\
@@ -998,7 +1009,7 @@ static inline int
 wordSkip(
     void *ptr)
 {
-    int mask = TCL_ALLOCALIGN-1;
+    int mask = TCL_ALLOCALIGN - 1;
     int base = PTR2INT(ptr) & mask;
     return (TCL_ALLOCALIGN - base)/sizeof(Tcl_Obj *);
 }
@@ -9991,7 +10002,7 @@ EvalStatsCmd(
 	    break;
 	}
     }
-    for (i = 31;  i >= 0;  i--) {
+    for (i = 31;  i != (size_t)-1;  i--) {
 	if (statsPtr->srcCount[i] > 0) {
 	    maxSizeDecade = i;
 	    break;
@@ -10014,7 +10025,7 @@ EvalStatsCmd(
 	    break;
 	}
     }
-    for (i = 31;  i >= 0;  i--) {
+    for (i = 31;  i != (size_t)-1;  i--) {
 	if (statsPtr->byteCodeCount[i] > 0) {
 	    maxSizeDecade = i;
 	    break;
@@ -10037,7 +10048,7 @@ EvalStatsCmd(
 	    break;
 	}
     }
-    for (i = 31;  i >= 0;  i--) {
+    for (i = 31;  i != (size_t)-1;  i--) {
 	if (statsPtr->lifetimeCount[i] > 0) {
 	    maxSizeDecade = i;
 	    break;

generic/tclFileName.c

@@ -2600,44 +2600,44 @@ Tcl_GetDeviceTypeFromStat(
     return (int) statPtr->st_rdev;
 }
 
-Tcl_WideInt
+long long
 Tcl_GetAccessTimeFromStat(
     const Tcl_StatBuf *statPtr)
 {
-    return (Tcl_WideInt) statPtr->st_atime;
+    return (long long) statPtr->st_atime;
 }
 
-Tcl_WideInt
+long long
 Tcl_GetModificationTimeFromStat(
     const Tcl_StatBuf *statPtr)
 {
-    return (Tcl_WideInt) statPtr->st_mtime;
+    return (long long) statPtr->st_mtime;
 }
 
-Tcl_WideInt
+long long
 Tcl_GetChangeTimeFromStat(
     const Tcl_StatBuf *statPtr)
 {
-    return (Tcl_WideInt) statPtr->st_ctime;
+    return (long long) statPtr->st_ctime;
 }
 
-Tcl_WideUInt
+unsigned long long
 Tcl_GetSizeFromStat(
     const Tcl_StatBuf *statPtr)
 {
-    return (Tcl_WideUInt) statPtr->st_size;
+    return (unsigned long long) statPtr->st_size;
 }
 
-Tcl_WideUInt
+unsigned long long
 Tcl_GetBlocksFromStat(
     const Tcl_StatBuf *statPtr)
 {
 #ifdef HAVE_STRUCT_STAT_ST_BLOCKS
-    return (Tcl_WideUInt) statPtr->st_blocks;
+    return (unsigned long long) statPtr->st_blocks;
 #else
     unsigned blksize = Tcl_GetBlockSizeFromStat(statPtr);
 
-    return ((Tcl_WideUInt) statPtr->st_size + blksize - 1) / blksize;
+    return ((unsigned long long) statPtr->st_size + blksize - 1) / blksize;
 #endif
 }
 

generic/tclIOCmd.c

@@ -40,9 +40,9 @@ static Tcl_ExitProc		FinalizeIOCmdTSD;
 static Tcl_TcpAcceptProc 	AcceptCallbackProc;
 static Tcl_ObjCmdProc		ChanPendingObjCmd;
 static Tcl_ObjCmdProc		ChanTruncateObjCmd;
-static void			RegisterTcpServerInterpCleanup(
-				    Tcl_Interp *interp,
-				    AcceptCallback *acceptCallbackPtr);
+static void		RegisterTcpServerInterpCleanup(
+			    Tcl_Interp *interp,
+			    AcceptCallback *acceptCallbackPtr);
 static Tcl_InterpDeleteProc	TcpAcceptCallbacksDeleteProc;
 static void		TcpServerCloseProc(ClientData callbackData);
 static void		UnregisterTcpServerInterpCleanupProc(
@@ -1219,7 +1219,8 @@ TcpAcceptCallbacksDeleteProc(
 
     for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
 	    hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) {
-	AcceptCallback *acceptCallbackPtr = (AcceptCallback *)Tcl_GetHashValue(hPtr);
+	AcceptCallback *acceptCallbackPtr = (AcceptCallback *)
+		Tcl_GetHashValue(hPtr);
 
 	acceptCallbackPtr->interp = NULL;
     }
@@ -1307,7 +1308,8 @@ UnregisterTcpServerInterpCleanupProc(
     Tcl_HashTable *hTblPtr;
     Tcl_HashEntry *hPtr;
 
-    hTblPtr = (Tcl_HashTable *)Tcl_GetAssocData(interp, "tclTCPAcceptCallbacks", NULL);
+    hTblPtr = (Tcl_HashTable *)
+	    Tcl_GetAssocData(interp, "tclTCPAcceptCallbacks", NULL);
     if (hTblPtr == NULL) {
 	return;
     }
@@ -1635,7 +1637,8 @@ Tcl_SocketObjCmd(
     port = TclGetString(objv[a]);
 
     if (server) {
-	AcceptCallback *acceptCallbackPtr = (AcceptCallback *)ckalloc(sizeof(AcceptCallback));
+	AcceptCallback *acceptCallbackPtr = (AcceptCallback *)
+		ckalloc(sizeof(AcceptCallback));
 
 	Tcl_IncrRefCount(script);
 	acceptCallbackPtr->script = script;

generic/tclIOGT.c

@@ -41,8 +41,8 @@ static void		TransformWatchProc(ClientData instanceData, int mask);
 static int		TransformGetFileHandleProc(ClientData instanceData,
 			    int direction, ClientData *handlePtr);
 static int		TransformNotifyProc(ClientData instanceData, int mask);
-static Tcl_WideInt	TransformWideSeekProc(ClientData instanceData,
-			    Tcl_WideInt offset, int mode, int *errorCodePtr);
+static long long	TransformWideSeekProc(ClientData instanceData,
+			    long long offset, int mode, int *errorCodePtr);
 
 /*
  * Forward declarations of internal procedures. Secondly the procedures for
@@ -68,18 +68,22 @@ static int		ExecuteCallback(TransformChannelData *ctrl,
  * the procedure what to do with the result of the script it calls.
  */
 
-#define TRANSMIT_DONT	0	/* No transfer to do. */
-#define TRANSMIT_DOWN	1	/* Transfer to the underlying channel. */
-#define TRANSMIT_SELF	2	/* Transfer into our channel. */
-#define TRANSMIT_IBUF	3	/* Transfer to internal input buffer. */
-#define TRANSMIT_NUM	4	/* Transfer number to 'maxRead'. */
+enum {
+    TRANSMIT_DONT = 0,		/* No transfer to do. */
+    TRANSMIT_DOWN = 1,		/* Transfer to the underlying channel. */
+    TRANSMIT_SELF = 2,		/* Transfer into our channel. */
+    TRANSMIT_IBUF = 3,		/* Transfer to internal input buffer. */
+    TRANSMIT_NUM = 4		/* Transfer number to 'maxRead'. */
+};
 
 /*
  * Codes for 'preserve' of 'ExecuteCallback'.
  */
 
-#define P_PRESERVE	1
-#define P_NO_PRESERVE	0
+enum {
+    P_PRESERVE = 1,
+    P_NO_PRESERVE = 0
+};
 
 /*
  * Strings for the action codes delivered to the script implementing a
@@ -907,10 +911,10 @@ TransformSeekProc(
  *----------------------------------------------------------------------
  */
 
-static Tcl_WideInt
+static long long
 TransformWideSeekProc(
     ClientData instanceData,	/* The channel to manipulate. */
-    Tcl_WideInt offset,		/* Size of movement. */
+    long long offset,		/* Size of movement. */
     int mode,			/* How to move. */
     int *errorCodePtr)		/* Location of error flag. */
 {
@@ -922,7 +926,7 @@ TransformWideSeekProc(
 #endif
     Tcl_DriverWideSeekProc *parentWideSeekProc =
 	    Tcl_ChannelWideSeekProc(parentType);
-    ClientData parentData = Tcl_GetChannelInstanceData(parent);
+    void *parentData = Tcl_GetChannelInstanceData(parent);
 
     if ((offset == 0) && (mode == SEEK_CUR)) {
 	/*
@@ -969,11 +973,11 @@ TransformWideSeekProc(
 
     if (parentWideSeekProc == NULL) {
 	/*
-	 * We're transferring to narrow seeks at this point; this is a bit complex
-	 * because we have to check whether the seek is possible first (i.e.
-	 * whether we are losing information in truncating the bits of the
-	 * offset). Luckily, there's a defined error for what happens when trying
-	 * to go out of the representable range.
+	 * We're transferring to narrow seeks at this point; this is a bit
+	 * complex because we have to check whether the seek is possible first
+	 * (i.e. whether we are losing information in truncating the bits of
+	 * the offset). Luckily, there's a defined error for what happens when
+	 * trying to go out of the representable range.
 	 */
 
 #ifndef TCL_NO_DEPRECATED

generic/tclIORChan.c

@@ -43,25 +43,26 @@ static int		ReflectBlock(ClientData clientData, int mode);
 static void		ReflectThread(ClientData clientData, int action);
 static int		ReflectEventRun(Tcl_Event *ev, int flags);
 static int		ReflectEventDelete(Tcl_Event *ev, ClientData cd);
-#endif
-static Tcl_WideInt	ReflectSeekWide(ClientData clientData,
-			    Tcl_WideInt offset, int mode, int *errorCodePtr);
+#endif /* TCL_THREADS */
+static long long ReflectSeekWide(ClientData clientData,
+			    long long offset, int mode, int *errorCodePtr);
 #ifndef TCL_NO_DEPRECATED
 static int		ReflectSeek(ClientData clientData, long offset,
 			    int mode, int *errorCodePtr);
-#endif
+#endif /* !TCL_NO_DEPRECATED */
 static int		ReflectGetOption(ClientData clientData,
 			    Tcl_Interp *interp, const char *optionName,
 			    Tcl_DString *dsPtr);
 static int		ReflectSetOption(ClientData clientData,
 			    Tcl_Interp *interp, const char *optionName,
 			    const char *newValue);
-static void     TimerRunRead(ClientData clientData);
-static void     TimerRunWrite(ClientData clientData);
+static int		ReflectTruncate(ClientData clientData,
+			    long long length);
+static void             TimerRunRead(ClientData clientData);
+static void             TimerRunWrite(ClientData clientData);
 
 /*
- * The C layer channel type/driver definition used by the reflection. This is
- * a version 3 structure.
+ * The C layer channel type/driver definition used by the reflection.
  */
 
 static const Tcl_ChannelType tclRChannelType = {
@@ -89,7 +90,7 @@ static const Tcl_ChannelType tclRChannelType = {
 #else
 	NULL,		   /* thread action */
 #endif
-    NULL		   /* truncate */
+    ReflectTruncate	   /* Truncate.				NULL'able */
 };
 
 /*
@@ -103,33 +104,27 @@ typedef struct {
 				 * Tcl level part of the channel. NULL here
 				 * signals the channel is dead because the
 				 * interpreter/thread containing its Tcl
-				 * command is gone.
-				 */
+				 * command is gone. */
 #if TCL_THREADS
-    Tcl_ThreadId thread;	/* Thread the 'interp' belongs to. == Handler thread */
-    Tcl_ThreadId owner;         /* Thread owning the structure.    == Channel thread */
+    Tcl_ThreadId thread;	/* Thread the 'interp' belongs to.
+                                 * == Handler thread */
+    Tcl_ThreadId owner;         /* Thread owning the structure.
+                                 * == Channel thread */
 #endif
     Tcl_Obj *cmd;		/* Callback command prefix */
     Tcl_Obj *methods;		/* Methods to append to command prefix */
     Tcl_Obj *name;		/* Name of the channel as created */
-
     int mode;			/* Mask of R/W mode */
     int interest;		/* Mask of events the channel is interested
 				 * in. */
-
     int dead;			/* Boolean signal that some operations
 				 * should no longer be attempted. */
-
-    Tcl_TimerToken readTimer;   /*
-				   A token for the timer that is scheduled in
-				   order to call Tcl_NotifyChannel when the
-				   channel is readable
-			        */
-    Tcl_TimerToken writeTimer;  /*
-				   A token for the timer that is scheduled in
-				   order to call Tcl_NotifyChannel when the
-				   channel is writable
-			        */
+    Tcl_TimerToken readTimer;   /* A token for the timer that is scheduled in
+                                 * order to call Tcl_NotifyChannel when the
+                                 * channel is readable */
+    Tcl_TimerToken writeTimer;  /* A token for the timer that is scheduled in
+                                 * order to call Tcl_NotifyChannel when the
+                                 * channel is writable */
 
     /*
      * Note regarding the usage of timers.
@@ -187,6 +182,7 @@ static const char *const methodNames[] = {
     "initialize",	/*     */
     "read",		/* OPT */
     "seek",		/* OPT */
+    "truncate",		/* OPT */
     "watch",		/*     */
     "write",		/* OPT */
     NULL
@@ -200,6 +196,7 @@ typedef enum {
     METH_INIT,
     METH_READ,
     METH_SEEK,
+    METH_TRUNCATE,
     METH_WATCH,
     METH_WRITE
 } MethodName;
@@ -209,7 +206,8 @@ typedef enum {
 	(FLAG(METH_INIT) | FLAG(METH_FINAL) | FLAG(METH_WATCH))
 #define NULLABLE_METHODS \
 	(FLAG(METH_BLOCKING) | FLAG(METH_SEEK) | \
-	FLAG(METH_CONFIGURE) | FLAG(METH_CGET) | FLAG(METH_CGETALL))
+	FLAG(METH_CONFIGURE) | FLAG(METH_CGET) | \
+	FLAG(METH_CGETALL)   | FLAG(METH_TRUNCATE))
 
 #define RANDW \
 	(TCL_READABLE | TCL_WRITABLE)
@@ -239,7 +237,8 @@ typedef enum {
     ForwardedBlock,
     ForwardedSetOpt,
     ForwardedGetOpt,
-    ForwardedGetOptAll
+    ForwardedGetOptAll,
+    ForwardedTruncate
 } ForwardedOperation;
 
 /*
@@ -302,6 +301,10 @@ struct ForwardParamGetOpt {
     const char *name;		/* Name of option to get, maybe NULL */
     Tcl_DString *value;		/* Result */
 };
+struct ForwardParamTruncate {
+    ForwardParamBase base;	/* "Supertype". MUST COME FIRST. */
+    Tcl_WideInt length;		/* I: Length of file. */
+};
 
 /*
  * Now join all these together in a single union for convenience.
@@ -316,6 +319,7 @@ typedef union ForwardParam {
     struct ForwardParamBlock block;
     struct ForwardParamSetOpt setOpt;
     struct ForwardParamGetOpt getOpt;
+    struct ForwardParamTruncate truncate;
 } ForwardParam;
 
 /*
@@ -686,7 +690,8 @@ TclChanCreateObjCmd(
 	 * as the actual channel type.
 	 */
 
-	Tcl_ChannelType *clonePtr = (Tcl_ChannelType *)ckalloc(sizeof(Tcl_ChannelType));
+	Tcl_ChannelType *clonePtr = (Tcl_ChannelType *)
+                ckalloc(sizeof(Tcl_ChannelType));
 
 	memcpy(clonePtr, &tclRChannelType, sizeof(Tcl_ChannelType));
 
@@ -706,6 +711,9 @@ TclChanCreateObjCmd(
 #endif
 	    clonePtr->wideSeekProc = NULL;
 	}
+	if (!(methods & FLAG(METH_TRUNCATE))) {
+	    clonePtr->truncateProc = NULL;
+	}
 
 	chanPtr->typePtr = clonePtr;
     }
@@ -889,7 +897,7 @@ TclChanPostEventObjCmd(
      * have gone seriously haywire.
      */
 
-    chan = (Tcl_Channel)Tcl_GetHashValue(hPtr);
+    chan = (Tcl_Channel) Tcl_GetHashValue(hPtr);
     chanTypePtr = Tcl_GetChannelType(chan);
 
     /*
@@ -1158,7 +1166,7 @@ static int
 ReflectClose(
     ClientData clientData,
     Tcl_Interp *interp,
-	int flags)
+    int flags)
 {
     ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
     int result;			/* Result code for 'close' */
@@ -1550,10 +1558,10 @@ ReflectOutput(
  *----------------------------------------------------------------------
  */
 
-static Tcl_WideInt
+static long long
 ReflectSeekWide(
     ClientData clientData,
-    Tcl_WideInt offset,
+    long long offset,
     int seekMode,
     int *errorCodePtr)
 {
@@ -2047,6 +2055,73 @@ ReflectGetOption(
     goto stop;
 }
 
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReflectTruncate --
+ *
+ *	This function is invoked to truncate a channel's file size.
+ *
+ * Results:
+ *	A standard Tcl result code.
+ *
+ * Side effects:
+ *	Arbitrary, as it calls upon a Tcl script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ReflectTruncate(
+    ClientData clientData,	/* Channel to query */
+    long long length)		/* Length to truncate to. */
+{
+    ReflectedChannel *rcPtr = (ReflectedChannel *)clientData;
+    Tcl_Obj *lenObj;
+    int errorNum;		/* EINVAL or EOK (success). */
+    Tcl_Obj *resObj;		/* Result for 'truncate' */
+
+    /*
+     * Are we in the correct thread?
+     */
+
+#ifdef TCL_THREADS
+    if (rcPtr->thread != Tcl_GetCurrentThread()) {
+	ForwardParam p;
+
+	p.truncate.length = length;
+
+	ForwardOpToHandlerThread(rcPtr, ForwardedTruncate, &p);
+
+	if (p.base.code != TCL_OK) {
+	    PassReceivedError(rcPtr->chan, &p);
+	    return EINVAL;
+	}
+
+	return EOK;
+    }
+#endif
+
+    /* ASSERT: rcPtr->method & FLAG(METH_TRUNCATE) */
+
+    Tcl_Preserve(rcPtr);
+
+    lenObj  = Tcl_NewIntObj(length);
+    Tcl_IncrRefCount(lenObj);
+
+    if (InvokeTclMethod(rcPtr,METH_TRUNCATE,lenObj,NULL,&resObj)!=TCL_OK) {
+	Tcl_SetChannelError(rcPtr->chan, resObj);
+	errorNum = EINVAL;
+    } else {
+	errorNum = EOK;
+    }
+
+    Tcl_DecrRefCount(lenObj);
+    Tcl_DecrRefCount(resObj);		/* Remove reference held from invoke */
+    Tcl_Release(rcPtr);
+    return errorNum;
+}
+
 /*
  * Helpers. =========================================================
  */
@@ -2510,7 +2585,8 @@ static ReflectedChannelMap *
 GetReflectedChannelMap(
     Tcl_Interp *interp)
 {
-    ReflectedChannelMap *rcmPtr = (ReflectedChannelMap *)Tcl_GetAssocData(interp, RCMKEY, NULL);
+    ReflectedChannelMap *rcmPtr = (ReflectedChannelMap *)
+            Tcl_GetAssocData(interp, RCMKEY, NULL);
 
     if (rcmPtr == NULL) {
 	rcmPtr = (ReflectedChannelMap *)ckalloc(sizeof(ReflectedChannelMap));
@@ -2713,7 +2789,8 @@ GetThreadReflectedChannelMap(void)
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
     if (!tsdPtr->rcmPtr) {
-	tsdPtr->rcmPtr = (ReflectedChannelMap *)ckalloc(sizeof(ReflectedChannelMap));
+	tsdPtr->rcmPtr = (ReflectedChannelMap *)
+                ckalloc(sizeof(ReflectedChannelMap));
 	Tcl_InitHashTable(&tsdPtr->rcmPtr->map, TCL_STRING_KEYS);
 	Tcl_CreateThreadExitHandler(DeleteThreadReflectedChannelMap, NULL);
     }
@@ -2831,7 +2908,8 @@ DeleteThreadReflectedChannelMap(
 	    hPtr != NULL;
 	    hPtr = Tcl_FirstHashEntry(&rcmPtr->map, &hSearch)) {
 	Tcl_Channel chan = (Tcl_Channel)Tcl_GetHashValue(hPtr);
-	ReflectedChannel *rcPtr = (ReflectedChannel *)Tcl_GetChannelInstanceData(chan);
+	ReflectedChannel *rcPtr = (ReflectedChannel *)
+                Tcl_GetChannelInstanceData(chan);
 
 	MarkDead(rcPtr);
 	Tcl_DeleteHashEntry(hPtr);
@@ -3278,6 +3356,19 @@ ForwardProc(
         Tcl_Release(rcPtr);
 	break;
 
+    case ForwardedTruncate: {
+	Tcl_Obj *lenObj = Tcl_NewIntObj(paramPtr->truncate.length);
+
+	Tcl_IncrRefCount(lenObj);
+	Tcl_Preserve(rcPtr);
+	if (InvokeTclMethod(rcPtr,METH_TRUNCATE,lenObj,NULL,&resObj)!=TCL_OK) {
+	    ForwardSetObjError(paramPtr, resObj);
+	}
+	Tcl_Release(rcPtr);
+	Tcl_DecrRefCount(lenObj);
+	break;
+    }
+
     default:
 	/*
 	 * Bad operation code.

generic/tclIORTrans.c

@@ -39,8 +39,8 @@ static int		ReflectOutput(ClientData clientData, const char *buf,
 			    int toWrite, int *errorCodePtr);
 static void		ReflectWatch(ClientData clientData, int mask);
 static int		ReflectBlock(ClientData clientData, int mode);
-static Tcl_WideInt	ReflectSeekWide(ClientData clientData,
-			    Tcl_WideInt offset, int mode, int *errorCodePtr);
+static long long	ReflectSeekWide(ClientData clientData,
+			    long long offset, int mode, int *errorCodePtr);
 #ifndef TCL_NO_DEPRECATED
 static int		ReflectSeek(ClientData clientData, long offset,
 			    int mode, int *errorCodePtr);
@@ -476,8 +476,10 @@ static int		TransformLimit(ReflectedTransform *rtPtr,
  * Operation codes for TransformFlush().
  */
 
-#define FLUSH_WRITE	1
-#define FLUSH_DISCARD	0
+enum {
+    FLUSH_WRITE = 1,
+    FLUSH_DISCARD = 0
+};
 
 /*
  * Main methods to plug into the 'chan' ensemble'. ==================
@@ -1113,7 +1115,6 @@ ReflectInput(
 	    goto stop;
 	}
 
-
 	/*
 	 * The buffer is exhausted, but the caller wants even more. We now
 	 * have to go to the underlying channel, get more bytes and then
@@ -1149,7 +1150,6 @@ ReflectInput(
 	    goto stop;
 	}
 
-
 	readBytes = Tcl_ReadRaw(rtPtr->parent,
 		(char *) Tcl_SetByteArrayLength(bufObj, toRead), toRead);
 	if (readBytes < 0) {
@@ -1165,11 +1165,10 @@ ReflectInput(
 	    }
 
 	    /*
-	     * Either the down channel is not blocked (a real error)
-	     * or it is and there are gotBytes==0 byte copied so far.
-	     * In either case, pass up the error, so we either report
-	     * any real error, or do not mistakenly signal EOF by
-	     * returning 0 to the caller.
+	     * Either the down channel is not blocked (a real error) or it is
+	     * and there are gotBytes==0 byte copied so far.  In either case,
+	     * pass up the error, so we either report any real error, or do
+	     * not mistakenly signal EOF by returning 0 to the caller.
 	     */
 
 	    *errorCodePtr = Tcl_GetErrno();
@@ -1177,7 +1176,6 @@ ReflectInput(
 	}
 
 	if (readBytes == 0) {
-
 	    /*
 	     * Zero returned from Tcl_ReadRaw() always indicates EOF
 	     * on the down channel.
@@ -1185,26 +1183,26 @@ ReflectInput(
 
 	    rtPtr->eofPending = 1;
 
+	    /*
+	     * Now this is a bit different. The partial data waiting is
+	     * converted and returned.
+	     */
+
+	    if (HAS(rtPtr->methods, METH_DRAIN)) {
+		if (!TransformDrain(rtPtr, errorCodePtr)) {
+		    goto error;
+		}
+	    }
+
+	    if (ResultLength(&rtPtr->result) == 0) {
 		/*
-		 * Now this is a bit different. The partial data waiting is
-		 * converted and returned.
+		 * The drain delivered nothing.
 		 */
 
-		if (HAS(rtPtr->methods, METH_DRAIN)) {
-		    if (!TransformDrain(rtPtr, errorCodePtr)) {
-			goto error;
-		    }
-		}
+		goto stop;
+	    }
 
-		if (ResultLength(&rtPtr->result) == 0) {
-		    /*
-		     * The drain delivered nothing.
-		     */
-
-		    goto stop;
-		}
-
-		continue; /* at: while (toRead > 0) */
+	    continue; /* at: while (toRead > 0) */
 	} /* readBytes == 0 */
 
 	/*
@@ -1261,7 +1259,7 @@ ReflectOutput(
     int toWrite,
     int *errorCodePtr)
 {
-    ReflectedTransform *rtPtr = (ReflectedTransform *)clientData;
+    ReflectedTransform *rtPtr = (ReflectedTransform *) clientData;
 
     /*
      * The following check can be done before thread redirection, because we
@@ -1327,10 +1325,10 @@ ReflectOutput(
  *----------------------------------------------------------------------
  */
 
-static Tcl_WideInt
+static long long
 ReflectSeekWide(
     ClientData clientData,
-    Tcl_WideInt offset,
+    long long offset,
     int seekMode,
     int *errorCodePtr)
 {
@@ -1388,16 +1386,15 @@ ReflectSeekWide(
 	    curPos = -1;
 	} else {
 	    curPos = Tcl_ChannelSeekProc(parent->typePtr)(
-	    parent->instanceData, offset, seekMode,
-	    errorCodePtr);
+		    parent->instanceData, offset, seekMode, errorCodePtr);
 	}
 #else
 	*errorCodePtr = EINVAL;
 	curPos = -1;
 #endif
     } else {
-    	curPos = Tcl_ChannelWideSeekProc(parent->typePtr)(parent->instanceData, offset,
-    		seekMode, errorCodePtr);
+    	curPos = Tcl_ChannelWideSeekProc(parent->typePtr)(parent->instanceData,
+		offset, seekMode, errorCodePtr);
     }
     if (curPos == -1) {
 	Tcl_SetErrno(*errorCodePtr);
@@ -1423,8 +1420,7 @@ ReflectSeek(
      * routine.
      */
 
-    return ReflectSeekWide(clientData, offset, seekMode,
-	    errorCodePtr);
+    return ReflectSeekWide(clientData, offset, seekMode, errorCodePtr);
 }
 #endif
 
@@ -2042,6 +2038,7 @@ InvokeTclMethod(
 	     * This is complex and ugly, and would be completely unnecessary
 	     * if we only added support for a TCL_FORBID_EXCEPTIONS flag.
 	     */
+
 	    if (result != TCL_ERROR) {
 		Tcl_Obj *cmd = Tcl_NewListObj(cmdc, rtPtr->argv);
 		int cmdLen;
@@ -2114,10 +2111,12 @@ static ReflectedTransformMap *
 GetReflectedTransformMap(
     Tcl_Interp *interp)
 {
-    ReflectedTransformMap *rtmPtr = (ReflectedTransformMap *)Tcl_GetAssocData(interp, RTMKEY, NULL);
+    ReflectedTransformMap *rtmPtr = (ReflectedTransformMap *)
+	    Tcl_GetAssocData(interp, RTMKEY, NULL);
 
     if (rtmPtr == NULL) {
-	rtmPtr = (ReflectedTransformMap *)ckalloc(sizeof(ReflectedTransformMap));
+	rtmPtr = (ReflectedTransformMap *)
+		ckalloc(sizeof(ReflectedTransformMap));
 	Tcl_InitHashTable(&rtmPtr->map, TCL_STRING_KEYS);
 	Tcl_SetAssocData(interp, RTMKEY,
 		(Tcl_InterpDeleteProc *) DeleteReflectedTransformMap, rtmPtr);
@@ -2280,7 +2279,8 @@ GetThreadReflectedTransformMap(void)
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 
     if (!tsdPtr->rtmPtr) {
-	tsdPtr->rtmPtr = (ReflectedTransformMap *)ckalloc(sizeof(ReflectedTransformMap));
+	tsdPtr->rtmPtr = (ReflectedTransformMap *)
+		ckalloc(sizeof(ReflectedTransformMap));
 	Tcl_InitHashTable(&tsdPtr->rtmPtr->map, TCL_STRING_KEYS);
 	Tcl_CreateThreadExitHandler(DeleteThreadReflectedTransformMap, NULL);
     }
@@ -2415,8 +2415,8 @@ ForwardOpToOwnerThread(
      * Create and initialize the event and data structures.
      */
 
-    evPtr = (ForwardingEvent *)ckalloc(sizeof(ForwardingEvent));
-    resultPtr = (ForwardingResult *)ckalloc(sizeof(ForwardingResult));
+    evPtr = (ForwardingEvent *) ckalloc(sizeof(ForwardingEvent));
+    resultPtr = (ForwardingResult *) ckalloc(sizeof(ForwardingResult));
 
     evPtr->event.proc = ForwardProc;
     evPtr->resultPtr = resultPtr;
@@ -2759,7 +2759,7 @@ static void
 SrcExitProc(
     ClientData clientData)
 {
-    ForwardingEvent *evPtr = (ForwardingEvent *)clientData;
+    ForwardingEvent *evPtr = (ForwardingEvent *) clientData;
     ForwardingResult *resultPtr;
     ForwardParam *paramPtr;
 
@@ -3230,7 +3230,7 @@ TransformDrain(
     } else
 #endif /* TCL_THREADS */
     {
-	if (InvokeTclMethod(rtPtr, "drain", NULL, NULL, &resObj)!=TCL_OK) {
+	if (InvokeTclMethod(rtPtr, "drain", NULL, NULL, &resObj) != TCL_OK) {
 	    Tcl_SetChannelError(rtPtr->chan, resObj);
 	    Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
 	    *errorCodePtr = EINVAL;
@@ -3285,7 +3285,7 @@ TransformFlush(
     } else
 #endif /* TCL_THREADS */
     {
-	if (InvokeTclMethod(rtPtr, "flush", NULL, NULL, &resObj)!=TCL_OK) {
+	if (InvokeTclMethod(rtPtr, "flush", NULL, NULL, &resObj) != TCL_OK) {
 	    Tcl_SetChannelError(rtPtr->chan, resObj);
 	    Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
 	    *errorCodePtr = EINVAL;

generic/tclIOUtil.c

@@ -3009,7 +3009,7 @@ Tcl_FSLoadFile(
     const char *sym1, const char *sym2,
 				/* Names of two functions to find in the
 				 * dynamic shared object. */
-    Tcl_PackageInitProc **proc1Ptr, Tcl_PackageInitProc **proc2Ptr,
+    Tcl_LibraryInitProc **proc1Ptr, Tcl_LibraryInitProc **proc2Ptr,
 				/* Places to store pointers to the functions
 				 * named by sym1 and sym2. */
     Tcl_LoadHandle *handlePtr,	/* A place to store the token for the loaded
@@ -3027,8 +3027,8 @@ Tcl_FSLoadFile(
 
     res = Tcl_LoadFile(interp, pathPtr, symbols, 0, procPtrs, handlePtr);
     if (res == TCL_OK) {
-	*proc1Ptr = (Tcl_PackageInitProc *) procPtrs[0];
-	*proc2Ptr = (Tcl_PackageInitProc *) procPtrs[1];
+	*proc1Ptr = (Tcl_LibraryInitProc *) procPtrs[0];
+	*proc2Ptr = (Tcl_LibraryInitProc *) procPtrs[1];
     } else {
 	*proc1Ptr = *proc2Ptr = NULL;
     }
@@ -3077,6 +3077,13 @@ Tcl_FSLoadFile(
  *
  */
 
+#ifdef _WIN32
+#define getenv(x) _wgetenv(L##x)
+#define atoi(x) _wtoi(x)
+#else
+#define WCHAR char
+#endif
+
 static int
 skipUnlink(
     Tcl_Obj *shlibFile)
@@ -3098,7 +3105,7 @@ skipUnlink(
     (void)shlibFile;
     return 1;
 #else
-    char *skipstr = getenv("TCL_TEMPLOAD_NO_UNLINK");
+    WCHAR *skipstr = getenv("TCL_TEMPLOAD_NO_UNLINK");
 
     if (skipstr && (skipstr[0] != '\0')) {
 	return atoi(skipstr);

generic/tclIndexObj.c

@@ -785,7 +785,7 @@ PrefixLongestObjCmd(
 		     * Adjust in case we stopped in the middle of a UTF char.
 		     */
 
-		    resultLength = TclUtfPrev(&resultString[i+1],
+		    resultLength = Tcl_UtfPrev(&resultString[i+1],
 			    resultString) - resultString;
 		    break;
 		}
@@ -1332,7 +1332,6 @@ PrintUsage(
     int width, numSpaces;
 #define NUM_SPACES 20
     static const char spaces[] = "                    ";
-    char tmp[TCL_DOUBLE_SPACE];
     Tcl_Obj *msg;
 
     /*
@@ -1382,7 +1381,6 @@ PrintUsage(
 	case TCL_ARGV_FLOAT:
 	    Tcl_AppendPrintfToObj(msg, "\n\t\tDefault value: %g",
 		    *((double *) infoPtr->dstPtr));
-	    sprintf(tmp, "%g", *((double *) infoPtr->dstPtr));
 	    break;
 	case TCL_ARGV_STRING: {
 	    char *string = *((char **) infoPtr->dstPtr);

generic/tclInt.decls

@@ -17,6 +17,7 @@ library tcl
 # Define the unsupported generic interfaces.
 
 interface tclInt
+scspec EXTERN
 
 # Declare each of the functions in the unsupported internal Tcl
 # interface.  These interfaces are allowed to changed between versions.
@@ -239,8 +240,8 @@ declare 55 {
 # Replaced with TclpLoadFile in 8.1:
 #  declare 56 {
 #      int TclLoadFile(Tcl_Interp *interp, char *fileName, char *sym1,
-#  	    char *sym2, Tcl_PackageInitProc **proc1Ptr,
-#  	    Tcl_PackageInitProc **proc2Ptr)
+#  	    char *sym2, Tcl_LibraryInitProc **proc1Ptr,
+#  	    Tcl_LibraryInitProc **proc2Ptr)
 #  }
 # Signature changed to take a length in 8.1:
 #  declare 57 {
@@ -552,8 +553,8 @@ declare 138 {
 }
 #declare 139 {
 #    int TclpLoadFile(Tcl_Interp *interp, char *fileName, char *sym1,
-#	    char *sym2, Tcl_PackageInitProc **proc1Ptr,
-#	    Tcl_PackageInitProc **proc2Ptr, void **clientDataPtr)
+#	    char *sym2, Tcl_LibraryInitProc **proc1Ptr,
+#	    Tcl_LibraryInitProc **proc2Ptr, void **clientDataPtr)
 #}
 #declare 140 {
 #    int TclLooksLikeInt(const char *bytes, int length)
@@ -981,7 +982,7 @@ declare 247 {
 
 declare 248 {
     int TclCopyChannel(Tcl_Interp *interp, Tcl_Channel inChan,
-	    Tcl_Channel outChan, Tcl_WideInt toRead, Tcl_Obj *cmdPtr)
+	    Tcl_Channel outChan, long long toRead, Tcl_Obj *cmdPtr)
 }
 
 declare 249 {
@@ -1025,8 +1026,8 @@ declare 256 {
 	    Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags)
 }
 declare 257 {
-    void TclStaticPackage(Tcl_Interp *interp, const char *pkgName,
-	    Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc)
+    void TclStaticLibrary(Tcl_Interp *interp, const char *prefix,
+	    Tcl_LibraryInitProc *initProc, Tcl_LibraryInitProc *safeInitProc)
 }
 
 # TIP 431: temporary directory creation function

generic/tclIntDecls.h

@@ -618,7 +618,7 @@ EXTERN void		TclResetRewriteEnsemble(Tcl_Interp *interp,
 /* 248 */
 EXTERN int		TclCopyChannel(Tcl_Interp *interp,
 				Tcl_Channel inChan, Tcl_Channel outChan,
-				Tcl_WideInt toRead, Tcl_Obj *cmdPtr);
+				long long toRead, Tcl_Obj *cmdPtr);
 /* 249 */
 EXTERN char *		TclDoubleDigits(double dv, int ndigits, int flags,
 				int *decpt, int *signum, char **endPtr);
@@ -651,10 +651,10 @@ EXTERN int		TclPtrUnsetVar(Tcl_Interp *interp, Tcl_Var varPtr,
 				Tcl_Var arrayPtr, Tcl_Obj *part1Ptr,
 				Tcl_Obj *part2Ptr, const int flags);
 /* 257 */
-EXTERN void		TclStaticPackage(Tcl_Interp *interp,
-				const char *pkgName,
-				Tcl_PackageInitProc *initProc,
-				Tcl_PackageInitProc *safeInitProc);
+EXTERN void		TclStaticLibrary(Tcl_Interp *interp,
+				const char *prefix,
+				Tcl_LibraryInitProc *initProc,
+				Tcl_LibraryInitProc *safeInitProc);
 /* 258 */
 EXTERN Tcl_Obj *	TclpCreateTemporaryDirectory(Tcl_Obj *dirObj,
 				Tcl_Obj *basenameObj);
@@ -916,7 +916,7 @@ typedef struct TclIntStubs {
     Tcl_HashTable * (*tclGetNamespaceCommandTable) (Tcl_Namespace *nsPtr); /* 245 */
     int (*tclInitRewriteEnsemble) (Tcl_Interp *interp, int numRemoved, int numInserted, Tcl_Obj *const *objv); /* 246 */
     void (*tclResetRewriteEnsemble) (Tcl_Interp *interp, int isRootEnsemble); /* 247 */
-    int (*tclCopyChannel) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, Tcl_WideInt toRead, Tcl_Obj *cmdPtr); /* 248 */
+    int (*tclCopyChannel) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, long long toRead, Tcl_Obj *cmdPtr); /* 248 */
     char * (*tclDoubleDigits) (double dv, int ndigits, int flags, int *decpt, int *signum, char **endPtr); /* 249 */
     void (*tclSetChildCancelFlags) (Tcl_Interp *interp, int flags, int force); /* 250 */
     int (*tclRegisterLiteral) (void *envPtr, const char *bytes, int length, int flags); /* 251 */
@@ -925,7 +925,7 @@ typedef struct TclIntStubs {
     Tcl_Obj * (*tclPtrIncrObjVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *incrPtr, const int flags); /* 254 */
     int (*tclPtrObjMakeUpvar) (Tcl_Interp *interp, Tcl_Var otherPtr, Tcl_Obj *myNamePtr, int myFlags); /* 255 */
     int (*tclPtrUnsetVar) (Tcl_Interp *interp, Tcl_Var varPtr, Tcl_Var arrayPtr, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, const int flags); /* 256 */
-    void (*tclStaticPackage) (Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 257 */
+    void (*tclStaticLibrary) (Tcl_Interp *interp, const char *prefix, Tcl_LibraryInitProc *initProc, Tcl_LibraryInitProc *safeInitProc); /* 257 */
     Tcl_Obj * (*tclpCreateTemporaryDirectory) (Tcl_Obj *dirObj, Tcl_Obj *basenameObj); /* 258 */
     unsigned char * (*tclGetBytesFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *lengthPtr); /* 259 */
     void (*tclUnusedStubEntry) (void); /* 260 */
@@ -1370,8 +1370,8 @@ extern const TclIntStubs *tclIntStubsPtr;
 	(tclIntStubsPtr->tclPtrObjMakeUpvar) /* 255 */
 #define TclPtrUnsetVar \
 	(tclIntStubsPtr->tclPtrUnsetVar) /* 256 */
-#define TclStaticPackage \
-	(tclIntStubsPtr->tclStaticPackage) /* 257 */
+#define TclStaticLibrary \
+	(tclIntStubsPtr->tclStaticLibrary) /* 257 */
 #define TclpCreateTemporaryDirectory \
 	(tclIntStubsPtr->tclpCreateTemporaryDirectory) /* 258 */
 #define TclGetBytesFromObj \
@@ -1409,11 +1409,12 @@ extern const TclIntStubs *tclIntStubsPtr;
 #   undef TclGetCommandFullName
 #   undef TclCopyChannelOld
 #   undef TclSockMinimumBuffersOld
-#   undef Tcl_StaticPackage
-#   define Tcl_StaticPackage (tclIntStubsPtr->tclStaticPackage)
+#   undef Tcl_StaticLibrary
+#   define Tcl_StaticLibrary (tclIntStubsPtr->tclStaticLibrary)
 #endif
 
 #undef TclGuessPackageName
+#undef TclUnusedStubEntry
 #ifndef TCL_NO_DEPRECATED
 #   define TclGuessPackageName(fileName, pkgName) ((void)fileName,(void)pkgName,0)
 #endif

generic/tclIntPlatDecls.h

@@ -570,6 +570,11 @@ 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
 

generic/tclInterp.c

@@ -195,19 +195,19 @@ struct LimitHandler {
 };
 
 /*
- * Values for the LimitHandler flags field.
- *      LIMIT_HANDLER_ACTIVE - Whether the handler is currently being
- *              processed; handlers are never to be entered reentrantly.
- *      LIMIT_HANDLER_DELETED - Whether the handler has been deleted. This
- *              should not normally be observed because when a handler is
- *              deleted it is also spliced out of the list of handlers, but
- *              even so we will be careful.
+ * Values for bits in the LimitHandler flags field.
  */
 
-#define LIMIT_HANDLER_ACTIVE    0x01
-#define LIMIT_HANDLER_DELETED   0x02
-
-
+enum {
+    LIMIT_HANDLER_ACTIVE = 1,	/* Whether the handler is currently being
+				 * processed; handlers are never to be entered
+				 * reentrantly. */
+    LIMIT_HANDLER_DELETED = 2	/* Whether the handler has been deleted. This
+				 * should not normally be observed because
+				 * when a handler is deleted it is also
+				 * spliced out of the list of handlers, but
+				 * even so we will be careful. */
+};
 
 /*
  * Prototypes for local static functions:
@@ -4785,7 +4785,7 @@ ChildTimeLimitCmd(
 	Tcl_Obj *milliObj = NULL, *secObj = NULL;
 	int gran = 0;
 	Tcl_Time limitMoment;
-	int tmp;
+	Tcl_WideInt tmp;
 
 	Tcl_LimitGetTime(childInterp, &limitMoment);
 	for (i=consumedObjc ; i<objc ; i+=2) {
@@ -4817,17 +4817,17 @@ ChildTimeLimitCmd(
 		if (milliLen == 0) {
 		    break;
 		}
-		if (TclGetIntFromObj(interp, objv[i+1], &tmp) != TCL_OK) {
+		if (TclGetWideIntFromObj(interp, objv[i+1], &tmp) != TCL_OK) {
 		    return TCL_ERROR;
 		}
-		if (tmp < 0) {
-		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
-			    "milliseconds must be at least 0", -1));
+		if (tmp < 0 || tmp > LONG_MAX) {
+		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			    "milliseconds must be between 0 and %ld", LONG_MAX));
 		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
 			    "BADVALUE", NULL);
 		    return TCL_ERROR;
 		}
-		limitMoment.usec = ((long) tmp)*1000;
+		limitMoment.usec = ((long)tmp)*1000;
 		break;
 	    case OPT_SEC:
 		secObj = objv[i+1];
@@ -4835,17 +4835,17 @@ ChildTimeLimitCmd(
 		if (secLen == 0) {
 		    break;
 		}
-		if (TclGetIntFromObj(interp, objv[i+1], &tmp) != TCL_OK) {
+		if (TclGetWideIntFromObj(interp, objv[i+1], &tmp) != TCL_OK) {
 		    return TCL_ERROR;
 		}
-		if (tmp < 0) {
-		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
-			    "seconds must be at least 0", -1));
+		if (tmp < 0 || tmp > LONG_MAX) {
+		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+			    "seconds must be between 0 and %ld", LONG_MAX));
 		    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "INTERP",
 			    "BADVALUE", NULL);
 		    return TCL_ERROR;
 		}
-		limitMoment.sec = tmp;
+		limitMoment.sec = (long)tmp;
 		break;
 	    }
 	}

generic/tclLink.c

@@ -75,21 +75,19 @@ typedef struct Link {
 
 /*
  * Definitions for flag bits:
- * LINK_READ_ONLY -		1 means errors should be generated if Tcl
- *				script attempts to write variable.
- * LINK_BEING_UPDATED -		1 means that a call to Tcl_UpdateLinkedVar is
- *				in progress for this variable, so trace
- *				callbacks on the variable should be ignored.
- * LINK_ALLOC_ADDR -		1 means linkPtr->addr was allocated on the
- *				heap.
- * LINK_ALLOC_LAST -		1 means linkPtr->valueLast.p was allocated on
- *				the heap.
  */
 
-#define LINK_READ_ONLY		1
-#define LINK_BEING_UPDATED	2
-#define LINK_ALLOC_ADDR		4
-#define LINK_ALLOC_LAST		8
+enum {
+    LINK_READ_ONLY = 1,		/* Errors should be generated if Tcl script
+				 * attempts to write variable.*/
+    LINK_BEING_UPDATED = 2,	/* A call to Tcl_UpdateLinkedVar is in
+				 * progress for this variable, so trace
+				 * callbacks on the variable should be
+				 * ignored. */
+    LINK_ALLOC_ADDR = 4,	/* linkPtr->addr was allocated on the heap. */
+    LINK_ALLOC_LAST = 8		/* linkPtr->valueLast.p was allocated on the
+				 * heap. */
+};
 
 /*
  * Forward references to functions defined later in this file:
@@ -110,11 +108,11 @@ static int		SetInvalidRealFromAny(Tcl_Interp *interp,
  */
 
 static Tcl_ObjType invalidRealType = {
-    "invalidReal",			/* name */
-    NULL,				/* freeIntRepProc */
-    NULL,				/* dupIntRepProc */
-    NULL,				/* updateStringProc */
-    NULL				/* setFromAnyProc */
+    "invalidReal",		/* name */
+    NULL,			/* freeIntRepProc */
+    NULL,			/* dupIntRepProc */
+    NULL,			/* updateStringProc */
+    NULL			/* setFromAnyProc */
 };
 
 /*

generic/tclMain.c

@@ -64,11 +64,6 @@ NewNativeObj(
  * source directory to make their own modified versions).
  */
 
-#if defined _MSC_VER && _MSC_VER < 1900
-/* isatty is always defined on MSVC 14.0, but not necessarily as CRTIMPORT. */
-extern CRTIMPORT int	isatty(int fd);
-#endif
-
 /*
  * The thread-local variables for this file's functions.
  */

generic/tclNotify.c

@@ -10,6 +10,7 @@
  * Copyright © 1995-1997 Sun Microsystems, Inc.
  * Copyright © 1998 Scriptics Corporation.
  * Copyright © 2003 Kevin B. Kenny.  All rights reserved.
+ * Copyright © 2021 Donal K. Fellows
  *
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -18,11 +19,11 @@
 #include "tclInt.h"
 
 /*
- * Module-scope struct of notifier hooks that are checked in the default
+ * Notifier hooks that are checked in the public wrappers for the default
  * notifier functions (for overriding via Tcl_SetNotifier).
  */
 
-Tcl_NotifierProcs tclNotifierHooks = {
+static Tcl_NotifierProcs tclNotifierHooks = {
     NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL
 };
 
@@ -174,7 +175,8 @@ TclFinalizeNotifier(void)
     Tcl_Event *evPtr, *hold;
 
     if (!tsdPtr->initialized) {
-	return;		/* Notifier not initialized for the current thread */
+	return;			/* Notifier not initialized for the current
+				 * thread. */
     }
 
     Tcl_MutexLock(&(tsdPtr->queueMutex));
@@ -227,6 +229,38 @@ Tcl_SetNotifier(
     Tcl_NotifierProcs *notifierProcPtr)
 {
     tclNotifierHooks = *notifierProcPtr;
+
+    /*
+     * Don't allow hooks to refer to the hook point functions; avoids infinite
+     * loop.
+     */
+
+    if (tclNotifierHooks.setTimerProc == Tcl_SetTimer) {
+	tclNotifierHooks.setTimerProc = NULL;
+    }
+    if (tclNotifierHooks.waitForEventProc == Tcl_WaitForEvent) {
+	tclNotifierHooks.waitForEventProc = NULL;
+    }
+    if (tclNotifierHooks.initNotifierProc == Tcl_InitNotifier) {
+	tclNotifierHooks.initNotifierProc = NULL;
+    }
+    if (tclNotifierHooks.finalizeNotifierProc == Tcl_FinalizeNotifier) {
+	tclNotifierHooks.finalizeNotifierProc = NULL;
+    }
+    if (tclNotifierHooks.alertNotifierProc == Tcl_AlertNotifier) {
+	tclNotifierHooks.alertNotifierProc = NULL;
+    }
+    if (tclNotifierHooks.serviceModeHookProc == Tcl_ServiceModeHook) {
+	tclNotifierHooks.serviceModeHookProc = NULL;
+    }
+#ifndef _WIN32
+    if (tclNotifierHooks.createFileHandlerProc == Tcl_CreateFileHandler) {
+	tclNotifierHooks.createFileHandlerProc = NULL;
+    }
+    if (tclNotifierHooks.deleteFileHandlerProc == Tcl_DeleteFileHandler) {
+	tclNotifierHooks.deleteFileHandlerProc = NULL;
+    }
+#endif /* !_WIN32 */
 }
 
 /*
@@ -276,7 +310,7 @@ Tcl_CreateEventSource(
 				 * checkProc. */
 {
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
-    EventSource *sourcePtr = (EventSource *)ckalloc(sizeof(EventSource));
+    EventSource *sourcePtr = (EventSource *) ckalloc(sizeof(EventSource));
 
     sourcePtr->setupProc = setupProc;
     sourcePtr->checkProc = checkProc;
@@ -794,7 +828,7 @@ Tcl_SetServiceMode(
 
 void
 Tcl_SetMaxBlockTime(
-    const Tcl_Time *timePtr)		/* Specifies a maximum elapsed time for the
+    const Tcl_Time *timePtr)	/* Specifies a maximum elapsed time for the
 				 * next blocking operation in the event
 				 * tsdPtr-> */
 {
@@ -1132,6 +1166,260 @@ Tcl_ThreadAlert(
     Tcl_MutexUnlock(&listLock);
 }
 
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_InitNotifier --
+ *
+ *	Initializes the platform specific notifier state. Forwards to the
+ *	platform implementation when the hook is not enabled.
+ *
+ * Results:
+ *	Returns a handle to the notifier state for this thread..
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ClientData
+Tcl_InitNotifier(void)
+{
+    if (tclNotifierHooks.initNotifierProc) {
+	return tclNotifierHooks.initNotifierProc();
+    } else {
+	return TclpInitNotifier();
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FinalizeNotifier --
+ *
+ *	This function is called to cleanup the notifier state before a thread
+ *	is terminated. Forwards to the platform implementation when the hook
+ *	is not enabled.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	If no finalizeNotifierProc notifier hook exists, TclpFinalizeNotifier
+ *	is called.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_FinalizeNotifier(
+    ClientData clientData)
+{
+    if (tclNotifierHooks.finalizeNotifierProc) {
+	tclNotifierHooks.finalizeNotifierProc(clientData);
+    } else {
+	TclpFinalizeNotifier(clientData);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_AlertNotifier --
+ *
+ *	Wake up the specified notifier from any thread. This routine is called
+ *	by the platform independent notifier code whenever the Tcl_ThreadAlert
+ *	routine is called. This routine is guaranteed not to be called by Tcl
+ *	on a given notifier after Tcl_FinalizeNotifier is called for that
+ *	notifier.  This routine is typically called from a thread other than
+ *	the notifier's thread.  Forwards to the platform implementation when
+ *	the hook is not enabled.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	See the platform-specific implementations.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_AlertNotifier(
+    ClientData clientData)	/* Pointer to thread data. */
+{
+    if (tclNotifierHooks.alertNotifierProc) {
+	tclNotifierHooks.alertNotifierProc(clientData);
+    } else {
+	TclpAlertNotifier(clientData);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_ServiceModeHook --
+ *
+ *	This function is invoked whenever the service mode changes.  Forwards
+ *	to the platform implementation when the hook is not enabled.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	See the platform-specific implementations.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_ServiceModeHook(
+    int mode)			/* Either TCL_SERVICE_ALL, or
+				 * TCL_SERVICE_NONE. */
+{
+    if (tclNotifierHooks.serviceModeHookProc) {
+	tclNotifierHooks.serviceModeHookProc(mode);
+    } else {
+	TclpServiceModeHook(mode);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetTimer --
+ *
+ *	This function sets the current notifier timer value.  Forwards to the
+ *	platform implementation when the hook is not enabled.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	See the platform-specific implementations.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SetTimer(
+    const Tcl_Time *timePtr)		/* Timeout value, may be NULL. */
+{
+    if (tclNotifierHooks.setTimerProc) {
+	tclNotifierHooks.setTimerProc(timePtr);
+    } else {
+	TclpSetTimer(timePtr);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_WaitForEvent --
+ *
+ *	This function is called by Tcl_DoOneEvent to wait for new events on
+ *	the notifier's message queue.  If the block time is 0, then
+ *	Tcl_WaitForEvent just polls without blocking.  Forwards to the
+ *	platform implementation when the hook is not enabled.
+ *
+ * Results:
+ *	Returns -1 if the wait would block forever, 1 if an out-of-loop source
+ *	was processed (see platform-specific notes) and otherwise returns 0.
+ *
+ * Side effects:
+ *	Queues file events that are detected by the notifier.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_WaitForEvent(
+    const Tcl_Time *timePtr)		/* Maximum block time, or NULL. */
+{
+    if (tclNotifierHooks.waitForEventProc) {
+	return tclNotifierHooks.waitForEventProc(timePtr);
+    } else {
+	return TclpWaitForEvent(timePtr);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_CreateFileHandler --
+ *
+ *	This function registers a file descriptor handler with the notifier.
+ *	Forwards to the platform implementation when the hook is not enabled.
+ *
+ *	This function is not defined on Windows. The OS API there is too
+ *	different.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Creates a new file handler structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifndef _WIN32
+void
+Tcl_CreateFileHandler(
+    int fd,			/* Handle of stream to watch. */
+    int mask,			/* OR'ed combination of TCL_READABLE,
+				 * TCL_WRITABLE, and TCL_EXCEPTION: indicates
+				 * conditions under which proc should be
+				 * called. */
+    Tcl_FileProc *proc,		/* Function to call for each selected
+				 * event. */
+    ClientData clientData)	/* Arbitrary data to pass to proc. */
+{
+    if (tclNotifierHooks.createFileHandlerProc) {
+	tclNotifierHooks.createFileHandlerProc(fd, mask, proc, clientData);
+    } else {
+	TclpCreateFileHandler(fd, mask, proc, clientData);
+    }
+}
+#endif /* !_WIN32 */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DeleteFileHandler --
+ *
+ *	Cancel a previously-arranged callback arrangement for a file
+ *	descriptor.  Forwards to the platform implementation when the hook is
+ *	not enabled.
+ *
+ *	This function is not defined on Windows. The OS API there is too
+ *	different.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	If a callback was previously registered on the file descriptor, remove
+ *	it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifndef _WIN32
+void
+Tcl_DeleteFileHandler(
+    int fd)			/* Stream id for which to remove callback
+				 * function. */
+{
+    if (tclNotifierHooks.deleteFileHandlerProc) {
+	tclNotifierHooks.deleteFileHandlerProc(fd);
+    } else {
+	TclpDeleteFileHandler(fd);
+    }
+}
+#endif /* !_WIN32 */
+
 /*
  * Local Variables:
  * mode: c

generic/tclOO.decls

@@ -5,7 +5,7 @@
 #	library via the stubs table.  This file is used to generate the
 #	tclOODecls.h, tclOOIntDecls.h and tclOOStubInit.c files.
 #
-# Copyright (c) 2008-2013 by Donal K. Fellows.
+# Copyright © 2008-2013 Donal K. Fellows.
 #
 # See the file "license.terms" for information on usage and redistribution of
 # this file, and for a DISCLAIMER OF ALL WARRANTIES.

generic/tclOO.h

@@ -105,9 +105,11 @@ typedef struct {
  * Tcl_NewInstanceMethod.
  */
 
-#define TCL_OO_METHOD_PUBLIC		1
-#define TCL_OO_METHOD_UNEXPORTED	0
-#define TCL_OO_METHOD_PRIVATE		0x20
+enum {
+    TCL_OO_METHOD_UNEXPORTED = 0,
+    TCL_OO_METHOD_PUBLIC = 1,
+    TCL_OO_METHOD_PRIVATE = 0x20
+};
 
 /*
  * The type of some object (or class) metadata. This describes how to delete

generic/tclOOCall.c

@@ -51,38 +51,15 @@ typedef struct {
  * Extra flags used for call chain management.
  */
 
-#define DEFINITE_PROTECTED 0x100000
-#define DEFINITE_PUBLIC    0x200000
-#define KNOWN_STATE	   (DEFINITE_PROTECTED | DEFINITE_PUBLIC)
-#define SPECIAL		   (CONSTRUCTOR | DESTRUCTOR | FORCE_UNKNOWN)
-#define BUILDING_MIXINS	   0x400000
-#define TRAVERSED_MIXIN	   0x800000
-#define OBJECT_MIXIN	   0x1000000
-#define MIXIN_CONSISTENT(flags) \
-    (((flags) & OBJECT_MIXIN) ||					\
-	!((flags) & BUILDING_MIXINS) == !((flags) & TRAVERSED_MIXIN))
-
-/*
- * Note that the flag bit PRIVATE_METHOD has a confusing name; it's just for
- * Itcl's special type of private.
- */
-
-#define IS_PUBLIC(mPtr)				\
-    (((mPtr)->flags & PUBLIC_METHOD) != 0)
-#define IS_UNEXPORTED(mPtr)			\
-    (((mPtr)->flags & SCOPE_FLAGS) == 0)
-#define IS_ITCLPRIVATE(mPtr)				\
-    (((mPtr)->flags & PRIVATE_METHOD) != 0)
-#define IS_PRIVATE(mPtr)			\
-    (((mPtr)->flags & TRUE_PRIVATE_METHOD) != 0)
-#define WANT_PUBLIC(flags)			\
-    (((flags) & PUBLIC_METHOD) != 0)
-#define WANT_UNEXPORTED(flags)			\
-    (((flags) & (PRIVATE_METHOD | TRUE_PRIVATE_METHOD)) == 0)
-#define WANT_ITCLPRIVATE(flags)			\
-    (((flags) & PRIVATE_METHOD) != 0)
-#define WANT_PRIVATE(flags)			\
-    (((flags) & TRUE_PRIVATE_METHOD) != 0)
+enum {
+    DEFINITE_PROTECTED = 0x100000,
+    DEFINITE_PUBLIC = 0x200000,
+    KNOWN_STATE = (DEFINITE_PROTECTED | DEFINITE_PUBLIC),
+    SPECIAL = (CONSTRUCTOR | DESTRUCTOR | FORCE_UNKNOWN),
+    BUILDING_MIXINS = 0x400000,
+    TRAVERSED_MIXIN = 0x800000,
+    OBJECT_MIXIN = 0x1000000
+};
 
 /*
  * Function declarations for things defined in this file.
@@ -152,7 +129,60 @@ static const Tcl_ObjType methodNameType = {
     NULL,
     NULL
 };
+
+/*
+ * Inline functions that test flags.
+ */
 
+static inline int
+MixinConsistent(
+    int flags)
+{
+    return (flags & OBJECT_MIXIN) ||
+	    (!(flags & BUILDING_MIXINS) == !(flags & TRAVERSED_MIXIN));
+}
+
+static inline int
+IsPublic(
+    Method *mPtr)
+{
+    return (mPtr->flags & PUBLIC_METHOD) != 0;
+}
+
+static inline int
+IsUnexported(
+    Method *mPtr)
+{
+    return (mPtr->flags & SCOPE_FLAGS) == 0;
+}
+
+static inline int
+IsPrivate(
+    Method *mPtr)
+{
+    return (mPtr->flags & TRUE_PRIVATE_METHOD) != 0;
+}
+
+static inline int
+WantPublic(
+    int flags)
+{
+    return (flags & PUBLIC_METHOD) != 0;
+}
+
+static inline int
+WantUnexported(
+    int flags)
+{
+    return (flags & (PRIVATE_METHOD | TRUE_PRIVATE_METHOD)) == 0;
+}
+
+static inline int
+WantPrivate(
+    int flags)
+{
+    return (flags & TRUE_PRIVATE_METHOD) != 0;
+}
 
 /*
  * ----------------------------------------------------------------------
@@ -279,16 +309,16 @@ DupMethodNameRep(
     Tcl_Obj *srcPtr,
     Tcl_Obj *dstPtr)
 {
-    StashCallChain(dstPtr,
-	    (CallChain *)TclFetchIntRep(srcPtr, &methodNameType)->twoPtrValue.ptr1);
+    StashCallChain(dstPtr, (CallChain *)
+	    TclFetchIntRep(srcPtr, &methodNameType)->twoPtrValue.ptr1);
 }
 
 static void
 FreeMethodNameRep(
     Tcl_Obj *objPtr)
 {
-    TclOODeleteChain(
-	    (CallChain *)TclFetchIntRep(objPtr, &methodNameType)->twoPtrValue.ptr1);
+    TclOODeleteChain((CallChain *)
+	    TclFetchIntRep(objPtr, &methodNameType)->twoPtrValue.ptr1);
 }
 
 /*
@@ -465,10 +495,10 @@ TclOOGetSortedMethodList(
 
     if (oPtr->methodsPtr) {
 	FOREACH_HASH(namePtr, mPtr, oPtr->methodsPtr) {
-	    if (IS_PRIVATE(mPtr)) {
+	    if (IsPrivate(mPtr)) {
 		continue;
 	    }
-	    if (IS_UNEXPORTED(mPtr) && !WANT_UNEXPORTED(flags)) {
+	    if (IsUnexported(mPtr) && !WantUnexported(flags)) {
 		continue;
 	    }
 	    AddStandardMethodName(flags, namePtr, mPtr, &names);
@@ -479,9 +509,9 @@ TclOOGetSortedMethodList(
      * Process method names due to private methods on the object's class.
      */
 
-    if (WANT_UNEXPORTED(flags)) {
+    if (WantUnexported(flags)) {
 	FOREACH_HASH(namePtr, mPtr, &oPtr->selfCls->classMethods) {
-	    if (IS_UNEXPORTED(mPtr)) {
+	    if (IsUnexported(mPtr)) {
 		AddStandardMethodName(flags, namePtr, mPtr, &names);
 	    }
 	}
@@ -551,7 +581,7 @@ TclOOGetSortedClassMethodList(
      * Process private method names if we should. [TIP 500]
      */
 
-    if (WANT_PRIVATE(flags)) {
+    if (WantPrivate(flags)) {
 	AddPrivateMethodNames(&clsPtr->classMethods, &names);
 	flags &= ~TRUE_PRIVATE_METHOD;
     }
@@ -615,7 +645,7 @@ SortMethodNames(
 
     strings = (const char **)ckalloc(sizeof(char *) * namesPtr->numEntries);
     FOREACH_HASH(namePtr, isWanted, namesPtr) {
-	if (!WANT_PUBLIC(flags) || (PTR2INT(isWanted) & IN_LIST)) {
+	if (!WantPublic(flags) || (PTR2INT(isWanted) & IN_LIST)) {
 	    if (PTR2INT(isWanted) & NO_IMPLEMENTATION) {
 		continue;
 	    }
@@ -766,7 +796,7 @@ AddPrivateMethodNames(
     Tcl_Obj *namePtr;
 
     FOREACH_HASH(namePtr, mPtr, methodsTablePtr) {
-	if (IS_PRIVATE(mPtr)) {
+	if (IsPrivate(mPtr)) {
 	    int isNew;
 
 	    hPtr = Tcl_CreateHashEntry(namesPtr, (char *) namePtr, &isNew);
@@ -782,13 +812,13 @@ AddStandardMethodName(
     Method *mPtr,
     Tcl_HashTable *namesPtr)
 {
-    if (!IS_PRIVATE(mPtr)) {
+    if (!IsPrivate(mPtr)) {
 	int isNew;
 	Tcl_HashEntry *hPtr =
 		Tcl_CreateHashEntry(namesPtr, (char *) namePtr, &isNew);
 
 	if (isNew) {
-	    int isWanted = (!WANT_PUBLIC(flags) || IS_PUBLIC(mPtr))
+	    int isWanted = (!WantPublic(flags) || IsPublic(mPtr))
 		    ? IN_LIST : 0;
 
 	    isWanted |= (mPtr->typePtr == NULL ? NO_IMPLEMENTATION : 0);
@@ -836,7 +866,7 @@ AddInstancePrivateToCallContext(
 	hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) methodName);
 	if (hPtr != NULL) {
 	    mPtr = (Method *)Tcl_GetHashValue(hPtr);
-	    if (IS_PRIVATE(mPtr)) {
+	    if (IsPrivate(mPtr)) {
 		AddMethodToCallChain(mPtr, cbPtr, NULL, NULL, flags);
 		donePrivate = 1;
 	    }
@@ -886,9 +916,9 @@ AddSimpleChainToCallContext(
 
 	if (hPtr != NULL) {
 	    mPtr = (Method *)Tcl_GetHashValue(hPtr);
-	    if (!IS_PRIVATE(mPtr)) {
-		if (WANT_PUBLIC(flags)) {
-		    if (!IS_PUBLIC(mPtr)) {
+	    if (!IsPrivate(mPtr)) {
+		if (WantPublic(flags)) {
+		    if (!IsPublic(mPtr)) {
 			blockedUnexported = 1;
 		    } else {
 			flags |= DEFINITE_PUBLIC;
@@ -916,7 +946,7 @@ AddSimpleChainToCallContext(
 	    hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char*) methodNameObj);
 	    if (hPtr != NULL) {
 		mPtr = (Method *)Tcl_GetHashValue(hPtr);
-		if (!IS_PRIVATE(mPtr)) {
+		if (!IsPrivate(mPtr)) {
 		    AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl,
 			    flags);
 		}
@@ -979,7 +1009,7 @@ AddMethodToCallChain(
      * This is also where we enforce mixin-consistency.
      */
 
-    if (mPtr == NULL || mPtr->typePtr == NULL || !MIXIN_CONSISTENT(flags)) {
+    if (mPtr == NULL || mPtr->typePtr == NULL || !MixinConsistent(flags)) {
 	return;
     }
 
@@ -995,8 +1025,8 @@ AddMethodToCallChain(
      * should be sufficient for [incr Tcl] support though.
      */
 
-    if (!WANT_UNEXPORTED(callPtr->flags)
-	    && IS_UNEXPORTED(mPtr)
+    if (!WantUnexported(callPtr->flags)
+	    && IsUnexported(mPtr)
 	    && (mPtr->declaringClassPtr != NULL)
 	    && (mPtr->declaringClassPtr != cbPtr->oPtr->selfCls)) {
 	return;
@@ -1156,7 +1186,7 @@ TclOOGetCallContext(
     if (cacheInThisObj == NULL) {
 	cacheInThisObj = methodNameObj;
     }
-    if (flags&(SPECIAL|FILTER_HANDLING) || (oPtr->flags&FILTER_HANDLING)) {
+    if (flags & (SPECIAL|FILTER_HANDLING) || (oPtr->flags & FILTER_HANDLING)) {
 	hPtr = NULL;
 	doFilters = 0;
 
@@ -1190,7 +1220,7 @@ TclOOGetCallContext(
 	 */
 
 	const Tcl_ObjIntRep *irPtr;
-	const int reuseMask = (WANT_PUBLIC(flags) ? ~0 : ~PUBLIC_METHOD);
+	const int reuseMask = (WantPublic(flags) ? ~0 : ~PUBLIC_METHOD);
 
 	if ((irPtr = TclFetchIntRep(cacheInThisObj, &methodNameType))) {
 	    callPtr = (CallChain *)irPtr->twoPtrValue.ptr1;
@@ -1218,7 +1248,7 @@ TclOOGetCallContext(
 	}
 
 	if (hPtr != NULL && Tcl_GetHashValue(hPtr) != NULL) {
-	    callPtr = (CallChain *)Tcl_GetHashValue(hPtr);
+	    callPtr = (CallChain *) Tcl_GetHashValue(hPtr);
 	    if (IsStillValid(callPtr, oPtr, flags, reuseMask)) {
 		callPtr->refCount++;
 		goto returnContext;
@@ -1230,7 +1260,7 @@ TclOOGetCallContext(
 	doFilters = 1;
     }
 
-    callPtr = (CallChain *)ckalloc(sizeof(CallChain));
+    callPtr = (CallChain *) ckalloc(sizeof(CallChain));
     InitCallChain(callPtr, oPtr, flags);
 
     cb.callChainPtr = callPtr;
@@ -1335,7 +1365,7 @@ TclOOGetCallContext(
 	    if (oPtr->flags & USE_CLASS_CACHE) {
 		if (oPtr->selfCls->classChainCache == NULL) {
 		    oPtr->selfCls->classChainCache =
-			    (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
+			    (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
 
 		    Tcl_InitObjHashTable(oPtr->selfCls->classChainCache);
 		}
@@ -1343,7 +1373,8 @@ TclOOGetCallContext(
 			(char *) methodNameObj, &i);
 	    } else {
 		if (oPtr->chainCache == NULL) {
-		    oPtr->chainCache = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
+		    oPtr->chainCache = (Tcl_HashTable *)
+			    ckalloc(sizeof(Tcl_HashTable));
 
 		    Tcl_InitObjHashTable(oPtr->chainCache);
 		}
@@ -1369,7 +1400,8 @@ TclOOGetCallContext(
     }
 
   returnContext:
-    contextPtr = (CallContext *)TclStackAlloc(oPtr->fPtr->interp, sizeof(CallContext));
+    contextPtr = (CallContext *)
+	    TclStackAlloc(oPtr->fPtr->interp, sizeof(CallContext));
     contextPtr->oPtr = oPtr;
 
     /*
@@ -1436,9 +1468,9 @@ TclOOGetStereotypeCallChain(
 	hPtr = Tcl_FindHashEntry(clsPtr->classChainCache,
 		(char *) methodNameObj);
 	if (hPtr != NULL && Tcl_GetHashValue(hPtr) != NULL) {
-	    const int reuseMask = (WANT_PUBLIC(flags) ? ~0 : ~PUBLIC_METHOD);
+	    const int reuseMask = (WantPublic(flags) ? ~0 : ~PUBLIC_METHOD);
 
-	    callPtr = (CallChain *)Tcl_GetHashValue(hPtr);
+	    callPtr = (CallChain *) Tcl_GetHashValue(hPtr);
 	    if (IsStillValid(callPtr, &obj, flags, reuseMask)) {
 		callPtr->refCount++;
 		return callPtr;
@@ -1450,9 +1482,9 @@ TclOOGetStereotypeCallChain(
 	hPtr = NULL;
     }
 
-    callPtr = (CallChain *)ckalloc(sizeof(CallChain));
+    callPtr = (CallChain *) ckalloc(sizeof(CallChain));
     memset(callPtr, 0, sizeof(CallChain));
-    callPtr->flags = flags & (PUBLIC_METHOD|PRIVATE_METHOD|FILTER_HANDLING);
+    callPtr->flags = flags & (PUBLIC_METHOD | PRIVATE_METHOD | FILTER_HANDLING);
     callPtr->epoch = fPtr->epoch;
     callPtr->objectCreationEpoch = fPtr->tsdPtr->nsCount;
     callPtr->objectEpoch = clsPtr->thisPtr->epoch;
@@ -1505,7 +1537,8 @@ TclOOGetStereotypeCallChain(
     } else {
 	if (hPtr == NULL) {
 	    if (clsPtr->classChainCache == NULL) {
-		clsPtr->classChainCache = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
+		clsPtr->classChainCache = (Tcl_HashTable *)
+			ckalloc(sizeof(Tcl_HashTable));
 		Tcl_InitObjHashTable(clsPtr->classChainCache);
 	    }
 	    hPtr = Tcl_CreateHashEntry(clsPtr->classChainCache,
@@ -1568,7 +1601,7 @@ AddClassFiltersToCallContext(
      * override how filters work to extend their behaviour.
      */
 
-    if (MIXIN_CONSISTENT(flags)) {
+    if (MixinConsistent(flags)) {
 	FOREACH(filterObj, clsPtr->filters) {
 	    int isNew;
 
@@ -1658,7 +1691,7 @@ AddPrivatesFromClassChainToCallContext(
 	if (hPtr != NULL) {
 	    Method *mPtr = (Method *)Tcl_GetHashValue(hPtr);
 
-	    if (IS_PRIVATE(mPtr)) {
+	    if (IsPrivate(mPtr)) {
 		AddMethodToCallChain(mPtr, cbPtr, doneFilters, filterDecl,
 			flags);
 		return 1;
@@ -1743,10 +1776,10 @@ AddSimpleClassChainToCallContext(
 	if (hPtr != NULL) {
 	    Method *mPtr = (Method *)Tcl_GetHashValue(hPtr);
 
-	    if (!IS_PRIVATE(mPtr)) {
+	    if (!IsPrivate(mPtr)) {
 		if (!(flags & KNOWN_STATE)) {
 		    if (flags & PUBLIC_METHOD) {
-			if (!IS_PUBLIC(mPtr)) {
+			if (!IsPublic(mPtr)) {
 			    return privateDanger;
 			}
 			flags |= DEFINITE_PUBLIC;
@@ -1821,14 +1854,15 @@ TclOORenderCallChain(
      * method (or "object" if it is declared on the instance).
      */
 
-    objv = (Tcl_Obj **)TclStackAlloc(interp, callPtr->numChain * sizeof(Tcl_Obj *));
+    objv = (Tcl_Obj **)
+	    TclStackAlloc(interp, callPtr->numChain * sizeof(Tcl_Obj *));
     for (i = 0 ; i < callPtr->numChain ; i++) {
 	struct MInvoke *miPtr = &callPtr->chain[i];
 
 	descObjs[0] =
 	    miPtr->isFilter ? filterLiteral :
 	    callPtr->flags & OO_UNKNOWN_METHOD ? fPtr->unknownMethodNameObj :
-	    IS_PRIVATE(miPtr->mPtr) ? privateLiteral :
+	    IsPrivate(miPtr->mPtr) ? privateLiteral :
 		    methodLiteral;
 	descObjs[1] =
 	    callPtr->flags & CONSTRUCTOR ? fPtr->constructorName :
@@ -2027,8 +2061,9 @@ AddSimpleClassDefineNamespaces(
 
 static inline void
 AddDefinitionNamespaceToChain(
-    Class *const definerCls,		/* What class defines this entry. */
-    Tcl_Obj *const namespaceName,	/* The name for this entry (or NULL, a
+    Class *const definerCls,	/* What class defines this entry. */
+    Tcl_Obj *const namespaceName,
+				/* The name for this entry (or NULL, a
 				 * no-op). */
     DefineChain *const definePtr,
 				/* The define chain to add the method
@@ -2047,7 +2082,7 @@ AddDefinitionNamespaceToChain(
      * mixin-consistency.
      */
 
-    if (namespaceName == NULL || !MIXIN_CONSISTENT(flags)) {
+    if (namespaceName == NULL || !MixinConsistent(flags)) {
 	return;
     }
 
@@ -2088,12 +2123,12 @@ AddDefinitionNamespaceToChain(
 	if (definePtr->num == DEFINE_CHAIN_STATIC_SIZE) {
 	    DefineEntry *staticList = definePtr->list;
 
-	    definePtr->list =
-		    (DefineEntry *)ckalloc(sizeof(DefineEntry) * definePtr->size);
+	    definePtr->list = (DefineEntry *)
+		    ckalloc(sizeof(DefineEntry) * definePtr->size);
 	    memcpy(definePtr->list, staticList,
 		    sizeof(DefineEntry) * definePtr->num);
 	} else {
-	    definePtr->list = (DefineEntry *)ckrealloc(definePtr->list,
+	    definePtr->list = (DefineEntry *) ckrealloc(definePtr->list,
 		    sizeof(DefineEntry) * definePtr->size);
 	}
     }

generic/tclOOInt.h

@@ -103,16 +103,19 @@ typedef struct ProcedureMethod {
 
 /*
  * Flags for use in a ProcedureMethod.
- *
- * When the USE_DECLARER_NS flag is set, the method will use the namespace of
- * the object or class that declared it (or the clone of it, if it was from
- * such that the implementation of the method came to the particular use)
- * instead of the namespace of the object on which the method was invoked.
- * This flag must be distinct from all others that are associated with
- * methods.
  */
 
-#define USE_DECLARER_NS		0x80
+enum {
+    USE_DECLARER_NS = 0x80	/* When the USE_DECLARER_NS flag is set, the
+				 * method will use the namespace of the object
+				 * or class that declared it (or the clone of
+				 * it, if it was from such that the
+				 * implementation of the method came to the
+				 * particular use) instead of the namespace of
+				 * the object on which the method was invoked.
+				 * This flag must be distinct from all others
+				 * that are associated with methods. */
+};
 
 /*
  * Forwarded methods have the following extra information.
@@ -213,36 +216,38 @@ typedef struct Object {
 				 * command. */
 } Object;
 
-#define OBJECT_DESTRUCTING	1	/* Indicates that an object is being or has
-								 *  been destroyed  */
-#define DESTRUCTOR_CALLED 2	/* Indicates that evaluation of destructor script for the
-							   object has began */
-#define OO_UNUSED_4	4	/* No longer used.  */
-#define ROOT_OBJECT 0x1000	/* Flag to say that this object is the root of
+enum {
+    OBJECT_DESTRUCTING = 1,	/* Indicates that an object is being or has
+				 * been destroyed  */
+    DESTRUCTOR_CALLED = 2,	/* Indicates that evaluation of destructor
+				 * script for the object has began */
+    OO_UNUSED_4 = 4,		/* No longer used.  */
+    ROOT_OBJECT = 0x1000,	/* Flag to say that this object is the root of
 				 * the class hierarchy and should be treated
 				 * specially during teardown. */
-#define FILTER_HANDLING 0x2000	/* Flag set when the object is processing a
+    FILTER_HANDLING = 0x2000,	/* Flag set when the object is processing a
 				 * filter; when set, filters are *not*
 				 * processed on the object, preventing nasty
 				 * recursive filtering problems. */
-#define USE_CLASS_CACHE 0x4000	/* Flag set to say that the object is a pure
+    USE_CLASS_CACHE = 0x4000,	/* Flag set to say that the object is a pure
 				 * instance of the class, and has had nothing
 				 * added that changes the dispatch chain (i.e.
 				 * no methods, mixins, or filters. */
-#define ROOT_CLASS 0x8000	/* Flag to say that this object is the root
+    ROOT_CLASS = 0x8000,	/* Flag to say that this object is the root
 				 * class of classes, and should be treated
 				 * specially during teardown (and in a few
 				 * other spots). */
-#define FORCE_UNKNOWN 0x10000	/* States that we are *really* looking up the
+    FORCE_UNKNOWN = 0x10000,	/* States that we are *really* looking up the
 				 * unknown method handler at that point. */
-#define HAS_PRIVATE_METHODS 0x20000
+    HAS_PRIVATE_METHODS = 0x20000,
 				/* Object/class has (or had) private methods,
 				 * and so shouldn't be cached so
 				 * aggressively. */
-#define DONT_DELETE 0x40000	/* Inhibit deletion of this object. Used
+    DONT_DELETE = 0x40000	/* Inhibit deletion of this object. Used
 				 * during fundamental object type mutation to
 				 * make sure that the object actually survives
 				 * to the end of the operation. */
+};
 
 /*
  * And the definition of a class. Note that every class also has an associated
@@ -418,17 +423,18 @@ typedef struct CallContext {
  * Bits for the 'flags' field of the call chain.
  */
 
-#define PUBLIC_METHOD     0x01	/* This is a public (exported) method. */
-#define PRIVATE_METHOD    0x02	/* This is a private (class's direct instances
+enum {
+    PUBLIC_METHOD = 0x01,	/* This is a public (exported) method. */
+    PRIVATE_METHOD = 0x02,	/* This is a private (class's direct instances
 				 * only) method. Supports itcl. */
-#define OO_UNKNOWN_METHOD 0x04	/* This is an unknown method. */
-#define CONSTRUCTOR	  0x08	/* This is a constructor. */
-#define DESTRUCTOR	  0x10	/* This is a destructor. */
-#define TRUE_PRIVATE_METHOD 0x20
-				/* This is a private method only accessible
+    OO_UNKNOWN_METHOD = 0x04,	/* This is an unknown method. */
+    CONSTRUCTOR = 0x08,		/* This is a constructor. */
+    DESTRUCTOR = 0x10,		/* This is a destructor. */
+    TRUE_PRIVATE_METHOD = 0x20,	/* This is a private method only accessible
 				 * from other methods defined on this class
 				 * or instance. [TIP #500] */
-#define SCOPE_FLAGS (PUBLIC_METHOD | PRIVATE_METHOD | TRUE_PRIVATE_METHOD)
+    SCOPE_FLAGS = (PUBLIC_METHOD | PRIVATE_METHOD | TRUE_PRIVATE_METHOD)
+};
 
 /*
  * Structure containing definition information about basic class methods.

generic/tclObj.c

@@ -165,19 +165,19 @@ static PendingObjData pendingObjData;
 static __thread PendingObjData pendingObjData;
 #define ObjInitDeletionContext(contextPtr) \
     PendingObjData *const contextPtr = &pendingObjData
-#else
+#else /* TCL_THREADS && !defined(HAVE_FAST_TSD) */
 static Tcl_ThreadDataKey pendingObjDataKey;
 #define ObjInitDeletionContext(contextPtr) \
-    PendingObjData *const contextPtr =     \
-	    (PendingObjData *)Tcl_GetThreadData(&pendingObjDataKey, sizeof(PendingObjData))
+    PendingObjData *const contextPtr = (PendingObjData *) \
+            Tcl_GetThreadData(&pendingObjDataKey, sizeof(PendingObjData))
 #endif
 
 /*
- * Macros to pack/unpack a bignum's fields in a Tcl_Obj internal rep
+ * Macro to pack a bignum's fields in a Tcl_Obj internal rep
  */
 
 #define PACK_BIGNUM(bignum, objPtr) \
-    if ((bignum).used > 0x7FFF) {                                   \
+    if ((bignum).used > 0x7FFF) {                                       \
 	mp_int *temp = (mp_int *)ckalloc(sizeof(mp_int));               \
 	*temp = bignum;                                                 \
 	(objPtr)->internalRep.twoPtrValue.ptr1 = temp;                  \
@@ -185,9 +185,28 @@ static Tcl_ThreadDataKey pendingObjDataKey;
     } else if (((bignum).alloc <= 0x7FFF) || (mp_shrink(&(bignum))) == MP_OKAY) { \
 	(objPtr)->internalRep.twoPtrValue.ptr1 = (void *)(bignum).dp;   \
 	(objPtr)->internalRep.twoPtrValue.ptr2 = INT2PTR(((bignum).sign << 30) \
-		| ((bignum).alloc << 15) | ((bignum).used));                \
+		| ((bignum).alloc << 15) | ((bignum).used));            \
     }
 
+/*
+ * Standard way to report a failure to parse something as an integer. This
+ * would probably be an exception throw if this was C++, but it isn't...
+ */
+
+static inline int
+NotAnInteger(
+    Tcl_Interp *interp,
+    Tcl_Obj *objPtr)
+{
+    if (interp != NULL) {
+	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		"expected integer but got \"%s\"",
+		TclGetString(objPtr)));
+	Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
+    }
+    return TCL_ERROR;
+}
+
 /*
  * Prototypes for functions defined later in this file:
  */
@@ -234,7 +253,7 @@ static const Tcl_ObjType oldBooleanType = {
     NULL,			/* freeIntRepProc */
     NULL,			/* dupIntRepProc */
     NULL,			/* updateStringProc */
-    TclSetBooleanFromAny		/* setFromAnyProc */
+    TclSetBooleanFromAny	/* setFromAnyProc */
 };
 #endif
 const Tcl_ObjType tclBooleanType = {
@@ -242,7 +261,7 @@ const Tcl_ObjType tclBooleanType = {
     NULL,			/* freeIntRepProc */
     NULL,			/* dupIntRepProc */
     NULL,			/* updateStringProc */
-    TclSetBooleanFromAny		/* setFromAnyProc */
+    TclSetBooleanFromAny	/* setFromAnyProc */
 };
 const Tcl_ObjType tclDoubleType = {
     "double",			/* name */
@@ -255,7 +274,8 @@ const Tcl_ObjType tclIntType = {
 #if defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8 || defined(TCL_WIDE_INT_IS_LONG)
     "int",			/* name */
 #else
-    "wideInt",		/* name, keeping maximum compatibility with Tcl 8.6 on 32-bit platforms*/
+    "wideInt",			/* name, keeping maximum compatibility with
+				 * Tcl 8.6 on 32-bit platforms*/
 #endif
     NULL,			/* freeIntRepProc */
     NULL,			/* dupIntRepProc */
@@ -336,7 +356,7 @@ typedef struct ResolvedCmdName {
 				 * reference (not the namespace that contains
 				 * the referenced command). NULL if the name
 				 * is fully qualified.*/
-    unsigned long refNsId;		/* refNsPtr's unique namespace id. Used to
+    unsigned long refNsId;	/* refNsPtr's unique namespace id. Used to
 				 * verify that refNsPtr is still valid (e.g.,
 				 * it's possible that the cmd's containing
 				 * namespace was deleted and a new one created
@@ -402,7 +422,7 @@ TclInitObjSubsystem(void)
     Tcl_RegisterObjType(&oldIntType);
 #endif
     Tcl_RegisterObjType(&oldBooleanType);
-#endif
+#endif /* !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 */
 
 #ifdef TCL_COMPILE_STATS
     Tcl_MutexLock(&tclObjMutex);
@@ -416,7 +436,7 @@ TclInitObjSubsystem(void)
 	}
     }
     Tcl_MutexUnlock(&tclObjMutex);
-#endif
+#endif /* TCL_COMPILE_STATS */
 }
 
 /*
@@ -567,7 +587,8 @@ TclContinuationsEnter(
     ThreadSpecificData *tsdPtr = TclGetContLineTable();
     Tcl_HashEntry *hPtr =
 	    Tcl_CreateHashEntry(tsdPtr->lineCLPtr, objPtr, &newEntry);
-    ContLineLoc *clLocPtr = (ContLineLoc *)ckalloc(offsetof(ContLineLoc, loc) + (num + 1) *sizeof(int));
+    ContLineLoc *clLocPtr = (ContLineLoc *)
+	    ckalloc(offsetof(ContLineLoc, loc) + (num + 1) *sizeof(int));
 
     if (!newEntry) {
 	/*
@@ -1028,7 +1049,7 @@ TclDbDumpActiveObjects(
     TCL_UNUSED(FILE *))
 {
 }
-#endif
+#endif /* TCL_THREADS && defined(TCL_MEM_DEBUG) */
 
 /*
  *----------------------------------------------------------------------
@@ -1326,7 +1347,7 @@ TclFreeObj(
 	    Tcl_DeleteHashEntry(hPtr);
 	}
     }
-# endif
+#endif /* TCL_THREADS */
 
     /*
      * Check for a double free of the same value.  This is slightly tricky
@@ -1553,24 +1574,27 @@ TclObjBeingDeleted(
  *----------------------------------------------------------------------
  */
 
-#define SetDuplicateObj(dupPtr, objPtr)					\
-    {									\
-	const Tcl_ObjType *typePtr = (objPtr)->typePtr;			\
-	const char *bytes = (objPtr)->bytes;				\
-	if (bytes) {							\
-	    TclInitStringRep((dupPtr), bytes, (objPtr)->length);	\
-	} else {							\
-	    (dupPtr)->bytes = NULL;					\
-	}								\
-	if (typePtr) {							\
-	    if (typePtr->dupIntRepProc) {				\
-		typePtr->dupIntRepProc((objPtr), (dupPtr));		\
-	    } else {							\
-		(dupPtr)->internalRep = (objPtr)->internalRep;		\
-		(dupPtr)->typePtr = typePtr;				\
-	    }								\
-	}								\
+static inline void
+SetDuplicateObj(
+    Tcl_Obj *dupPtr,
+    Tcl_Obj *objPtr)
+{
+    const Tcl_ObjType *typePtr = objPtr->typePtr;
+    const char *bytes = objPtr->bytes;
+    if (bytes) {
+        TclInitStringRep(dupPtr, bytes, objPtr->length);
+    } else {
+        dupPtr->bytes = NULL;
     }
+    if (typePtr) {
+        if (typePtr->dupIntRepProc) {
+            typePtr->dupIntRepProc(objPtr, dupPtr);
+        } else {
+            dupPtr->internalRep = objPtr->internalRep;
+            dupPtr->typePtr = typePtr;
+        }
+    }
+}
 
 Tcl_Obj *
 Tcl_DuplicateObj(
@@ -1617,9 +1641,10 @@ TclSetDuplicateObj(
  *----------------------------------------------------------------------
  */
 
+#undef Tcl_GetString
 char *
 Tcl_GetString(
-    Tcl_Obj *objPtr)	/* Object whose string rep byte pointer should
+    Tcl_Obj *objPtr)		/* Object whose string rep byte pointer should
 				 * be returned. */
 {
     if (objPtr->bytes == NULL) {
@@ -1676,9 +1701,9 @@ Tcl_GetString(
 #undef Tcl_GetStringFromObj
 char *
 Tcl_GetStringFromObj(
-    Tcl_Obj *objPtr,	/* Object whose string rep byte pointer should
+    Tcl_Obj *objPtr,		/* Object whose string rep byte pointer should
 				 * be returned. */
-    int *lengthPtr)	/* If non-NULL, the location where the string
+    int *lengthPtr)		/* If non-NULL, the location where the string
 				 * rep's byte array length should * be stored.
 				 * If NULL, no length is stored. */
 {
@@ -1716,9 +1741,9 @@ Tcl_GetStringFromObj(
 #undef TclGetStringFromObj
 char *
 TclGetStringFromObj(
-    Tcl_Obj *objPtr,	/* Object whose string rep byte pointer should
+    Tcl_Obj *objPtr,		/* Object whose string rep byte pointer should
 				 * be returned. */
-    size_t *lengthPtr)	/* If non-NULL, the location where the string
+    size_t *lengthPtr)		/* If non-NULL, the location where the string
 				 * rep's byte array length should * be stored.
 				 * If NULL, no length is stored. */
 {
@@ -1756,42 +1781,40 @@ TclGetStringFromObj(
     }
     return objPtr->bytes;
 }
-
 
 /*
  *----------------------------------------------------------------------
  *
  * Tcl_InitStringRep --
  *
- *	This function is called in several configurations to provide all
- *	the tools needed to set an object's string representation. The
- *	function is determined by the arguments.
+ *	This function is called in several configurations to provide all the
+ *	tools needed to set an object's string representation. The function is
+ *	determined by the arguments.
  *
  *	(objPtr->bytes != NULL && bytes != NULL) || (numBytes < 0)
  *	    Invalid call -- panic!
  *
  *	objPtr->bytes == NULL && bytes == NULL && numBytes >= 0
- *	    Allocation only - allocate space for (numBytes+1) chars.
- *	    store in objPtr->bytes and return. Also sets
- *	    objPtr->length to 0 and objPtr->bytes[0] to NUL.
+ *	    Allocation only - allocate space for (numBytes+1) chars.  Store in
+ *	    objPtr->bytes and return. Also sets objPtr->length to 0 and
+ *	    objPtr->bytes[0] to NUL.
  *
  *	objPtr->bytes == NULL && bytes != NULL && numBytes >= 0
- *	    Allocate and copy. bytes is assumed to point to chars to
- *	    copy into the string rep. objPtr->length = numBytes. Allocate
- *	    array of (numBytes + 1) chars. store in objPtr->bytes. Copy
- *	    numBytes chars from bytes to objPtr->bytes; Set
- *	    objPtr->bytes[numBytes] to NUL and return objPtr->bytes.
- *	    Caller must guarantee there are numBytes chars at bytes to
- *	    be copied.
+ *	    Allocate and copy. bytes is assumed to point to chars to copy into
+ *	    the string rep. objPtr->length = numBytes. Allocate array of
+ *	    (numBytes + 1) chars. store in objPtr->bytes. Copy numBytes chars
+ *	    from bytes to objPtr->bytes; Set objPtr->bytes[numBytes] to NUL
+ *	    and return objPtr->bytes.  Caller must guarantee there are
+ *	    numBytes chars at bytes to be copied.
  *
  *	objPtr->bytes != NULL && bytes == NULL && numBytes >= 0
  *	    Truncate.  Set objPtr->length to numBytes and
- *	    objPr->bytes[numBytes] to NUL.  Caller has to guarantee
- *	    that a prior allocating call allocated enough bytes for
- *	    this to be valid. Return objPtr->bytes.
+ *	    objPr->bytes[numBytes] to NUL.  Caller has to guarantee that a
+ *	    prior allocating call allocated enough bytes for this to be
+ *	    valid. Return objPtr->bytes.
  *
- *	Caller is expected to ascertain that the bytes copied into
- *	the string rep make up complete valid UTF-8 characters.
+ *	Caller is expected to ascertain that the bytes copied into the string
+ *	rep make up complete valid UTF-8 characters.
  *
  * Results:
  *	A pointer to the string rep of objPtr.
@@ -1804,7 +1827,7 @@ TclGetStringFromObj(
 
 char *
 Tcl_InitStringRep(
-    Tcl_Obj *objPtr,	/* Object whose string rep is to be set */
+    Tcl_Obj *objPtr,		/* Object whose string rep is to be set */
     const char *bytes,
     unsigned int numBytes)
 {
@@ -1816,7 +1839,9 @@ Tcl_InitStringRep(
 
     /* Allocate */
     if (objPtr->bytes == NULL) {
-	/* Allocate only as empty - extend later if bytes copied */
+	/*
+         * Allocate only as empty - extend later if bytes copied.
+         */
 	objPtr->length = 0;
 	if (numBytes) {
 	    objPtr->bytes = (char *)attemptckalloc(numBytes + 1);
@@ -1863,7 +1888,7 @@ Tcl_InitStringRep(
 
 void
 Tcl_InvalidateStringRep(
-    Tcl_Obj *objPtr)	/* Object whose string rep byte pointer should
+    Tcl_Obj *objPtr)		/* Object whose string rep byte pointer should
 				 * be freed. */
 {
     TclInvalidateStringRep(objPtr);
@@ -1883,7 +1908,7 @@ Tcl_InvalidateStringRep(
 
 int
 Tcl_HasStringRep(
-    Tcl_Obj *objPtr)	/* Object to test */
+    Tcl_Obj *objPtr)		/* Object to test */
 {
     return TclHasStringRep(objPtr);
 }
@@ -1938,12 +1963,12 @@ Tcl_StoreIntRep(
  *	representation matching a requested type, if any.
  *
  * Results:
- *	A read-only pointer to the associated Tcl_ObjIntRep, or
- *	NULL if no such internal representation exists.
+ *	A read-only pointer to the associated Tcl_ObjIntRep, or NULL if no
+ *	such internal representation exists.
  *
  * Side effects:
- *	Calls the freeIntRepProc of the current Tcl_ObjType, if any.
- *	Sets the internalRep and typePtr fields to the submitted values.
+ *	Calls the freeIntRepProc of the current Tcl_ObjType, if any.  Sets the
+ *	internalRep and typePtr fields to the submitted values.
  *
  *----------------------------------------------------------------------
  */
@@ -1967,8 +1992,8 @@ Tcl_FetchIntRep(
  *	None.
  *
  * Side effects:
- *	Calls the freeIntRepProc of the current Tcl_ObjType, if any.
- *	Sets typePtr field to NULL.
+ *	Calls the freeIntRepProc of the current Tcl_ObjType, if any.  Sets
+ *	typePtr field to NULL.
  *
  *----------------------------------------------------------------------
  */
@@ -1986,9 +2011,9 @@ Tcl_FreeIntRep(
  * Tcl_NewBooleanObj --
  *
  *	This function is normally called when not debugging: i.e., when
- *	TCL_MEM_DEBUG is not defined. It creates a new Tcl_Obj and
- *	initializes it from the argument boolean value. A nonzero "boolValue"
- *	is coerced to 1.
+ *	TCL_MEM_DEBUG is not defined. It creates a new Tcl_Obj and initializes
+ *	it from the argument boolean value. A nonzero "boolValue" is coerced
+ *	to 1.
  *
  *	When TCL_MEM_DEBUG is defined, this function just returns the result
  *	of calling the debugging version Tcl_DbNewLongObj.
@@ -2008,7 +2033,7 @@ Tcl_FreeIntRep(
 
 Tcl_Obj *
 Tcl_NewBooleanObj(
-    int boolValue)	/* Boolean used to initialize new object. */
+    int boolValue)		/* Boolean used to initialize new object. */
 {
     return Tcl_DbNewWideIntObj(boolValue!=0, "unknown", 0);
 }
@@ -2017,7 +2042,7 @@ Tcl_NewBooleanObj(
 
 Tcl_Obj *
 Tcl_NewBooleanObj(
-    int boolValue)	/* Boolean used to initialize new object. */
+    int boolValue)		/* Boolean used to initialize new object. */
 {
     Tcl_Obj *objPtr;
 
@@ -2058,7 +2083,7 @@ Tcl_NewBooleanObj(
 
 Tcl_Obj *
 Tcl_DbNewBooleanObj(
-    int boolValue,	/* Boolean used to initialize new object. */
+    int boolValue,		/* Boolean used to initialize new object. */
     const char *file,		/* The name of the source file calling this
 				 * function; used for debugging. */
     int line)			/* Line number in the source file; used for
@@ -2108,8 +2133,8 @@ Tcl_DbNewBooleanObj(
 #undef Tcl_SetBooleanObj
 void
 Tcl_SetBooleanObj(
-    Tcl_Obj *objPtr,	/* Object whose internal rep to init. */
-    int boolValue)	/* Boolean used to set object's value. */
+    Tcl_Obj *objPtr,		/* Object whose internal rep to init. */
+    int boolValue)		/* Boolean used to set object's value. */
 {
     if (Tcl_IsShared(objPtr)) {
 	Tcl_Panic("%s called with shared object", "Tcl_SetBooleanObj");
@@ -2141,8 +2166,8 @@ Tcl_SetBooleanObj(
 int
 Tcl_GetBooleanFromObj(
     Tcl_Interp *interp,         /* Used for error reporting if not NULL. */
-    Tcl_Obj *objPtr,	/* The object from which to get boolean. */
-    int *boolPtr)	/* Place to store resulting boolean. */
+    Tcl_Obj *objPtr,		/* The object from which to get boolean. */
+    int *boolPtr)		/* Place to store resulting boolean. */
 {
     do {
 	if (objPtr->typePtr == &tclIntType) {
@@ -2207,7 +2232,7 @@ Tcl_GetBooleanFromObj(
 int
 TclSetBooleanFromAny(
     Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
-    Tcl_Obj *objPtr)	/* The object to convert. */
+    Tcl_Obj *objPtr)		/* The object to convert. */
 {
     /*
      * For some "pure" numeric Tcl_ObjTypes (no string rep), we can determine
@@ -2443,7 +2468,7 @@ Tcl_NewDoubleObj(
 
 Tcl_Obj *
 Tcl_DbNewDoubleObj(
-    double dblValue,	/* Double used to initialize the object. */
+    double dblValue,		/* Double used to initialize the object. */
     const char *file,		/* The name of the source file calling this
 				 * function; used for debugging. */
     int line)			/* Line number in the source file; used for
@@ -2464,7 +2489,7 @@ Tcl_DbNewDoubleObj(
 
 Tcl_Obj *
 Tcl_DbNewDoubleObj(
-    double dblValue,	/* Double used to initialize the object. */
+    double dblValue,		/* Double used to initialize the object. */
     TCL_UNUSED(const char *) /*file*/,
     TCL_UNUSED(int) /*line*/)
 {
@@ -2492,8 +2517,8 @@ Tcl_DbNewDoubleObj(
 
 void
 Tcl_SetDoubleObj(
-    Tcl_Obj *objPtr,	/* Object whose internal rep to init. */
-    double dblValue)	/* Double used to set the object's value. */
+    Tcl_Obj *objPtr,		/* Object whose internal rep to init. */
+    double dblValue)		/* Double used to set the object's value. */
 {
     if (Tcl_IsShared(objPtr)) {
 	Tcl_Panic("%s called with shared object", "Tcl_SetDoubleObj");
@@ -2525,8 +2550,8 @@ Tcl_SetDoubleObj(
 int
 Tcl_GetDoubleFromObj(
     Tcl_Interp *interp,         /* Used for error reporting if not NULL. */
-    Tcl_Obj *objPtr,	/* The object from which to get a double. */
-    double *dblPtr)	/* Place to store resulting double. */
+    Tcl_Obj *objPtr,		/* The object from which to get a double. */
+    double *dblPtr)		/* Place to store resulting double. */
 {
     do {
 	if (objPtr->typePtr == &tclDoubleType) {
@@ -2609,7 +2634,7 @@ SetDoubleFromAny(
 
 static void
 UpdateStringOfDouble(
-    Tcl_Obj *objPtr)	/* Double obj with string rep to update. */
+    Tcl_Obj *objPtr)		/* Double obj with string rep to update. */
 {
     char *dst = Tcl_InitStringRep(objPtr, NULL, TCL_DOUBLE_SPACE);
 
@@ -2655,7 +2680,7 @@ UpdateStringOfDouble(
 
 Tcl_Obj *
 Tcl_NewIntObj(
-    int intValue)	/* Int used to initialize the new object. */
+    int intValue)		/* Int used to initialize the new object. */
 {
     return Tcl_DbNewWideIntObj((long)intValue, "unknown", 0);
 }
@@ -2664,7 +2689,7 @@ Tcl_NewIntObj(
 
 Tcl_Obj *
 Tcl_NewIntObj(
-    int intValue)	/* Int used to initialize the new object. */
+    int intValue)		/* Int used to initialize the new object. */
 {
     Tcl_Obj *objPtr;
 
@@ -2695,8 +2720,8 @@ Tcl_NewIntObj(
 #undef Tcl_SetIntObj
 void
 Tcl_SetIntObj(
-    Tcl_Obj *objPtr,	/* Object whose internal rep to init. */
-    int intValue)	/* Integer used to set object's value. */
+    Tcl_Obj *objPtr,		/* Object whose internal rep to init. */
+    int intValue)		/* Integer used to set object's value. */
 {
     if (Tcl_IsShared(objPtr)) {
 	Tcl_Panic("%s called with shared object", "Tcl_SetIntObj");
@@ -2731,12 +2756,12 @@ Tcl_SetIntObj(
  *
  *----------------------------------------------------------------------
  */
- 
+
 int
 Tcl_GetIntFromObj(
     Tcl_Interp *interp,         /* Used for error reporting if not NULL. */
-    Tcl_Obj *objPtr,	/* The object from which to get a int. */
-    int *intPtr)	/* Place to store resulting int. */
+    Tcl_Obj *objPtr,		/* The object from which to get a int. */
+    int *intPtr)		/* Place to store resulting int. */
 {
 #if (LONG_MAX == INT_MAX)
     return TclGetLongFromObj(interp, objPtr, (long *) intPtr);
@@ -2807,7 +2832,7 @@ SetIntFromAny(
 
 static void
 UpdateStringOfInt(
-    Tcl_Obj *objPtr)	/* Int object whose string rep to update. */
+    Tcl_Obj *objPtr)		/* Int object whose string rep to update. */
 {
     char *dst = Tcl_InitStringRep( objPtr, NULL, TCL_INTEGER_SPACE);
 
@@ -2819,7 +2844,7 @@ UpdateStringOfInt(
 #if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 && !defined(TCL_WIDE_INT_IS_LONG)
 static void
 UpdateStringOfOldInt(
-    Tcl_Obj *objPtr)	/* Int object whose string rep to update. */
+    Tcl_Obj *objPtr)		/* Int object whose string rep to update. */
 {
     char *dst = Tcl_InitStringRep( objPtr, NULL, TCL_INTEGER_SPACE);
 
@@ -2865,8 +2890,8 @@ UpdateStringOfOldInt(
 
 Tcl_Obj *
 Tcl_NewLongObj(
-    long longValue)	/* Long integer used to initialize the
-				 * new object. */
+    long longValue)		/* Long integer used to initialize the new
+				 * object. */
 {
     return Tcl_DbNewWideIntObj(longValue, "unknown", 0);
 }
@@ -2875,8 +2900,8 @@ Tcl_NewLongObj(
 
 Tcl_Obj *
 Tcl_NewLongObj(
-    long longValue)	/* Long integer used to initialize the
-				 * new object. */
+    long longValue)		/* Long integer used to initialize the new
+				 * object. */
 {
     Tcl_Obj *objPtr;
 
@@ -2924,7 +2949,7 @@ Tcl_NewLongObj(
 
 Tcl_Obj *
 Tcl_DbNewLongObj(
-    long longValue,	/* Long integer used to initialize the new
+    long longValue,		/* Long integer used to initialize the new
 				 * object. */
     const char *file,		/* The name of the source file calling this
 				 * function; used for debugging. */
@@ -2946,7 +2971,7 @@ Tcl_DbNewLongObj(
 
 Tcl_Obj *
 Tcl_DbNewLongObj(
-    long longValue,	/* Long integer used to initialize the new
+    long longValue,		/* Long integer used to initialize the new
 				 * object. */
     TCL_UNUSED(const char *) /*file*/,
     TCL_UNUSED(int) /*line*/)
@@ -2978,8 +3003,8 @@ Tcl_DbNewLongObj(
 #undef Tcl_SetLongObj
 void
 Tcl_SetLongObj(
-    Tcl_Obj *objPtr,	/* Object whose internal rep to init. */
-    long longValue)	/* Long integer used to initialize the
+    Tcl_Obj *objPtr,		/* Object whose internal rep to init. */
+    long longValue)		/* Long integer used to initialize the
 				 * object's value. */
 {
     if (Tcl_IsShared(objPtr)) {
@@ -3014,8 +3039,8 @@ Tcl_SetLongObj(
 int
 Tcl_GetLongFromObj(
     Tcl_Interp *interp,         /* Used for error reporting if not NULL. */
-    Tcl_Obj *objPtr,	/* The object from which to get a long. */
-    long *longPtr)	/* Place to store resulting long. */
+    Tcl_Obj *objPtr,		/* The object from which to get a long. */
+    long *longPtr)		/* Place to store resulting long. */
 {
     do {
 #ifdef TCL_WIDE_INT_IS_LONG
@@ -3042,15 +3067,9 @@ Tcl_GetLongFromObj(
 	    }
 	    goto tooLarge;
 	}
-#endif
+#endif /* TCL_WIDE_INT_IS_LONG */
 	if (objPtr->typePtr == &tclDoubleType) {
-	    if (interp != NULL) {
-                Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-                        "expected integer but got \"%s\"",
-                        TclGetString(objPtr)));
-		Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
-	    }
-	    return TCL_ERROR;
+            return NotAnInteger(interp, objPtr);
 	}
 	if (objPtr->typePtr == &tclBignumType) {
 	    /*
@@ -3060,7 +3079,6 @@ Tcl_GetLongFromObj(
 	     * values in the unsigned long range will fit in a long.
 	     */
 
-		{
 	    mp_int big;
 	    unsigned long scratch, value = 0;
 	    unsigned char *bytes = (unsigned char *) &scratch;
@@ -3069,7 +3087,7 @@ Tcl_GetLongFromObj(
 	    TclUnpackBignum(objPtr, big);
 	    if (mp_to_ubin(&big, bytes, sizeof(long), &numBytes) == MP_OKAY) {
 		while (numBytes-- > 0) {
-			value = (value << CHAR_BIT) | *bytes++;
+                    value = (value << CHAR_BIT) | *bytes++;
 		}
 		if (big.sign) {
 		    if (value <= 1 + (unsigned long)LONG_MAX) {
@@ -3083,21 +3101,20 @@ Tcl_GetLongFromObj(
 		    }
 		}
 	    }
-	    }
-#ifndef TCL_WIDE_INT_IS_LONG
-	tooLarge:
-#endif
-	    if (interp != NULL) {
-		const char *s = "integer value too large to represent";
-		Tcl_Obj *msg = Tcl_NewStringObj(s, -1);
-
-		Tcl_SetObjResult(interp, msg);
-		Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL);
-	    }
-	    return TCL_ERROR;
+            goto tooLarge;
 	}
     } while (TclParseNumber(interp, objPtr, "integer", NULL, -1, NULL,
-	    TCL_PARSE_INTEGER_ONLY)==TCL_OK);
+	    TCL_PARSE_INTEGER_ONLY) == TCL_OK);
+    return TCL_ERROR;
+
+  tooLarge:
+    if (interp != NULL) {
+        const char *s = "integer value too large to represent";
+        Tcl_Obj *msg = Tcl_NewStringObj(s, -1);
+
+        Tcl_SetObjResult(interp, msg);
+        Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL);
+    }
     return TCL_ERROR;
 }
 
@@ -3239,7 +3256,7 @@ Tcl_DbNewWideIntObj(
 
 void
 Tcl_SetWideIntObj(
-    Tcl_Obj *objPtr,	/* Object w. internal rep to init. */
+    Tcl_Obj *objPtr,		/* Object w. internal rep to init. */
     Tcl_WideInt wideValue)
 				/* Wide integer used to initialize the
 				 * object's value. */
@@ -3275,7 +3292,7 @@ Tcl_SetWideIntObj(
 int
 Tcl_GetWideIntFromObj(
     Tcl_Interp *interp,         /* Used for error reporting if not NULL. */
-    Tcl_Obj *objPtr,	/* Object from which to get a wide int. */
+    Tcl_Obj *objPtr,		/* Object from which to get a wide int. */
     Tcl_WideInt *wideIntPtr)
 				/* Place to store resulting long. */
 {
@@ -3285,13 +3302,7 @@ Tcl_GetWideIntFromObj(
 	    return TCL_OK;
 	}
 	if (objPtr->typePtr == &tclDoubleType) {
-	    if (interp != NULL) {
-                Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-                        "expected integer but got \"%s\"",
-                        TclGetString(objPtr)));
-		Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
-	    }
-	    return TCL_ERROR;
+            return NotAnInteger(interp, objPtr);
 	}
 	if (objPtr->typePtr == &tclBignumType) {
 	    /*
@@ -3322,17 +3333,20 @@ Tcl_GetWideIntFromObj(
 		    }
 		}
 	    }
-	    if (interp != NULL) {
-		const char *s = "integer value too large to represent";
-		Tcl_Obj *msg = Tcl_NewStringObj(s, -1);
-
-		Tcl_SetObjResult(interp, msg);
-		Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL);
-	    }
-	    return TCL_ERROR;
+            goto tooLarge;
 	}
     } while (TclParseNumber(interp, objPtr, "integer", NULL, -1, NULL,
-	    TCL_PARSE_INTEGER_ONLY)==TCL_OK);
+	    TCL_PARSE_INTEGER_ONLY) == TCL_OK);
+    return TCL_ERROR;
+
+  tooLarge:
+    if (interp != NULL) {
+        const char *s = "integer value too large to represent";
+        Tcl_Obj *msg = Tcl_NewStringObj(s, -1);
+
+        Tcl_SetObjResult(interp, msg);
+        Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL);
+    }
     return TCL_ERROR;
 }
 
@@ -3370,13 +3384,7 @@ TclGetWideBitsFromObj(
 	    return TCL_OK;
 	}
 	if (objPtr->typePtr == &tclDoubleType) {
-	    if (interp != NULL) {
-                Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-                        "expected integer but got \"%s\"",
-                        TclGetString(objPtr)));
-		Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
-	    }
-	    return TCL_ERROR;
+            return NotAnInteger(interp, objPtr);
 	}
 	if (objPtr->typePtr == &tclBignumType) {
 	    mp_int big;
@@ -3402,7 +3410,7 @@ TclGetWideBitsFromObj(
 	    return TCL_OK;
 	}
     } while (TclParseNumber(interp, objPtr, "integer", NULL, -1, NULL,
-	    TCL_PARSE_INTEGER_ONLY)==TCL_OK);
+	    TCL_PARSE_INTEGER_ONLY) == TCL_OK);
     return TCL_ERROR;
 }
 
@@ -3642,11 +3650,13 @@ GetBignumFromObj(
 		objPtr->internalRep.twoPtrValue.ptr1 = NULL;
 		objPtr->internalRep.twoPtrValue.ptr2 = NULL;
 		objPtr->typePtr = NULL;
+
 		/*
-		 * TODO: If objPtr has a string rep, this leaves
-		 * it undisturbed.  Not clear that's proper. Pure
-		 * bignum values are converted to empty string.
+		 * TODO: If objPtr has a string rep, this leaves it
+		 * undisturbed. Not clear that's proper. Pure bignum values
+		 * are converted to empty string.
 		 */
+
 		if (objPtr->bytes == NULL) {
 		    TclInitStringRep(objPtr, NULL, 0);
 		}
@@ -3661,16 +3671,10 @@ GetBignumFromObj(
 	    return TCL_OK;
 	}
 	if (objPtr->typePtr == &tclDoubleType) {
-	    if (interp != NULL) {
-                Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-                        "expected integer but got \"%s\"",
-                        TclGetString(objPtr)));
-		Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
-	    }
-	    return TCL_ERROR;
+            return NotAnInteger(interp, objPtr);
 	}
     } while (TclParseNumber(interp, objPtr, "integer", NULL, -1, NULL,
-	    TCL_PARSE_INTEGER_ONLY)==TCL_OK);
+	    TCL_PARSE_INTEGER_ONLY) == TCL_OK);
     return TCL_ERROR;
 }
 
@@ -3908,7 +3912,8 @@ TclGetNumberFromObj(
 #undef Tcl_IncrRefCount
 void
 Tcl_IncrRefCount(
-    Tcl_Obj *objPtr)	/* The object we are registering a reference to. */
+    Tcl_Obj *objPtr)		/* The object we are registering a reference
+                                 * to. */
 {
     ++(objPtr)->refCount;
 }
@@ -3929,7 +3934,8 @@ Tcl_IncrRefCount(
 #undef Tcl_DecrRefCount
 void
 Tcl_DecrRefCount(
-    Tcl_Obj *objPtr)	/* The object we are releasing a reference to. */
+    Tcl_Obj *objPtr)		/* The object we are releasing a reference
+                                 * to. */
 {
     if (objPtr->refCount-- <= 1) {
 	TclFreeObj(objPtr);
@@ -3952,7 +3958,7 @@ Tcl_DecrRefCount(
 #undef Tcl_IsShared
 int
 Tcl_IsShared(
-    Tcl_Obj *objPtr)	/* The object to test for being shared. */
+    Tcl_Obj *objPtr)		/* The object to test for being shared. */
 {
     return ((objPtr)->refCount > 1);
 }
@@ -3981,7 +3987,7 @@ Tcl_IsShared(
 #ifdef TCL_MEM_DEBUG
 void
 Tcl_DbIncrRefCount(
-    Tcl_Obj *objPtr,	/* The object we are registering a reference
+    Tcl_Obj *objPtr,		/* The object we are registering a reference
 				 * to. */
     const char *file,		/* The name of the source file calling this
 				 * function; used for debugging. */
@@ -4054,7 +4060,7 @@ Tcl_DbIncrRefCount(
 #ifdef TCL_MEM_DEBUG
 void
 Tcl_DbDecrRefCount(
-    Tcl_Obj *objPtr,	/* The object we are releasing a reference
+    Tcl_Obj *objPtr,		/* The object we are releasing a reference
 				 * to. */
     const char *file,		/* The name of the source file calling this
 				 * function; used for debugging. */
@@ -4097,7 +4103,7 @@ Tcl_DbDecrRefCount(
 #else /* !TCL_MEM_DEBUG */
 void
 Tcl_DbDecrRefCount(
-    Tcl_Obj *objPtr,	/* The object we are releasing a reference
+    Tcl_Obj *objPtr,		/* The object we are releasing a reference
 				 * to. */
     TCL_UNUSED(const char *) /*file*/,
     TCL_UNUSED(int) /*line*/)
@@ -4131,7 +4137,7 @@ Tcl_DbDecrRefCount(
 
 int
 Tcl_DbIsShared(
-    Tcl_Obj *objPtr,	/* The object to test for being shared. */
+    Tcl_Obj *objPtr,		/* The object to test for being shared. */
 #ifdef TCL_MEM_DEBUG
     const char *file,		/* The name of the source file calling this
 				 * function; used for debugging. */
@@ -4278,7 +4284,9 @@ TclCompareObjKeys(
      * If the object pointers are the same then they match.
      * OPT: this comparison was moved to the caller
 
-       if (objPtr1 == objPtr2) return 1;
+    if (objPtr1 == objPtr2) {
+	return 1;
+    }
     */
 
     /*
@@ -4429,7 +4437,7 @@ Tcl_Command
 Tcl_GetCommandFromObj(
     Tcl_Interp *interp,		/* The interpreter in which to resolve the
 				 * command and to report errors. */
-    Tcl_Obj *objPtr)	/* The object containing the command's name.
+    Tcl_Obj *objPtr)		/* The object containing the command's name.
 				 * If the name starts with "::", will be
 				 * looked up in global namespace. Else, looked
 				 * up first in the current namespace, then in
@@ -4478,9 +4486,10 @@ Tcl_GetCommandFromObj(
     /*
      * OK, must create a new internal representation (or fail) as any cache we
      * had is invalid one way or another.
+     *
+     * See [07d13d99b0a9] why we cannot call SetCmdNameFromAny() directly here.
      */
 
-    /* See [07d13d99b0a9] why we cannot call SetCmdNameFromAny() directly here. */
     if (tclCmdNameType.setFromAnyProc(interp, objPtr) != TCL_OK) {
         return NULL;
     }
@@ -4530,7 +4539,10 @@ SetCmdNameObj(
     cmdPtr->refCount++;
     fillPtr->cmdEpoch = cmdPtr->cmdEpoch;
 
-    /* NOTE: relying on NULL termination here. */
+    /*
+     * NOTE: relying on NULL termination here.
+     */
+
     if ((name[0] == ':') && (name[1] == ':')) {
 	/*
 	 * Fully qualified names always resolve to same thing. No need
@@ -4545,6 +4557,7 @@ SetCmdNameObj(
 	 * Record current state of current namespace as the resolution
 	 * context of this command name lookup.
 	 */
+
 	Namespace *currNsPtr = iPtr->varFramePtr->nsPtr;
 
 	fillPtr->refNsPtr = currNsPtr;
@@ -4565,7 +4578,7 @@ void
 TclSetCmdNameObj(
     Tcl_Interp *interp,		/* Points to interpreter containing command
 				 * that should be cached in objPtr. */
-    Tcl_Obj *objPtr,	/* Points to Tcl object to be changed to a
+    Tcl_Obj *objPtr,		/* Points to Tcl object to be changed to a
 				 * CmdName object. */
     Command *cmdPtr)		/* Points to Command structure that the
 				 * CmdName object should refer to. */
@@ -4605,28 +4618,28 @@ TclSetCmdNameObj(
 
 static void
 FreeCmdNameInternalRep(
-    Tcl_Obj *objPtr)	/* CmdName object with internal
+    Tcl_Obj *objPtr)		/* CmdName object with internal
 				 * representation to free. */
 {
-    ResolvedCmdName *resPtr = (ResolvedCmdName *)objPtr->internalRep.twoPtrValue.ptr1;
+    ResolvedCmdName *resPtr = (ResolvedCmdName *)
+            objPtr->internalRep.twoPtrValue.ptr1;
 
-	/*
-	 * Decrement the reference count of the ResolvedCmdName structure. If
-	 * there are no more uses, free the ResolvedCmdName structure.
-	 */
+    /*
+     * Decrement the reference count of the ResolvedCmdName structure. If
+     * there are no more uses, free the ResolvedCmdName structure.
+     */
 
-	if (resPtr->refCount-- <= 1) {
-	    /*
-	     * Now free the cached command, unless it is still in its hash
-	     * table or if there are other references to it from other cmdName
-	     * objects.
-	     */
+    if (resPtr->refCount-- <= 1) {
+        /*
+         * Now free the cached command, unless it is still in its hash table
+         * or if there are other references to it from other cmdName objects.
+         */
 
-	    Command *cmdPtr = resPtr->cmdPtr;
+        Command *cmdPtr = resPtr->cmdPtr;
 
-	    TclCleanupCommandMacro(cmdPtr);
-	    ckfree(resPtr);
-	}
+        TclCleanupCommandMacro(cmdPtr);
+        ckfree(resPtr);
+    }
     objPtr->typePtr = NULL;
 }
 
@@ -4653,9 +4666,10 @@ FreeCmdNameInternalRep(
 static void
 DupCmdNameInternalRep(
     Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
-    Tcl_Obj *copyPtr)	/* Object with internal rep to set. */
+    Tcl_Obj *copyPtr)		/* Object with internal rep to set. */
 {
-    ResolvedCmdName *resPtr = (ResolvedCmdName *)srcPtr->internalRep.twoPtrValue.ptr1;
+    ResolvedCmdName *resPtr = (ResolvedCmdName *)
+	    srcPtr->internalRep.twoPtrValue.ptr1;
 
     copyPtr->internalRep.twoPtrValue.ptr1 = resPtr;
     copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
@@ -4687,7 +4701,7 @@ DupCmdNameInternalRep(
 static int
 SetCmdNameFromAny(
     Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
-    Tcl_Obj *objPtr)	/* The object to convert. */
+    Tcl_Obj *objPtr)		/* The object to convert. */
 {
     const char *name;
     Command *cmdPtr;
@@ -4721,8 +4735,8 @@ SetCmdNameFromAny(
     resPtr = (ResolvedCmdName *)objPtr->internalRep.twoPtrValue.ptr1;
     if ((objPtr->typePtr == &tclCmdNameType) && (resPtr->refCount == 1)) {
 	/*
-	 * Re-use existing ResolvedCmdName struct when possible.
-	 * Cleanup the old fields that need it.
+	 * Re-use existing ResolvedCmdName struct when possible.  Cleanup the
+	 * old fields that need it.
 	 */
 
 	Command *oldCmdPtr = resPtr->cmdPtr;

generic/tclParse.c

@@ -119,7 +119,7 @@ const char tclCharTypeTable[] = {
  * Prototypes for local functions defined in this file:
  */
 
-static int	CommandComplete(const char *script, int numBytes);
+static int		CommandComplete(const char *script, int numBytes);
 static int		ParseComment(const char *src, int numBytes,
 			    Tcl_Parse *parsePtr);
 static int		ParseTokens(const char *src, int numBytes, int mask,
@@ -197,7 +197,7 @@ Tcl_ParseCommand(
 				 * NULL, then no error message is provided. */
     const char *start,		/* First character of string containing one or
 				 * more Tcl commands. */
-    int numBytes,	/* Total number of bytes in string. If < 0,
+    int numBytes,		/* Total number of bytes in string. If < 0,
 				 * the script consists of all bytes up to the
 				 * first null character. */
     int nested,			/* Non-zero means this is a nested command:
@@ -209,7 +209,7 @@ Tcl_ParseCommand(
 				 * the parsed command; any previous
 				 * information in the structure is ignored. */
 {
-    const char *src;	/* Points to current character in the
+    const char *src;		/* Points to current character in the
 				 * command. */
     char type;			/* Result returned by CHAR_TYPE(*src). */
     Tcl_Token *tokenPtr;	/* Pointer to token being filled in. */
@@ -786,7 +786,8 @@ TclParseBackslash(
 				 * of bytes scanned should be written. */
     char *dst)			/* NULL, or points to buffer where the UTF-8
 				 * encoding of the backslash sequence is to be
-				 * written. At most 4 bytes will be written there. */
+				 * written. At most 4 bytes will be written
+				 * there. */
 {
     const char *p = src+1;
     int unichar;
@@ -870,10 +871,14 @@ TclParseBackslash(
 	    result = 'u';
 	} 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. */
+	    /*
+	     * 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;
@@ -888,7 +893,9 @@ TclParseBackslash(
 	     */
 	    result = 'U';
 	} else if ((result | 0x7FF) == 0xDFFF) {
-	    /* Upper or lower surrogate, not allowed in this syntax. */
+	    /*
+	     * Upper or lower surrogate, not allowed in this syntax.
+	     */
 	    result = 0xFFFD;
 	}
 	break;
@@ -935,7 +942,7 @@ TclParseBackslash(
 	 * #217987] test subst-3.2
 	 */
 
-	if (TclUCS4Complete(p, numBytes - 1)) {
+	if (Tcl_UtfCharComplete(p, numBytes - 1)) {
 	    count = TclUtfToUCS4(p, &unichar) + 1;	/* +1 for '\' */
 	} else {
 	    char utfBytes[8];
@@ -954,7 +961,10 @@ TclParseBackslash(
     }
     count = Tcl_UniCharToUtf(result, dst);
     if ((result >= 0xD800) && (count < 3)) {
-	/* Special case for handling high surrogates. */
+	/*
+	 * Special case for handling high surrogates.
+	 */
+
 	count += Tcl_UniCharToUtf(-1, dst + count);
     }
     return count;
@@ -981,7 +991,7 @@ TclParseBackslash(
 static int
 ParseComment(
     const char *src,		/* First character to parse. */
-    int numBytes,	/* Max number of bytes to scan. */
+    int numBytes,		/* Max number of bytes to scan. */
     Tcl_Parse *parsePtr)	/* Information about parse in progress.
 				 * Updated if parsing indicates an incomplete
 				 * command. */
@@ -1053,8 +1063,8 @@ ParseComment(
 
 static int
 ParseTokens(
-    const char *src,	/* First character to parse. */
-    int numBytes,	/* Max number of bytes to scan. */
+    const char *src,		/* First character to parse. */
+    int numBytes,		/* Max number of bytes to scan. */
     int mask,			/* Specifies when to stop parsing. The parse
 				 * stops at the first unquoted character whose
 				 * CHAR_TYPE contains any of the bits in
@@ -1524,7 +1534,7 @@ Tcl_ParseVarName(
 const char *
 Tcl_ParseVar(
     Tcl_Interp *interp,		/* Context for looking up variable. */
-    const char *start,	/* Start of variable substitution. First
+    const char *start,		/* Start of variable substitution. First
 				 * character must be "$". */
     const char **termPtr)	/* If non-NULL, points to word to fill in with
 				 * character just after last one in the
@@ -1609,7 +1619,7 @@ Tcl_ParseBraces(
 				 * NULL, then no error message is provided. */
     const char *start,		/* Start of string enclosed in braces. The
 				 * first character must be {'. */
-    int numBytes,	/* Total number of bytes in string. If < 0,
+    int numBytes,		/* Total number of bytes in string. If < 0,
 				 * the string consists of all bytes up to the
 				 * first null character. */
     Tcl_Parse *parsePtr,
@@ -1810,7 +1820,7 @@ Tcl_ParseQuotedString(
 				 * NULL, then no error message is provided. */
     const char *start,		/* Start of the quoted string. The first
 				 * character must be '"'. */
-    int numBytes,	/* Total number of bytes in string. If < 0,
+    int numBytes,		/* Total number of bytes in string. If < 0,
 				 * the string consists of all bytes up to the
 				 * first null character. */
     Tcl_Parse *parsePtr,

generic/tclParse.h

@@ -3,14 +3,16 @@
  * source files can make use of the parsing table in tclParse.c
  */
 
-#define TYPE_NORMAL		0
-#define TYPE_SPACE		0x1
-#define TYPE_COMMAND_END	0x2
-#define TYPE_SUBS		0x4
-#define TYPE_QUOTE		0x8
-#define TYPE_CLOSE_PAREN	0x10
-#define TYPE_CLOSE_BRACK	0x20
-#define TYPE_BRACE		0x40
+enum {
+    TYPE_NORMAL = 0,
+    TYPE_SPACE = 0x1,
+    TYPE_COMMAND_END = 0x2,
+    TYPE_SUBS = 0x4,
+    TYPE_QUOTE = 0x8,
+    TYPE_CLOSE_PAREN = 0x10,
+    TYPE_CLOSE_BRACK = 0x20,
+    TYPE_BRACE = 0x40
+};
 
 #define CHAR_TYPE(c) tclCharTypeTable[(unsigned char)(c)]
 

generic/tclPathObj.c

@@ -77,23 +77,36 @@ typedef struct FsPath {
  * Flag values for FsPath->flags.
  */
 
-#define TCLPATH_APPENDED 1
-#define TCLPATH_NEEDNORM 4
+enum {
+    TCLPATH_APPENDED = 1,
+    TCLPATH_NEEDNORM = 4
+};
 
 /*
- * Define some macros to give us convenient access to path-object specific
- * fields.
+ * Define some inline functions to give us convenient fast access to
+ * path-object specific fields.
  */
 
-#define PATHOBJ(pathPtr) ((FsPath *) (TclFetchIntRep((pathPtr), &fsPathType)->twoPtrValue.ptr1))
-#define SETPATHOBJ(pathPtr,fsPathPtr) \
-	do {							\
-		Tcl_ObjIntRep ir;				\
-		ir.twoPtrValue.ptr1 = (void *) (fsPathPtr);	\
-		ir.twoPtrValue.ptr2 = NULL;			\
-		Tcl_StoreIntRep((pathPtr), &fsPathType, &ir);	\
-	} while (0)
-#define PATHFLAGS(pathPtr) (PATHOBJ(pathPtr)->flags)
+static inline FsPath *
+PATHOBJ(
+    Tcl_Obj *pathPtr)
+{
+    return (FsPath *) TclFetchIntRep(pathPtr, &fsPathType)->twoPtrValue.ptr1;
+}
+
+static inline void
+SETPATHOBJ(
+    Tcl_Obj *pathPtr,
+    FsPath *fsPathPtr)
+{
+    Tcl_ObjIntRep ir;
+
+    ir.twoPtrValue.ptr1 = (void *) fsPathPtr;
+    ir.twoPtrValue.ptr2 = NULL;
+    Tcl_StoreIntRep(pathPtr, &fsPathType, &ir);
+}
+
+#define PATHFLAGS(pathPtr)	(PATHOBJ(pathPtr)->flags)
 
 /*
  *---------------------------------------------------------------------------
@@ -143,17 +156,17 @@ TclFSNormalizeAbsolutePath(
     dirSep = TclGetString(pathPtr);
 
     if (tclPlatform == TCL_PLATFORM_WINDOWS) {
-	if (   (dirSep[0] == '/' || dirSep[0] == '\\')
-	    && (dirSep[1] == '/' || dirSep[1] == '\\')
-	    && (dirSep[2] == '?')
-	    && (dirSep[3] == '/' || dirSep[3] == '\\')) {
+	if (    (dirSep[0] == '/' || dirSep[0] == '\\') &&
+	        (dirSep[1] == '/' || dirSep[1] == '\\') &&
+	        (dirSep[2] == '?') &&
+	        (dirSep[3] == '/' || dirSep[3] == '\\')) {
 	    /* NT extended path */
 	    dirSep += 4;
 
-	    if (   (dirSep[0] == 'U' || dirSep[0] == 'u')
-		&& (dirSep[1] == 'N' || dirSep[1] == 'n')
-		&& (dirSep[2] == 'C' || dirSep[2] == 'c')
-		&& (dirSep[3] == '/' || dirSep[3] == '\\')) {
+	    if (    (dirSep[0] == 'U' || dirSep[0] == 'u') &&
+		    (dirSep[1] == 'N' || dirSep[1] == 'n') &&
+		    (dirSep[2] == 'C' || dirSep[2] == 'c') &&
+		    (dirSep[3] == '/' || dirSep[3] == '\\')) {
 		/* NT extended UNC path */
 		dirSep += 4;
 	    }
@@ -161,8 +174,8 @@ TclFSNormalizeAbsolutePath(
 	if (dirSep[0] != 0 && dirSep[1] == ':' &&
 		(dirSep[2] == '/' || dirSep[2] == '\\')) {
 	    /* Do nothing */
-	} else if ((dirSep[0] == '/' || dirSep[0] == '\\')
-		&& (dirSep[1] == '/' || dirSep[1] == '\\')) {
+	} else if ((dirSep[0] == '/' || dirSep[0] == '\\') &&
+		(dirSep[1] == '/' || dirSep[1] == '\\')) {
 	    /*
 	     * UNC style path, where we must skip over the first separator,
 	     * since the first two segments are actually inseparable.
@@ -932,7 +945,7 @@ TclJoinPath(
 	}
     }
 
-    assert ( res == NULL );
+    assert (res == NULL);
 
     for (i = 0; i < elements; i++) {
 	int driveNameLength, strEltLen, length;
@@ -1107,7 +1120,7 @@ TclJoinPath(
 	    Tcl_SetObjLength(res, length);
 	}
     }
-    assert ( res != NULL );
+    assert (res != NULL);
     return res;
 }
 
@@ -1760,7 +1773,9 @@ Tcl_FSGetNormalizedPath(
 	    TclFSNormalizeToUniquePath(interp, copy, cwdLen);
 	}
 
-	/* Now we need to construct the new path object. */
+	/*
+	 * Now we need to construct the new path object.
+	 */
 
 	if (pathType == TCL_PATH_RELATIVE) {
 	    Tcl_Obj *origDir = fsPathPtr->cwdPtr;

generic/tclPkgConfig.c

@@ -2,7 +2,7 @@
  * tclPkgConfig.c --
  *
  *	This file contains the configuration information to embed into the tcl
- *	binary library.
+ *	library.
  *
  * Copyright © 2002 Andreas Kupries <andreas_kupries@users.sourceforge.net>
  *
@@ -109,8 +109,9 @@ static Tcl_Config const cfg[] = {
     {"scriptdir,runtime",	CFG_RUNTIME_SCRDIR},
     {"includedir,runtime",	CFG_RUNTIME_INCDIR},
     {"docdir,runtime",		CFG_RUNTIME_DOCDIR},
+#if !defined(STATIC_BUILD)
     {"dllfile,runtime",		CFG_RUNTIME_DLLFILE},
-    {"zipfile,runtime",		CFG_RUNTIME_ZIPFILE},
+#endif
 
     /* Installation paths to various stuff */
 

generic/tclPlatDecls.h

@@ -40,6 +40,14 @@
 #   define _TCHAR_DEFINED
 #endif
 
+#ifndef MODULE_SCOPE
+#   ifdef __cplusplus
+#	define MODULE_SCOPE extern "C"
+#   else
+#	define MODULE_SCOPE extern
+#   endif
+#endif
+
 /* !BEGIN!: Do not edit below this line. */
 
 #ifdef __cplusplus
@@ -57,6 +65,9 @@ EXTERN TCHAR *		Tcl_WinUtfToTChar(const char *str, int len,
 /* 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 */
@@ -69,6 +80,9 @@ EXTERN int		Tcl_MacOSXOpenVersionedBundleResources(
 				const char *bundleVersion,
 				int hasResourceFile, int maxPathLen,
 				char *libraryPath);
+/* 2 */
+EXTERN void		Tcl_MacOSXNotifierAddRunLoopMode(
+				const void *runLoopMode);
 #endif /* MACOSX */
 
 typedef struct TclPlatStubs {
@@ -78,10 +92,13 @@ typedef struct TclPlatStubs {
 #if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
     TCHAR * (*tcl_WinUtfToTChar) (const char *str, int len, Tcl_DString *dsPtr); /* 0 */
     char * (*tcl_WinTCharToUtf) (const TCHAR *str, int len, Tcl_DString *dsPtr); /* 1 */
+    void (*reserved2)(void);
+    void (*tcl_WinConvertError) (unsigned errCode); /* 3 */
 #endif /* WIN */
 #ifdef MAC_OSX_TCL /* MACOSX */
     int (*tcl_MacOSXOpenBundleResources) (Tcl_Interp *interp, const char *bundleName, int hasResourceFile, int maxPathLen, char *libraryPath); /* 0 */
     int (*tcl_MacOSXOpenVersionedBundleResources) (Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, int hasResourceFile, int maxPathLen, char *libraryPath); /* 1 */
+    void (*tcl_MacOSXNotifierAddRunLoopMode) (const void *runLoopMode); /* 2 */
 #endif /* MACOSX */
 } TclPlatStubs;
 
@@ -102,12 +119,17 @@ extern const TclPlatStubs *tclPlatStubsPtr;
 	(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) */

generic/tclResult.c

@@ -464,6 +464,7 @@ Tcl_SetResult(
 
     ResetObjResult(iPtr);
 }
+#endif /* !TCL_NO_DEPRECATED */
 
 /*
  *----------------------------------------------------------------------
@@ -482,10 +483,12 @@ Tcl_SetResult(
  *----------------------------------------------------------------------
  */
 
+#undef Tcl_GetStringResult
 const char *
 Tcl_GetStringResult(
     Tcl_Interp *interp)/* Interpreter whose result to return. */
 {
+#ifndef TCL_NO_DEPRECATED
     Interp *iPtr = (Interp *) interp;
     /*
      * If the string result is empty, move the object result to the string
@@ -497,8 +500,10 @@ Tcl_GetStringResult(
 		TCL_VOLATILE);
     }
     return iPtr->result;
+#else
+    return TclGetString(Tcl_GetObjResult(interp));
+#endif
 }
-#endif /* !TCL_NO_DEPRECATED */
 
 /*
  *----------------------------------------------------------------------

generic/tclScan.c

@@ -16,13 +16,14 @@
  * Flag values used by Tcl_ScanObjCmd.
  */
 
-#define SCAN_NOSKIP	0x1		/* Don't skip blanks. */
-#define SCAN_SUPPRESS	0x2		/* Suppress assignment. */
-#define SCAN_UNSIGNED	0x4		/* Read an unsigned value. */
-#define SCAN_WIDTH	0x8		/* A width value was supplied. */
-
-#define SCAN_LONGER	0x400		/* Asked for a wide value. */
-#define SCAN_BIG	0x800		/* Asked for a bignum value. */
+enum {
+    SCAN_NOSKIP = 0x1,		/* Don't skip blanks. */
+    SCAN_SUPPRESS = 0x2,	/* Suppress assignment. */
+    SCAN_UNSIGNED = 0x4,	/* Read an unsigned value. */
+    SCAN_WIDTH = 0x8,		/* A width value was supplied. */
+    SCAN_LONGER = 0x400,	/* Asked for a wide value. */
+    SCAN_BIG = 0x800		/* Asked for a bignum value. */
+};
 
 /*
  * The following structure contains the information associated with a
@@ -104,9 +105,10 @@ BuildCharSet(
 	end += TclUtfToUniChar(end, &ch);
     }
 
-    cset->chars = (Tcl_UniChar *)ckalloc(sizeof(Tcl_UniChar) * (end - format - 1));
+    cset->chars = (Tcl_UniChar *)
+	    ckalloc(sizeof(Tcl_UniChar) * (end - format - 1));
     if (nranges > 0) {
-	cset->ranges = (Range *)ckalloc(sizeof(Range) * nranges);
+	cset->ranges = (Range *) ckalloc(sizeof(Range) * nranges);
     } else {
 	cset->ranges = NULL;
     }
@@ -262,7 +264,7 @@ ValidateFormat(
     char *end;
     Tcl_UniChar ch = 0;
     int objIndex, xpgSize, nspace = numVars;
-    int *nassign = (int *)TclStackAlloc(interp, nspace * sizeof(int));
+    int *nassign = (int *) TclStackAlloc(interp, nspace * sizeof(int));
     Tcl_Obj *errorMsg;		/* Place to build an error messages. Note that
 				 * these are messy operations because we do
 				 * not want to use the formatting engine;
@@ -479,7 +481,7 @@ ValidateFormat(
 		} else {
 		    nspace += 16;	/* formerly STATIC_LIST_SIZE */
 		}
-		nassign = (int *)TclStackRealloc(interp, nassign,
+		nassign = (int *) TclStackRealloc(interp, nassign,
 			nspace * sizeof(int));
 		for (i = value; i < nspace; i++) {
 		    nassign[i] = 0;
@@ -588,7 +590,7 @@ Tcl_ScanObjCmd(
     }
 
     format = Tcl_GetString(objv[2]);
-    numVars = objc-3;
+    numVars = objc - 3;
 
     /*
      * Check for errors in the format string.
@@ -603,7 +605,7 @@ Tcl_ScanObjCmd(
      */
 
     if (totalVars > 0) {
-	objs = (Tcl_Obj **)ckalloc(sizeof(Tcl_Obj *) * totalVars);
+	objs = (Tcl_Obj **) ckalloc(sizeof(Tcl_Obj *) * totalVars);
 	for (i = 0; i < totalVars; i++) {
 	    objs[i] = NULL;
 	}
@@ -890,13 +892,15 @@ Tcl_ScanObjCmd(
 	    /*
 	     * Scan an unsigned or signed integer.
 	     */
+
 	    TclNewIntObj(objPtr, 0);
 	    Tcl_IncrRefCount(objPtr);
 	    if (width == 0) {
 		width = ~0;
 	    }
 	    if (TCL_OK != TclParseNumber(NULL, objPtr, NULL, string, width,
-		&end, TCL_PARSE_INTEGER_ONLY | TCL_PARSE_NO_UNDERSCORE | parseFlag)) {
+		    &end, TCL_PARSE_INTEGER_ONLY | TCL_PARSE_NO_UNDERSCORE | 
+		    parseFlag)) {
 		Tcl_DecrRefCount(objPtr);
 		if (width < 0) {
 		    if (*end == '\0') {
@@ -979,7 +983,7 @@ Tcl_ScanObjCmd(
 		    }
 #else
 		    Tcl_SetWideIntObj(objPtr, (unsigned long)value);
-#endif
+#endif /* TCL_WIDE_INT_IS_LONG */
 		} else {
 		    TclSetIntObj(objPtr, value);
 		}
@@ -998,7 +1002,8 @@ Tcl_ScanObjCmd(
 		width = ~0;
 	    }
 	    if (TCL_OK != TclParseNumber(NULL, objPtr, NULL, string, width,
-		    &end, TCL_PARSE_DECIMAL_ONLY | TCL_PARSE_NO_WHITESPACE | TCL_PARSE_NO_UNDERSCORE)) {
+		    &end, TCL_PARSE_DECIMAL_ONLY | TCL_PARSE_NO_WHITESPACE | 
+		    TCL_PARSE_NO_UNDERSCORE)) {
 		Tcl_DecrRefCount(objPtr);
 		if (width < 0) {
 		    if (*end == '\0') {
@@ -1022,7 +1027,7 @@ Tcl_ScanObjCmd(
 		    if (irPtr) {
 			dvalue = irPtr->doubleValue;
 		    } else
-#endif
+#endif /* ACCEPT_NAN */
 		    {
 			Tcl_DecrRefCount(objPtr);
 			goto done;

generic/tclStrToD.c

@@ -22,6 +22,11 @@
 #define copysign _copysign
 #endif
 
+#ifndef PRIx64
+#   define PRIx64 TCL_LL_MODIFIER "x"
+#endif
+
+
 /*
  * This code supports (at least hypothetically), IBM, Cray, VAX and IEEE-754
  * floating point; of these, only IEEE-754 can represent NaN. IEEE-754 can be
@@ -538,7 +543,7 @@ TclParseNumber(
     int under = 0;              /* Flag trailing '_' as error if true once
 				 * number is accepted. */
 
-#define ALL_BITS	((Tcl_WideUInt)-1)
+#define ALL_BITS	UWIDE_MAX
 #define MOST_BITS	(ALL_BITS >> 1)
 
     /*
@@ -725,7 +730,7 @@ TclParseNumber(
 				&& (((size_t)shift >=
 					CHAR_BIT*sizeof(Tcl_WideUInt))
 				|| (octalSignificandWide >
-					((Tcl_WideUInt)-1 >> shift)))) {
+					(UWIDE_MAX >> shift)))) {
 			    octalSignificandOverflow = 1;
 			    err = mp_init_u64(&octalSignificandBig,
 				    octalSignificandWide);
@@ -865,7 +870,7 @@ TclParseNumber(
 
 		    if (significandWide != 0 &&
 			    ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) ||
-			    significandWide > ((Tcl_WideUInt)-1 >> shift))) {
+			    significandWide > (UWIDE_MAX >> shift))) {
 			significandOverflow = 1;
 			err = mp_init_u64(&significandBig,
 				significandWide);
@@ -899,12 +904,14 @@ TclParseNumber(
 		under = 0;
 		state = BINARY;
 		break;
-            } else if (c == '_' && !(flags & TCL_PARSE_NO_UNDERSCORE)) {
-                /* Ignore numeric "white space" */
-                under = 1;
-                break;
+	    } else if (c == '_' && !(flags & TCL_PARSE_NO_UNDERSCORE)) {
+		/* Ignore numeric "white space" */
+		under = 1;
+		break;
 	    } else if (c != '1') {
 		goto endgame;
+	    } else {
+		under = 0;
 	    }
 	    if (objPtr != NULL) {
 		shift = numTrailZeros + 1;
@@ -917,7 +924,7 @@ TclParseNumber(
 
 		    if (significandWide != 0 &&
 			    ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideUInt) ||
-			    significandWide > ((Tcl_WideUInt)-1 >> shift))) {
+			    significandWide > (UWIDE_MAX >> shift))) {
 			significandOverflow = 1;
 			err = mp_init_u64(&significandBig,
 				significandWide);
@@ -944,11 +951,11 @@ TclParseNumber(
 		under = 0;
 		numTrailZeros++;
 	    } else if ( ! isdigit(UCHAR(c))) {
-                if (c == '_' && !(flags & TCL_PARSE_NO_UNDERSCORE)) {
-                    /* Ignore numeric "white space" */
-                    under = 1;
-                    break;
-                }
+		if (c == '_' && !(flags & TCL_PARSE_NO_UNDERSCORE)) {
+		    /* Ignore numeric "white space" */
+		    under = 1;
+		    break;
+		}
 		goto endgame;
 	    }
 	    under = 0;
@@ -1597,7 +1604,7 @@ AccumulateDecimalDigit(
 	    *wideRepPtr = digit;
 	    return 0;
 	} else if (numZeros >= maxpow10_wide
-		|| w > ((Tcl_WideUInt)-1-digit)/pow10_wide[numZeros+1]) {
+		|| w > (UWIDE_MAX-digit)/pow10_wide[numZeros+1]) {
 	    /*
 	     * Wide multiplication will overflow.  Expand the number to a
 	     * bignum and fall through into the bignum case.
@@ -5251,23 +5258,23 @@ TclFormatNaN(
 #else
     union {
 	double dv;
-	Tcl_WideUInt iv;
+	uint64_t iv;
     } bitwhack;
 
     bitwhack.dv = value;
     if (n770_fp) {
 	bitwhack.iv = Nokia770Twiddle(bitwhack.iv);
     }
-    if (bitwhack.iv & ((Tcl_WideUInt) 1 << 63)) {
-	bitwhack.iv &= ~ ((Tcl_WideUInt) 1 << 63);
+    if (bitwhack.iv & (UINT64_C(1) << 63)) {
+	bitwhack.iv &= ~ (UINT64_C(1) << 63);
 	*buffer++ = '-';
     }
     *buffer++ = 'N';
     *buffer++ = 'a';
     *buffer++ = 'N';
-    bitwhack.iv &= (((Tcl_WideUInt) 1) << 51) - 1;
+    bitwhack.iv &= ((UINT64_C(1)) << 51) - 1;
     if (bitwhack.iv != 0) {
-	sprintf(buffer, "(%" TCL_LL_MODIFIER "x)", bitwhack.iv);
+	sprintf(buffer, "(%" PRIx64 ")", bitwhack.iv);
     } else {
 	*buffer = '\0';
     }

generic/tclStringObj.c

@@ -70,6 +70,11 @@ static void		SetUnicodeObj(Tcl_Obj *objPtr,
 static int		UnicodeLength(const Tcl_UniChar *unicode);
 static void		UpdateStringOfString(Tcl_Obj *objPtr);
 
+#define ISCONTINUATION(bytes) (\
+	((((bytes)[0] & 0xC0) == 0x80) || (((bytes)[0] == '\xED') \
+	&& (((bytes)[1] & 0xF0) == 0xB0) && (((bytes)[2] & 0xC0) == 0x80))))
+
+
 /*
  * The structure below defines the string Tcl object type by means of
  * functions that can be invoked by generic object code.
@@ -1199,10 +1204,10 @@ Tcl_AppendLimitedToObj(
 	}
 	eLen = strlen(ellipsis);
 	while (eLen > limit) {
-	    eLen = TclUtfPrev(ellipsis+eLen, ellipsis) - ellipsis;
+	    eLen = Tcl_UtfPrev(ellipsis+eLen, ellipsis) - ellipsis;
 	}
 
-	toCopy = TclUtfPrev(bytes+limit+1-eLen, bytes) - bytes;
+	toCopy = Tcl_UtfPrev(bytes+limit+1-eLen, bytes) - bytes;
     }
 
     /*
@@ -1218,6 +1223,11 @@ 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);
+    }
     if (stringPtr->hasUnicode && stringPtr->numChars > 0) {
 	AppendUtfToUnicodeRep(objPtr, bytes, toCopy);
     } else {
@@ -1415,6 +1425,12 @@ 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);
+    }
     /*
      * If objPtr has a valid Unicode rep, then get a Unicode string from
      * appendObjPtr and append it.
@@ -2644,7 +2660,7 @@ AppendPrintfToObjVA(
 		 * multi-byte characters.
 		 */
 
-		q = TclUtfPrev(end, bytes);
+		q = Tcl_UtfPrev(end, bytes);
 		if (!Tcl_UtfCharComplete(q, (int)(end - q))) {
 		    end = q;
 		}
@@ -3032,7 +3048,7 @@ TclStringCat(
 {
     Tcl_Obj *objResultPtr, * const *ov;
     int oc, length = 0, binary = 1;
-    int allowUniChar = 1, requestUniChar = 0;
+    int allowUniChar = 1, requestUniChar = 0, forceUniChar = 0;
     int first = objc - 1;	/* Index of first value possibly not empty */
     int last = 0;		/* Index of last value possibly not empty */
     int inPlace = flags & TCL_STRING_IN_PLACE;
@@ -3068,7 +3084,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;
 		}
@@ -3117,7 +3135,7 @@ TclStringCat(
 		}
 	    }
 	} while (--oc);
-    } else if (allowUniChar && requestUniChar) {
+    } else if ((allowUniChar && requestUniChar) || forceUniChar) {
 	/*
 	 * Result will be pure Tcl_UniChar array. Pre-size it.
 	 */
@@ -3270,7 +3288,7 @@ TclStringCat(
 		dst += more;
 	    }
 	}
-    } else if (allowUniChar && requestUniChar) {
+    } else if ((allowUniChar && requestUniChar) || forceUniChar) {
 	/* Efficiently produce a pure Tcl_UniChar array result */
 	Tcl_UniChar *dst;
 
@@ -3456,7 +3474,7 @@ TclStringCmp(
 		    s1 = (char *) Tcl_GetUnicode(value1Ptr);
 		    s2 = (char *) Tcl_GetUnicode(value2Ptr);
 		    if (
-#ifdef WORDS_BIGENDIAN
+#if defined(WORDS_BIGENDIAN) && (TCL_UTF_MAX > 3)
 			    1
 #else
 			    checkEq
@@ -3809,6 +3827,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)) {
 	int numBytes;
@@ -3827,10 +3848,9 @@ TclStringReverse(
     if (stringPtr->hasUnicode) {
 	Tcl_UniChar *from = Tcl_GetUnicode(objPtr);
 	Tcl_UniChar *src = from + stringPtr->numChars;
+	Tcl_UniChar *to;
 
 	if (!inPlace || Tcl_IsShared(objPtr)) {
-	    Tcl_UniChar *to;
-
 	    /*
 	     * Create a non-empty, pure unicode value, so we can coax
 	     * Tcl_SetObjLength into growing the unicode rep buffer.
@@ -3840,19 +3860,54 @@ TclStringReverse(
 	    Tcl_SetObjLength(objPtr, stringPtr->numChars);
 	    to = Tcl_GetUnicode(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) {
@@ -3876,8 +3931,8 @@ TclStringReverse(
 	     * Pass 1. Reverse the bytes of each multi-byte character.
 	     */
 
-	    int charCount = 0;
 	    int bytesLeft = numBytes;
+	    int chw;
 
 	    while (bytesLeft) {
 		/*
@@ -3886,18 +3941,16 @@ TclStringReverse(
 		 * skip calling Tcl_UtfCharComplete() here.
 		 */
 
-		int bytesInChar = TclUtfToUniChar(from, &ch);
+		int bytesInChar = TclUtfToUCS4(from, &chw);
 
 		ReverseBytes((unsigned char *)to, (unsigned char *)from,
 			bytesInChar);
 		to += bytesInChar;
 		from += bytesInChar;
 		bytesLeft -= bytesInChar;
-		charCount++;
 	    }
 
 	    from = to = objPtr->bytes;
-	    stringPtr->numChars = charCount;
 	}
 	/* Pass 2. Reverse all the bytes. */
 	ReverseBytes((unsigned char *)to, (unsigned char *)from, numBytes);
@@ -4110,9 +4163,22 @@ ExtendUnicodeRepWithString(
     } else {
 	numAppendChars = 0;
     }
-    for (dst=stringPtr->unicode + numOrigChars; numAppendChars-- > 0; dst++) {
+    dst = stringPtr->unicode + numOrigChars;
+    if (numAppendChars-- > 0) {
 	bytes += TclUtfToUniChar(bytes, &unichar);
-	*dst = unichar;
+#if TCL_UTF_MAX > 3
+	/* join upper/lower surrogate */
+	if (bytes && (stringPtr->unicode[numOrigChars - 1] | 0x3FF) == 0xDBFF && (unichar | 0x3FF) == 0xDFFF) {
+		stringPtr->numChars--;
+		unichar = ((stringPtr->unicode[numOrigChars - 1] & 0x3FF) << 10) + (unichar & 0x3FF) + 0x10000;
+		dst--;
+	}
+#endif
+	*dst++ = unichar;
+	while (numAppendChars-- > 0) {
+	    bytes += TclUtfToUniChar(bytes, &unichar);
+	    *dst++ = unichar;
+	}
     }
     *dst = 0;
 }

generic/tclStubInit.c

@@ -65,15 +65,22 @@
 #undef TclWinGetSockOpt
 #undef TclWinSetSockOpt
 #undef TclWinNToHS
-#undef TclStaticPackage
+#undef TclStaticLibrary
 #undef Tcl_BackgroundError
 #undef TclGuessPackageName
 #undef TclGetLoadedPackages
-#define TclStaticPackage Tcl_StaticPackage
+#define TclStaticLibrary Tcl_StaticLibrary
 #undef Tcl_UniCharToUtfDString
 #undef Tcl_UtfToUniCharDString
 #undef Tcl_UtfToUniChar
 #undef Tcl_MacOSXOpenBundleResources
+#undef TclWinConvertWSAError
+#undef TclWinConvertError
+#if defined(_WIN32) || defined(__CYGWIN__)
+#define TclWinConvertWSAError (void (*)(DWORD))(void *)Tcl_WinConvertError
+#define TclWinConvertError (void (*)(DWORD))(void *)Tcl_WinConvertError
+#endif
+
 
 #if TCL_UTF_MAX > 3
 static void uniCodePanic(void) {
@@ -90,6 +97,32 @@ static void uniCodePanic(void) {
 #   define Tcl_UniCharNcmp (int(*)(const Tcl_UniChar *, const Tcl_UniChar *, unsigned long))(void *)uniCodePanic
 #endif
 
+#define TclUtfCharComplete UtfCharComplete
+#define TclUtfNext UtfNext
+#define TclUtfPrev UtfPrev
+
+static int TclUtfCharComplete(const char *src, int length) {
+    if ((unsigned)((unsigned char)*(src) - 0xF0) < 5) {
+	return length < 3;
+    }
+    return Tcl_UtfCharComplete(src, length);
+}
+
+static const char *TclUtfNext(const char *src) {
+    if ((unsigned)((unsigned char)*(src) - 0xF0) < 5) {
+	return src + 1;
+    }
+    return Tcl_UtfNext(src);
+}
+
+static const char *TclUtfPrev(const char *src, const char *start) {
+    if ((src >= start + 3) && ((src[-1] & 0xC0) == 0x80)
+	    && ((src[-2] & 0xC0) == 0x80) && ((src[-3] & 0xC0) == 0x80)) {
+	return src - 3;
+    }
+    return Tcl_UtfPrev(src, start);
+}
+
 #define TclBN_mp_add mp_add
 #define TclBN_mp_and mp_and
 #define TclBN_mp_clamp mp_clamp
@@ -138,10 +171,11 @@ static void uniCodePanic(void) {
 #define TclBN_mp_to_radix mp_to_radix
 #define TclBN_mp_to_ubin mp_to_ubin
 #define TclBN_mp_ubin_size mp_ubin_size
+#define TclBN_mp_unpack mp_unpack
 #define TclBN_mp_xor mp_xor
 #define TclBN_mp_zero mp_zero
 #define TclBN_s_mp_add s_mp_add
-#define TclBN_s_mp_balance_mul mp_balance_mul
+#define TclBN_s_mp_balance_mul s_mp_balance_mul
 #define TclBN_mp_karatsuba_mul s_mp_karatsuba_mul
 #define TclBN_mp_karatsuba_sqr s_mp_karatsuba_sqr
 #define TclBN_s_mp_mul_digs s_mp_mul_digs
@@ -282,7 +316,7 @@ static int TclGetLoadedPackages(
 				 * otherwise, just return info about this
 				 * interpreter. */
 {
-    return TclGetLoadedPackagesEx(interp, targetName, NULL);
+    return TclGetLoadedLibraries(interp, targetName, NULL);
 }
 
 mp_err TclBN_mp_div_3(const mp_int *a, mp_int *c, unsigned int *d) {
@@ -396,7 +430,9 @@ TclWinGetPlatformId(void)
 
 #define TclpCreateTempFile_ TclpCreateTempFile
 #define TclUnixWaitForFile_ TclUnixWaitForFile
-#ifndef MAC_OSX_TCL /* On UNIX, fill with other stub entries */
+#ifdef MAC_OSX_TCL /* On UNIX, fill with other stub entries */
+#define TclMacOSXNotifierAddRunLoopMode Tcl_MacOSXNotifierAddRunLoopMode
+#else
 #define TclMacOSXGetFileAttribute (int (*)(Tcl_Interp *, int, Tcl_Obj *, Tcl_Obj **))(void *)TclpCreateProcess
 #define TclMacOSXSetFileAttribute (int (*)(Tcl_Interp *, int, Tcl_Obj *, Tcl_Obj *))(void *)isatty
 #define TclMacOSXCopyFileAttributes (int (*)(const char *, const char *, const Tcl_StatBuf *))(void *)TclUnixCopyFile
@@ -599,8 +635,6 @@ static int utfNcasecmp(const char *s1, const char *s2, unsigned int n){
 #   define Tcl_Eval 0
 #   undef Tcl_GlobalEval
 #   define Tcl_GlobalEval 0
-#   undef Tcl_GetStringResult
-#   define Tcl_GetStringResult 0
 #   undef Tcl_SaveResult
 #   define Tcl_SaveResult 0
 #   undef Tcl_RestoreResult
@@ -1003,7 +1037,7 @@ static const TclIntStubs tclIntStubs = {
     TclPtrIncrObjVar, /* 254 */
     TclPtrObjMakeUpvar, /* 255 */
     TclPtrUnsetVar, /* 256 */
-    TclStaticPackage, /* 257 */
+    TclStaticLibrary, /* 257 */
     TclpCreateTemporaryDirectory, /* 258 */
     TclGetBytesFromObj, /* 259 */
     TclUnusedStubEntry, /* 260 */
@@ -1119,10 +1153,13 @@ static const TclPlatStubs tclPlatStubs = {
 #if defined(_WIN32) || defined(__CYGWIN__) /* WIN */
     Tcl_WinUtfToTChar, /* 0 */
     Tcl_WinTCharToUtf, /* 1 */
+    0, /* 2 */
+    Tcl_WinConvertError, /* 3 */
 #endif /* WIN */
 #ifdef MAC_OSX_TCL /* MACOSX */
     Tcl_MacOSXOpenBundleResources, /* 0 */
     Tcl_MacOSXOpenVersionedBundleResources, /* 1 */
+    Tcl_MacOSXNotifierAddRunLoopMode, /* 2 */
 #endif /* MACOSX */
 };
 
@@ -1200,7 +1237,7 @@ const TclTomMathStubs tclTomMathStubs = {
     TclBN_mp_set_u64, /* 68 */
     TclBN_mp_get_mag_u64, /* 69 */
     TclBN_mp_set_i64, /* 70 */
-    0, /* 71 */
+    TclBN_mp_unpack, /* 71 */
     0, /* 72 */
     TclBN_mp_tc_and, /* 73 */
     TclBN_mp_tc_or, /* 74 */
@@ -1489,7 +1526,7 @@ const TclStubs tclStubs = {
     Tcl_SourceRCFile, /* 241 */
     Tcl_SplitList, /* 242 */
     Tcl_SplitPath, /* 243 */
-    Tcl_StaticPackage, /* 244 */
+    Tcl_StaticLibrary, /* 244 */
     Tcl_StringMatch, /* 245 */
     Tcl_TellOld, /* 246 */
     Tcl_TraceVar, /* 247 */
@@ -1571,12 +1608,12 @@ const TclStubs tclStubs = {
     Tcl_UniCharToUpper, /* 323 */
     Tcl_UniCharToUtf, /* 324 */
     Tcl_UtfAtIndex, /* 325 */
-    Tcl_UtfCharComplete, /* 326 */
+    TclUtfCharComplete, /* 326 */
     Tcl_UtfBackslash, /* 327 */
     Tcl_UtfFindFirst, /* 328 */
     Tcl_UtfFindLast, /* 329 */
-    Tcl_UtfNext, /* 330 */
-    Tcl_UtfPrev, /* 331 */
+    TclUtfNext, /* 330 */
+    TclUtfPrev, /* 331 */
     Tcl_UtfToExternal, /* 332 */
     Tcl_UtfToExternalDString, /* 333 */
     Tcl_UtfToLower, /* 334 */
@@ -1899,6 +1936,9 @@ const TclStubs tclStubs = {
     TclGetStringFromObj, /* 651 */
     TclGetUnicodeFromObj, /* 652 */
     TclGetByteArrayFromObj, /* 653 */
+    Tcl_UtfCharComplete, /* 654 */
+    Tcl_UtfNext, /* 655 */
+    Tcl_UtfPrev, /* 656 */
 };
 
 /* !END!: Do not edit above this line. */

generic/tclTest.c

@@ -19,6 +19,9 @@
 #ifndef USE_TCL_STUBS
 #   define USE_TCL_STUBS
 #endif
+#ifndef TCL_NO_DEPRECATED
+#   define TCL_NO_DEPRECATED
+#endif
 #include "tclInt.h"
 #ifdef TCL_WITH_EXTERNAL_TOMMATH
 #   include "tommath.h"
@@ -274,7 +277,7 @@ static Tcl_CmdProc	Testset2Cmd;
 static Tcl_CmdProc	TestseterrorcodeCmd;
 static Tcl_ObjCmdProc	TestsetobjerrorcodeCmd;
 static Tcl_CmdProc	TestsetplatformCmd;
-static Tcl_CmdProc	TeststaticpkgCmd;
+static Tcl_CmdProc	TeststaticlibraryCmd;
 static Tcl_CmdProc	TesttranslatefilenameCmd;
 static Tcl_CmdProc	TestupvarCmd;
 static Tcl_ObjCmdProc	TestWrongNumArgsObjCmd;
@@ -601,7 +604,7 @@ Tcltest_Init(
 	    NULL, NULL);
     Tcl_CreateCommand(interp, "testsocket", TestSocketCmd,
 	    NULL, NULL);
-    Tcl_CreateCommand(interp, "teststaticpkg", TeststaticpkgCmd,
+    Tcl_CreateCommand(interp, "teststaticlibrary", TeststaticlibraryCmd,
 	    NULL, NULL);
     Tcl_CreateCommand(interp, "testtranslatefilename",
 	    TesttranslatefilenameCmd, NULL, NULL);
@@ -4214,10 +4217,10 @@ TestsetplatformCmd(
 /*
  *----------------------------------------------------------------------
  *
- * TeststaticpkgCmd --
+ * TeststaticlibraryCmd --
  *
- *	This procedure implements the "teststaticpkg" command.
- *	It is used to test the procedure Tcl_StaticPackage.
+ *	This procedure implements the "teststaticlibrary" command.
+ *	It is used to test the procedure Tcl_StaticLibrary.
  *
  * Results:
  *	A standard Tcl result.
@@ -4230,7 +4233,7 @@ TestsetplatformCmd(
  */
 
 static int
-TeststaticpkgCmd(
+TeststaticlibraryCmd(
     TCL_UNUSED(void *),
     Tcl_Interp *interp,		/* Current interpreter. */
     int argc,			/* Number of arguments. */
@@ -4240,7 +4243,7 @@ TeststaticpkgCmd(
 
     if (argc != 4) {
 	Tcl_AppendResult(interp, "wrong # arguments: should be \"",
-		argv[0], " pkgName safe loaded\"", NULL);
+		argv[0], " prefix safe loaded\"", NULL);
 	return TCL_ERROR;
     }
     if (Tcl_GetInt(interp, argv[2], &safe) != TCL_OK) {
@@ -4249,7 +4252,7 @@ TeststaticpkgCmd(
     if (Tcl_GetInt(interp, argv[3], &loaded) != TCL_OK) {
 	return TCL_ERROR;
     }
-    Tcl_StaticPackage((loaded) ? interp : NULL, argv[1],
+    Tcl_StaticLibrary((loaded) ? interp : NULL, argv[1],
 	    StaticInitProc, (safe) ? StaticInitProc : NULL);
     return TCL_OK;
 }
@@ -6962,7 +6965,7 @@ TestUtfPrevCmd(
     } else {
 	offset = numBytes;
     }
-    result = TclUtfPrev(bytes + offset, bytes);
+    result = Tcl_UtfPrev(bytes + offset, bytes);
     Tcl_SetObjResult(interp, Tcl_NewIntObj(result - bytes));
     return TCL_OK;
 }

generic/tclTestObj.c

@@ -1176,7 +1176,7 @@ TeststringobjCmd(
 {
     Tcl_UniChar *unicode;
     int varIndex, option, i, length;
-    size_t size;
+    int size;
 #define MAX_STRINGS 11
     const char *index, *string, *strings[MAX_STRINGS+1];
     String *strPtr;
@@ -1371,7 +1371,7 @@ TeststringobjCmd(
 	    if (Tcl_GetIntFromObj(interp, objv[3], &i) != TCL_OK) {
 		return TCL_ERROR;
 	    }
-	    if ((i < 0) || ((size_t)i > size)) {
+	    if ((i < 0) || (i > size)) {
 		Tcl_SetObjResult(interp, Tcl_NewStringObj(
 			"index value out of range", -1));
 		return TCL_ERROR;
@@ -1402,7 +1402,7 @@ TeststringobjCmd(
 	    if (Tcl_GetIntFromObj(interp, objv[3], &i) != TCL_OK) {
 		return TCL_ERROR;
 	    }
-	    if ((i < 0) || ((size_t)i > size)) {
+	    if ((i < 0) || (i > size)) {
 		Tcl_SetObjResult(interp, Tcl_NewStringObj(
 			"index value out of range", -1));
 		return TCL_ERROR;

generic/tclThreadAlloc.c

@@ -82,18 +82,17 @@ typedef union Block {
  * and statistics information.
  */
 
-typedef struct Bucket {
+typedef struct {
     Block *firstPtr;		/* First block available */
     Block *lastPtr;		/* End of block list */
-    long numFree;		/* Number of blocks available */
+    size_t numFree;		/* Number of blocks available */
 
     /* All fields below for accounting only */
 
-    long numRemoves;		/* Number of removes from bucket */
-    long numInserts;		/* Number of inserts into bucket */
-    long numWaits;		/* Number of waits to acquire a lock */
-    long numLocks;		/* Number of locks acquired */
-    long totalAssigned;		/* Total space assigned to bucket */
+    size_t numRemoves;		/* Number of removes from bucket */
+    size_t numInserts;		/* Number of inserts into bucket */
+    size_t numLocks;		/* Number of locks acquired */
+    size_t totalAssigned;		/* Total space assigned to bucket */
 } Bucket;
 
 /*
@@ -107,9 +106,9 @@ typedef struct Cache {
     struct Cache *nextPtr;	/* Linked list of cache entries */
     Tcl_ThreadId owner;		/* Which thread's cache is this? */
     Tcl_Obj *firstObjPtr;	/* List of free objects for thread */
-    int numObjects;		/* Number of objects for thread */
+    size_t numObjects;		/* Number of objects for thread */
     Tcl_Obj *lastPtr;		/* Last object in this cache */
-    int totalAssigned;		/* Total space assigned to thread */
+    size_t totalAssigned;	/* Total space assigned to thread */
     Bucket buckets[NBUCKETS];	/* The buckets for this thread */
 } Cache;
 
@@ -120,8 +119,8 @@ typedef struct Cache {
 
 static struct {
     size_t blockSize;		/* Bucket blocksize. */
-    int maxBlocks;		/* Max blocks before move to share. */
-    int numMove;		/* Num blocks to move to share. */
+    size_t maxBlocks;		/* Max blocks before move to share. */
+    size_t numMove;			/* Num blocks to move to share. */
     Tcl_Mutex *lockPtr;		/* Share bucket lock. */
 } bucketInfo[NBUCKETS];
 
@@ -132,12 +131,12 @@ static struct {
 static Cache *	GetCache(void);
 static void	LockBucket(Cache *cachePtr, int bucket);
 static void	UnlockBucket(Cache *cachePtr, int bucket);
-static void	PutBlocks(Cache *cachePtr, int bucket, int numMove);
+static void	PutBlocks(Cache *cachePtr, int bucket, size_t numMove);
 static int	GetBlocks(Cache *cachePtr, int bucket);
 static Block *	Ptr2Block(void *ptr);
-static void *	Block2Ptr(Block *blockPtr, int bucket, unsigned int reqSize);
-static void	MoveObjs(Cache *fromPtr, Cache *toPtr, int numMove);
-static void	PutObjs(Cache *fromPtr, int numMove);
+static void *	Block2Ptr(Block *blockPtr, int bucket, size_t reqSize);
+static void	MoveObjs(Cache *fromPtr, Cache *toPtr, size_t numMove);
+static void	PutObjs(Cache *fromPtr, size_t numMove);
 
 /*
  * Local variables defined in this file and initialized at startup.
@@ -548,7 +547,7 @@ TclThreadAllocObj(void)
      */
 
     if (cachePtr->numObjects == 0) {
-	int numMove;
+	size_t numMove;
 
 	Tcl_MutexLock(objLockPtr);
 	numMove = sharedPtr->numObjects;
@@ -565,11 +564,11 @@ TclThreadAllocObj(void)
 	    cachePtr->numObjects = numMove = NOBJALLOC;
 	    newObjsPtr = (Tcl_Obj *)TclpSysAlloc(sizeof(Tcl_Obj) * numMove, 0);
 	    if (newObjsPtr == NULL) {
-		Tcl_Panic("alloc: could not allocate %d new objects", numMove);
+		Tcl_Panic("alloc: could not allocate %" TCL_Z_MODIFIER "u new objects", numMove);
 	    }
 	    cachePtr->lastPtr = newObjsPtr + numMove - 1;
 	    objPtr = cachePtr->firstObjPtr;	/* NULL */
-	    while (--numMove >= 0) {
+	    while (numMove-- > 0) {
 		newObjsPtr[numMove].internalRep.twoPtrValue.ptr1 = objPtr;
 		objPtr = newObjsPtr + numMove;
 	    }
@@ -671,14 +670,14 @@ Tcl_GetMemoryInfo(
 	    Tcl_DStringAppendElement(dsPtr, buf);
 	}
 	for (n = 0; n < NBUCKETS; ++n) {
-	    sprintf(buf, "%lu %ld %ld %ld %ld %ld %ld",
-		    (unsigned long) bucketInfo[n].blockSize,
+	    sprintf(buf, "%" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u %"
+		    TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u %" TCL_Z_MODIFIER "u",
+		    bucketInfo[n].blockSize,
 		    cachePtr->buckets[n].numFree,
 		    cachePtr->buckets[n].numRemoves,
 		    cachePtr->buckets[n].numInserts,
 		    cachePtr->buckets[n].totalAssigned,
-		    cachePtr->buckets[n].numLocks,
-		    cachePtr->buckets[n].numWaits);
+		    cachePtr->buckets[n].numLocks);
 	    Tcl_DStringAppendElement(dsPtr, buf);
 	}
 	Tcl_DStringEndSublist(dsPtr);
@@ -707,7 +706,7 @@ static void
 MoveObjs(
     Cache *fromPtr,
     Cache *toPtr,
-    int numMove)
+    size_t numMove)
 {
     Tcl_Obj *objPtr = fromPtr->firstObjPtr;
     Tcl_Obj *fromFirstObjPtr = objPtr;
@@ -720,7 +719,7 @@ MoveObjs(
      * to be moved) as the first object in the 'from' cache.
      */
 
-    while (--numMove) {
+    while (numMove-- > 1) {
 	objPtr = (Tcl_Obj *)objPtr->internalRep.twoPtrValue.ptr1;
     }
     fromPtr->firstObjPtr = (Tcl_Obj *)objPtr->internalRep.twoPtrValue.ptr1;
@@ -754,9 +753,9 @@ MoveObjs(
 static void
 PutObjs(
     Cache *fromPtr,
-    int numMove)
+    size_t numMove)
 {
-    int keep = fromPtr->numObjects - numMove;
+    size_t keep = fromPtr->numObjects - numMove;
     Tcl_Obj *firstPtr, *lastPtr = NULL;
 
     fromPtr->numObjects = keep;
@@ -767,7 +766,7 @@ PutObjs(
 	do {
 	    lastPtr = firstPtr;
 	    firstPtr = (Tcl_Obj *)firstPtr->internalRep.twoPtrValue.ptr1;
-	} while (--keep > 0);
+	} while (keep-- > 1);
 	lastPtr->internalRep.twoPtrValue.ptr1 = NULL;
     }
 
@@ -808,7 +807,7 @@ static void *
 Block2Ptr(
     Block *blockPtr,
     int bucket,
-    unsigned int reqSize)
+    size_t reqSize)
 {
     void *ptr;
 
@@ -898,14 +897,14 @@ static void
 PutBlocks(
     Cache *cachePtr,
     int bucket,
-    int numMove)
+    size_t numMove)
 {
     /*
      * We have numFree.  Want to shed numMove. So compute how many
      * Blocks to keep.
      */
 
-    int keep = cachePtr->buckets[bucket].numFree - numMove;
+    size_t keep = cachePtr->buckets[bucket].numFree - numMove;
     Block *lastPtr = NULL, *firstPtr;
 
     cachePtr->buckets[bucket].numFree = keep;
@@ -916,7 +915,7 @@ PutBlocks(
 	do {
 	    lastPtr = firstPtr;
 	    firstPtr = firstPtr->nextBlock;
-	} while (--keep > 0);
+	} while (keep-- > 1);
 	lastPtr->nextBlock = NULL;
     }
 
@@ -961,7 +960,7 @@ GetBlocks(
     int bucket)
 {
     Block *blockPtr;
-    int n;
+    size_t n;
 
     /*
      * First, atttempt to move blocks from the shared cache. Note the
@@ -994,7 +993,7 @@ GetBlocks(
 		cachePtr->buckets[bucket].firstPtr = blockPtr;
 		sharedPtr->buckets[bucket].numFree -= n;
 		cachePtr->buckets[bucket].numFree = n;
-		while (--n > 0) {
+		while (n-- > 1) {
 		    blockPtr = blockPtr->nextBlock;
 		}
 		sharedPtr->buckets[bucket].firstPtr = blockPtr->nextBlock;
@@ -1016,7 +1015,7 @@ GetBlocks(
 	blockPtr = NULL;
 	n = NBUCKETS;
 	size = 0;
-	while (--n > bucket) {
+	while (n-- > (size_t)bucket + 1) {
 	    if (cachePtr->buckets[n].numFree > 0) {
 		size = bucketInfo[n].blockSize;
 		blockPtr = cachePtr->buckets[n].firstPtr;
@@ -1045,7 +1044,7 @@ GetBlocks(
 	n = size / bucketInfo[bucket].blockSize;
 	cachePtr->buckets[bucket].numFree = n;
 	cachePtr->buckets[bucket].firstPtr = blockPtr;
-	while (--n > 0) {
+	while (n-- > 1) {
 	    blockPtr->nextBlock = (Block *)
 		((char *) blockPtr + bucketInfo[bucket].blockSize);
 	    blockPtr = blockPtr->nextBlock;
@@ -1082,9 +1081,9 @@ TclInitThreadAlloc(void)
     objLockPtr = TclpNewAllocMutex();
     for (i = 0; i < NBUCKETS; ++i) {
 	bucketInfo[i].blockSize = MINALLOC << i;
-	bucketInfo[i].maxBlocks = 1 << (NBUCKETS - 1 - i);
+	bucketInfo[i].maxBlocks = ((size_t)1) << (NBUCKETS - 1 - i);
 	bucketInfo[i].numMove = i < NBUCKETS - 1 ?
-		1 << (NBUCKETS - 2 - i) : 1;
+		(size_t)1 << (NBUCKETS - 2 - i) : 1;
 	bucketInfo[i].lockPtr = TclpNewAllocMutex();
     }
     TclpInitAllocCache();

generic/tclThreadJoin.c

@@ -305,6 +305,8 @@ TclSignalExitThread(
 
     Tcl_MutexUnlock(&threadPtr->threadMutex);
 }
+#else
+TCL_MAC_EMPTY_FILE(generic_tclThreadJoin_c)
 #endif /* _WIN32 */
 
 /*

generic/tclThreadTest.c

@@ -368,9 +368,9 @@ ThreadObjCmd(
 	if (result == TCL_OK) {
 	    Tcl_SetIntObj(Tcl_GetObjResult(interp), status);
 	} else {
-	    char buf[20];
+	    char buf[TCL_INTEGER_SPACE];
 
-	    sprintf(buf, "%" TCL_LL_MODIFIER "d", id);
+	    sprintf(buf, "%" TCL_LL_MODIFIER "d", (long long)id);
 	    Tcl_AppendResult(interp, "cannot join thread ", buf, NULL);
 	}
 	return result;

generic/tclTomMath.decls

@@ -7,7 +7,7 @@
 # If you edit this file, advance the revision number (and the epoch
 # if the new stubs are not backward compatible) in tclTomMathDecls.h
 #
-# Copyright (c) 2005 by Kevin B. Kenny.  All rights reserved.
+# Copyright © 2005 Kevin B. Kenny.  All rights reserved.
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -17,7 +17,6 @@ library tcl
 # Define the unsupported generic interfaces.
 
 interface tclTomMath
-# hooks {tclTomMathInt}
 scspec EXTERN
 
 # Declare each of the functions in the Tcl tommath interface
@@ -244,6 +243,10 @@ declare 69 {
 declare 70 {
     void TclBN_mp_set_i64(mp_int *a, int64_t i)
 }
+declare 71 {
+    mp_err MP_WUR TclBN_mp_unpack(mp_int *rop, size_t count, mp_order order, size_t size,
+	    mp_endian endian, size_t nails, const void *op)
+}
 
 # Added in libtommath 1.1.0
 declare 73 {deprecated {merged with mp_and}} {

generic/tclTomMathDecls.h

@@ -53,7 +53,11 @@
 #define MP_FREE(mem, size)                TclBNFree(mem)
 
 #ifndef MODULE_SCOPE
-#   define MODULE_SCOPE extern
+#   ifdef __cplusplus
+#	define MODULE_SCOPE extern "C"
+#   else
+#	define MODULE_SCOPE extern
+#   endif
 #endif
 
 #ifdef __cplusplus
@@ -69,6 +73,11 @@ MODULE_SCOPE mp_err	TclBN_s_mp_mul_d(const mp_int *a, mp_digit b, mp_int *c);
 MODULE_SCOPE void	TclBN_s_mp_reverse(unsigned char *s, size_t len);
 MODULE_SCOPE void	TclBN_s_mp_set(mp_int *a, mp_digit b);
 MODULE_SCOPE mp_err	TclBN_s_mp_sub_d(const mp_int *a, mp_digit b, mp_int *c);
+MODULE_SCOPE mp_err	TclBN_s_mp_balance_mul(const mp_int *a, const mp_int *b, mp_int *c);
+MODULE_SCOPE const char *const TclBN_mp_s_rmap;
+MODULE_SCOPE const uint8_t TclBN_mp_s_rmap_reverse[];
+MODULE_SCOPE const size_t TclBN_mp_s_rmap_reverse_sz;
+MODULE_SCOPE mp_err	TclBN_mp_set_int(mp_int *a, unsigned long b);
 #ifdef __cplusplus
 }
 #endif
@@ -141,10 +150,11 @@ MODULE_SCOPE mp_err	TclBN_s_mp_sub_d(const mp_int *a, mp_digit b, mp_int *c);
 #define mp_to_radix TclBN_mp_to_radix
 #define mp_to_ubin TclBN_mp_to_ubin
 #define mp_ubin_size TclBN_mp_ubin_size
+#define mp_unpack TclBN_mp_unpack
 #define mp_xor TclBN_mp_xor
 #define mp_zero TclBN_mp_zero
 #define s_mp_add TclBN_s_mp_add
-#define s_mp_balance_mul TclBN_mp_balance_mul
+#define s_mp_balance_mul TclBN_s_mp_balance_mul
 #define s_mp_karatsuba_mul TclBN_mp_karatsuba_mul
 #define s_mp_karatsuba_sqr TclBN_mp_karatsuba_sqr
 #define s_mp_mul_digs TclBN_s_mp_mul_digs
@@ -379,7 +389,11 @@ EXTERN void		TclBN_mp_set_u64(mp_int *a, uint64_t i);
 EXTERN uint64_t		TclBN_mp_get_mag_u64(const mp_int *a) MP_WUR;
 /* 70 */
 EXTERN void		TclBN_mp_set_i64(mp_int *a, int64_t i);
-/* Slot 71 is reserved */
+/* 71 */
+EXTERN mp_err		TclBN_mp_unpack(mp_int *rop, size_t count,
+				mp_order order, size_t size,
+				mp_endian endian, size_t nails,
+				const void *op) MP_WUR;
 /* Slot 72 is reserved */
 /* 73 */
 TCL_DEPRECATED("merged with mp_and")
@@ -482,7 +496,7 @@ typedef struct TclTomMathStubs {
     void (*tclBN_mp_set_u64) (mp_int *a, uint64_t i); /* 68 */
     uint64_t (*tclBN_mp_get_mag_u64) (const mp_int *a) MP_WUR; /* 69 */
     void (*tclBN_mp_set_i64) (mp_int *a, int64_t i); /* 70 */
-    void (*reserved71)(void);
+    mp_err (*tclBN_mp_unpack) (mp_int *rop, size_t count, mp_order order, size_t size, mp_endian endian, size_t nails, const void *op) MP_WUR; /* 71 */
     void (*reserved72)(void);
     TCL_DEPRECATED_API("merged with mp_and") mp_err (*tclBN_mp_tc_and) (const mp_int *a, const mp_int *b, mp_int *c); /* 73 */
     TCL_DEPRECATED_API("merged with mp_or") mp_err (*tclBN_mp_tc_or) (const mp_int *a, const mp_int *b, mp_int *c); /* 74 */
@@ -648,7 +662,8 @@ extern const TclTomMathStubs *tclTomMathStubsPtr;
 	(tclTomMathStubsPtr->tclBN_mp_get_mag_u64) /* 69 */
 #define TclBN_mp_set_i64 \
 	(tclTomMathStubsPtr->tclBN_mp_set_i64) /* 70 */
-/* Slot 71 is reserved */
+#define TclBN_mp_unpack \
+	(tclTomMathStubsPtr->tclBN_mp_unpack) /* 71 */
 /* Slot 72 is reserved */
 #define TclBN_mp_tc_and \
 	(tclTomMathStubsPtr->tclBN_mp_tc_and) /* 73 */

generic/tclTrace.c

@@ -68,25 +68,26 @@ typedef struct {
  * TCL_TRACE_ENTER_DURING_EXEC == 4 * TCL_TRACE_ENTER_EXEC and that
  * TCL_TRACE_LEAVE_DURING_EXEC == 4 * TCL_TRACE_LEAVE_EXEC.
  *
- * TCL_TRACE_ENTER_DURING_EXEC  - Trace each command inside the command
- *				  currently being traced, before execution.
- * TCL_TRACE_LEAVE_DURING_EXEC  - Trace each command inside the command
- *				  currently being traced, after execution.
- * TCL_TRACE_ANY_EXEC		- OR'd combination of all EXEC flags.
- * TCL_TRACE_EXEC_IN_PROGRESS   - The callback function on this trace is
- *				  currently executing. Therefore we don't let
- *				  further traces execute.
- * TCL_TRACE_EXEC_DIRECT	- This execution trace is triggered directly
- *				  by the command being traced, not because of
- *				  an internal trace.
  * The flag 'TCL_TRACE_DESTROYED' may also be used in command execution traces.
  */
 
-#define TCL_TRACE_ENTER_DURING_EXEC	4
-#define TCL_TRACE_LEAVE_DURING_EXEC	8
-#define TCL_TRACE_ANY_EXEC		15
-#define TCL_TRACE_EXEC_IN_PROGRESS	0x10
-#define TCL_TRACE_EXEC_DIRECT		0x20
+enum {
+    TCL_TRACE_ENTER_DURING_EXEC = 4,
+				/* Trace each command inside the command
+				 * currently being traced, before execution.*/
+    TCL_TRACE_LEAVE_DURING_EXEC = 8,
+				/* Trace each command inside the command
+				 * currently being traced, after execution. */
+    TCL_TRACE_ANY_EXEC = 15,	/* OR'd combination of all EXEC flags. */
+    TCL_TRACE_EXEC_IN_PROGRESS = 0x10,
+				/* The callback function on this trace is
+				 * currently executing. Therefore we don't let
+				 * further traces execute. */
+    TCL_TRACE_EXEC_DIRECT = 0x20
+				/* This execution trace is triggered directly
+				 * by the command being traced, not because of
+				 * an internal trace. */
+};
 
 /*
  * Forward declarations for functions defined in this file:

generic/tclUtf.c

@@ -64,20 +64,12 @@ static const unsigned char totalBytes[256] = {
     1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
     1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
     1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
-/* Tcl_UtfCharComplete() might point to 2nd byte of valid 4-byte sequence */
-    3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,
-    3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,
-/* End of "continuation byte section" */
+    1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
+    1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
     2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,
-    3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,
-#if TCL_UTF_MAX > 3
-    4,4,4,4,4,
-#else
-    1,1,1,1,1,
-#endif
-    1,1,1,1,1,1,1,1,1,1,1
+    3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,4,4,4,4,4,1,1,1,1,1,1,1,1,1,1,1
 };
-
+
 static const unsigned char complete[256] = {
     1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
     1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
@@ -88,15 +80,9 @@ static const unsigned char complete[256] = {
     3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,
 /* End of "continuation byte section" */
     2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,
-    3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,
-#if TCL_UTF_MAX > 3
-    4,4,4,4,4,
-#else
-    3,3,3,3,3,
-#endif
-    1,1,1,1,1,1,1,1,1,1,1
+    3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,3,4,4,4,4,4,1,1,1,1,1,1,1,1,1,1,1
 };
-
+
 /*
  * Functions used only in this module.
  */
@@ -694,7 +680,7 @@ Tcl_UtfToUniCharDString(
 	p += TclUtfToUCS4(p, &ch);
 	*w++ = ch;
     }
-    while ((p < endPtr) && TclUCS4Complete(p, endPtr-p)) {
+    while ((p < endPtr) && Tcl_UtfCharComplete(p, endPtr-p)) {
 	p += TclUtfToUCS4(p, &ch);
 	*w++ = ch;
     }
@@ -752,7 +738,7 @@ Tcl_UtfToChar16DString(
 	*w++ = ch;
     }
     while (p < endPtr) {
-	if (TclChar16Complete(p, endPtr-p)) {
+	if (Tcl_UtfCharComplete(p, endPtr-p)) {
 	    p += Tcl_UtfToChar16(p, &ch);
 	    *w++ = ch;
 	} else {
@@ -833,7 +819,7 @@ Tcl_NumUtfChars(
 	/* Pointer to the end of string. Never read endPtr[0] */
 	const char *endPtr = src + length;
 	/* Pointer to last byte where optimization still can be used */
-	const char *optPtr = endPtr - TCL_UTF_MAX;
+	const char *optPtr = endPtr - 4;
 
 	/*
 	 * Optimize away the call in this loop. Justified because...
@@ -970,6 +956,10 @@ Tcl_UtfNext(
     const char *next;
 
     if (((*src) & 0xC0) == 0x80) {
+	/* Continuation byte, so we start 'inside' a (possible valid) UTF-8
+	 * sequence. Since we are not allowed to access src[-1], we cannot
+	 * check if the sequence is actually valid, the best we can do is
+	 * just assume it is valid and locate the end. */
 	if ((((*++src) & 0xC0) == 0x80) && (((*++src) & 0xC0) == 0x80)) {
 	    ++src;
 	}
@@ -1064,7 +1054,7 @@ Tcl_UtfPrev(
 		 * it (the fallback) is correct.
 		 */
 
-		    || (trailBytesSeen >= complete[byte])) {
+		    || (trailBytesSeen >= totalBytes[byte])) {
 		/*
 		 * That is, (1 + trailBytesSeen > needed).
 		 * We've examined more bytes than needed to complete
@@ -1105,19 +1095,14 @@ Tcl_UtfPrev(
 
 	/* Continue the search backwards... */
 	look--;
-    } while (trailBytesSeen < TCL_UTF_MAX);
+    } while (trailBytesSeen < 4);
 
     /*
-     * We've seen TCL_UTF_MAX trail bytes, so we know there will not be a
+     * We've seen 4 trail bytes, so we know there will not be a
      * properly formed byte sequence to find, and we can stop looking,
-     * accepting the fallback (for TCL_UTF_MAX > 3) or just go back as
-     * far as we can.
+     * accepting the fallback.
      */
-#if TCL_UTF_MAX > 3
     return fallback;
-#else
-    return src - TCL_UTF_MAX;
-#endif
 }
 
 /*
@@ -1744,7 +1729,7 @@ Tcl_UniCharToLower(
     /* Clear away extension bits, if any */
     return ch & 0x1FFFFF;
 }
-
+
 /*
  *----------------------------------------------------------------------
  *
@@ -1838,7 +1823,7 @@ Tcl_UniCharNcmp(
     const Tcl_UniChar *uct,	/* Unicode string ucs is compared to. */
     unsigned long numChars)	/* Number of unichars to compare. */
 {
-#ifdef WORDS_BIGENDIAN
+#if defined(WORDS_BIGENDIAN) && (TCL_UTF_MAX > 3)
     /*
      * We are definitely on a big-endian machine; memcmp() is safe
      */
@@ -1852,6 +1837,14 @@ Tcl_UniCharNcmp(
 
     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);
 	}
     }
@@ -1889,6 +1882,14 @@ Tcl_UniCharNcasecmp(
 	    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);
 	    }
 	}

generic/tclUtil.c

@@ -88,11 +88,13 @@ static ProcessGlobalValue executableName = {
  */
 
 #define COMPAT 1
-#define CONVERT_NONE	0
-#define CONVERT_BRACE	2
-#define CONVERT_ESCAPE	4
-#define CONVERT_MASK	(CONVERT_BRACE | CONVERT_ESCAPE)
-#define CONVERT_ANY	16
+enum {
+    CONVERT_NONE = 0,
+    CONVERT_BRACE = 2,
+    CONVERT_ESCAPE = 4,
+    CONVERT_MASK = (CONVERT_BRACE | CONVERT_ESCAPE),
+    CONVERT_ANY = 16
+};
 
 /*
  * The following key is used by Tcl_PrintDouble and TclPrecTraceProc to
@@ -1707,7 +1709,7 @@ TclTrimRight(
 	const char *q = trim;
 	int pInc = 0, bytesLeft = numTrim;
 
-	pp = TclUtfPrev(p, bytes);
+	pp = Tcl_UtfPrev(p, bytes);
 	do {
 	    pp += pInc;
  	    pInc = TclUtfToUCS4(pp, &ch1);
@@ -1718,14 +1720,14 @@ TclTrimRight(
 	 */
 
 	do {
-	    int qInc = TclUtfToUCS4(q, &ch2);
+	    pInc = TclUtfToUCS4(q, &ch2);
 
 	    if (ch1 == ch2) {
 		break;
 	    }
 
-	    q += qInc;
-	    bytesLeft -= qInc;
+	    q += pInc;
+	    bytesLeft -= pInc;
 	} while (bytesLeft);
 
 	if (bytesLeft == 0) {
@@ -1771,7 +1773,7 @@ TclTrimLeft(
 			 * rely on (trim[numTrim] == '\0'). */
 {
     const char *p = bytes;
-	int ch1, ch2;
+    int ch1, ch2;
 
     /* Empty strings -> nothing to do */
     if ((numBytes == 0) || (numTrim == 0)) {
@@ -2030,7 +2032,14 @@ Tcl_ConcatObj(
 		continue;
 	    }
 	    if (resPtr) {
-		if (TCL_OK != Tcl_ListObjAppendList(NULL, resPtr, objPtr)) {
+		Tcl_Obj *elemPtr = NULL;
+
+		Tcl_ListObjIndex(NULL, objPtr, 0, &elemPtr);
+		if (elemPtr == NULL) {
+		    continue;
+		}
+		if (Tcl_GetString(elemPtr)[0] == '#' || TCL_OK
+			!= Tcl_ListObjAppendList(NULL, resPtr, objPtr)) {
 		    /* Abandon ship! */
 		    Tcl_DecrRefCount(resPtr);
 		    goto slow;

generic/tclZlib.c

@@ -140,11 +140,13 @@ typedef struct {
  *	STREAM_DONE -	Flag to signal stream end up to transform input.
  */
 
-#define ASYNC			0x01
-#define IN_HEADER		0x02
-#define OUT_HEADER		0x04
-#define STREAM_DECOMPRESS	0x08
-#define STREAM_DONE		0x10
+enum {
+    ASYNC = 0x01,
+    IN_HEADER = 0x02,
+    OUT_HEADER = 0x04,
+    STREAM_DECOMPRESS = 0x08,
+    STREAM_DONE = 0x10
+};
 
 /*
  * Size of buffers allocated by default, and the range it can be set to.  The
@@ -3957,7 +3959,7 @@ TclZlibInit(
      * Formally provide the package as a Tcl built-in.
      */
 
-#ifndef TCL_NO_DEPRECATED
+#if !defined(TCL_NO_DEPRECATED) && (TCL_MAJOR_VERSION < 9)
     Tcl_PkgProvide(interp, "zlib", TCL_ZLIB_VERSION);
 #endif
     return Tcl_PkgProvide(interp, "tcl::zlib", TCL_ZLIB_VERSION);

library/auto.tcl

@@ -70,60 +70,70 @@ proc tcl_findLibrary {basename version patch initScript enVarName varName} {
 	#    gives the end-user ultimate control to work-around any bugs, or
 	#    to customize.
 
-        if {[info exists env($enVarName)]} {
-            lappend dirs $env($enVarName)
-        }
+	if {[info exists env($enVarName)]} {
+	    lappend dirs $env($enVarName)
+	}
 
 	catch {
-      set found 0
+	    set found 0
 	    set root [zipfs root]
-	    set mountpoint [file join $root lib [string tolower $basename]]
-      lappend dirs [file join $root app ${basename}_library]
-      lappend dirs [file join $root lib $mountpoint ${basename}_library]
-      lappend dirs [file join $root lib $mountpoint]
+	    set mountpoint [file join $root lib $basename]
+	    lappend dirs [file join $root app ${basename}_library]
+	    lappend dirs [file join $root lib $mountpoint ${basename}_library]
+	    lappend dirs [file join $root lib $mountpoint]
 	    if {![zipfs exists [file join $root app ${basename}_library]] \
-	      && ![zipfs exists $mountpoint]} {
-	      set found 0
-	      foreach pkgdat [info loaded] {
-	        lassign $pkgdat dllfile dllpkg
-	        if {[string tolower $dllpkg] ne [string tolower $basename]} continue
-	        if {$dllfile eq {}} {
-	          # Loaded statically
-	          break
-	        }
-          set found 1
-	        zipfs mount $mountpoint $dllfile
-	        break
-	      }
-	      if {!$found} {
-  	      set paths {}
-  	      lappend paths [file join $root app]
-    	    lappend paths [::${basename}::pkgconfig get libdir,runtime]
-	        lappend paths [::${basename}::pkgconfig get bindir,runtime]
-	        if {[catch {::${basename}::pkgconfig get zipfile,runtime} zipfile]} {
-  	        set zipfile [string tolower \
-  	          "lib${basename}_[join [list {*}[split $version .] {*}$patch] _].zip"]
-  	      }
-  	      lappend paths [file dirname [file join [pwd] [info nameofexecutable]]]
-          foreach path $paths {
-            set archive [file join $path $zipfile]
-            if {![file exists $archive]} continue
-            zipfs mount $mountpoint $archive
-            if {[zipfs exists [file join $mountpoint ${basename}_library $initScript]]} {
-              lappend dirs [file join $mountpoint ${basename}_library]
-              set found 1
-              break
-            } elseif {[zipfs exists [file join $mountpoint $initScript]]} {
-              lappend dirs [file join $mountpoint $initScript]
-              set found 1
-              break
-            } else {
-              catch {zipfs unmount $archive}
-            }
-          }
-        }
-      }
-   }
+		    && ![zipfs exists $mountpoint]} {
+		set found 0
+		foreach pkgdat [info loaded] {
+		    lassign $pkgdat dllfile dllpkg
+		    if {$dllpkg ne $basename} continue
+		    if {$dllfile eq {}} {
+			# Loaded statically
+			break
+		    }
+		    set found 1
+		    zipfs mount $mountpoint $dllfile
+		    break
+		}
+		if {!$found} {
+		    set paths {}
+		    if {![catch {::${basename}::pkgconfig get libdir,runtime} dir]} {
+			lappend paths $dir
+		    } else {
+			catch {lappend paths [::tcl::pkgconfig get libdir,runtime]}
+		    }
+		    if {![catch {::${basename}::pkgconfig get bindir,runtime} dir]} {
+			lappend paths $dir
+		    } else {
+			catch {lappend paths [::tcl::pkgconfig get bindir,runtime]}
+		    }
+		    if {[catch {::${basename}::pkgconfig get dllfile,runtime} dllfile]} {
+			set dllfile "lib${basename}${version}[info sharedlibextension]"
+		    }
+		    set dir [file dirname [file join [pwd] [info nameofexecutable]]]
+		    lappend paths $dir
+		    lappend paths [file join [file dirname $dir] lib]
+		    foreach path $paths {
+			set archive [file join $path $dllfile]
+			if {![file exists $archive]} {
+			    continue
+			}
+			zipfs mount $mountpoint $archive
+			if {[zipfs exists [file join $mountpoint ${basename}_library $initScript]]} {
+			    lappend dirs [file join $mountpoint ${basename}_library]
+			    set found 1
+			    break
+			} elseif {[zipfs exists [file join $mountpoint $initScript]]} {
+			    lappend dirs [file join $mountpoint $initScript]
+			    set found 1
+			    break
+			} else {
+			    catch {zipfs unmount $archive}
+			}
+	      	    }
+		}
+	    }
+	}
 
 	# 2. In the package script directory registered within the
 	#    configuration of the package itself.
@@ -158,11 +168,11 @@ proc tcl_findLibrary {basename version patch initScript enVarName varName} {
 	# ../../../foo1.0.1/library
 	#		(From unix/arch directory in parallel build hierarchy)
 
-        set parentDir [file dirname [file dirname [info nameofexecutable]]]
-        set grandParentDir [file dirname $parentDir]
-        lappend dirs [file join $parentDir lib $basename$version]
-        lappend dirs [file join $grandParentDir lib $basename$version]
-        lappend dirs [file join $parentDir library]
+	set parentDir [file dirname [file dirname [info nameofexecutable]]]
+	set grandParentDir [file dirname $parentDir]
+	lappend dirs [file join $parentDir lib $basename$version]
+	lappend dirs [file join $grandParentDir lib $basename$version]
+	lappend dirs [file join $parentDir library]
 	if {0} {
 	    lappend dirs [file join $grandParentDir library]
 	    lappend dirs [file join $grandParentDir $basename$patch library]
@@ -185,19 +195,19 @@ proc tcl_findLibrary {basename version patch initScript enVarName varName} {
 	}
 	set seen($norm) {}
 
-        set the_library $i
-        set file [file join $i $initScript]
+	set the_library $i
+	set file [file join $i $initScript]
 
 	# source everything when in a safe interpreter because we have a
 	# source command, but no file exists command
 
-        if {[interp issafe] || [file exists $file]} {
-            if {![catch {uplevel #0 [list source $file]} msg opts]} {
-                return
-            }
+	if {[interp issafe] || [file exists $file]} {
+	    if {![catch {uplevel #0 [list source $file]} msg opts]} {
+		return
+	    }
 	    append errors "$file: $msg\n"
 	    append errors [dict get $opts -errorinfo]\n
-        }
+	}
     }
     unset -nocomplain the_library
     set msg "Can't find a usable $initScript in the following directories: \n"
@@ -236,7 +246,7 @@ if {[interp issafe]} {
 
 proc auto_mkindex {dir args} {
     if {[interp issafe]} {
-        error "can't generate index within safe interpreter"
+	error "can't generate index within safe interpreter"
     }
 
     set oldDir [pwd]
@@ -292,7 +302,7 @@ proc auto_mkindex_old {dir args} {
 	set f ""
 	set error [catch {
 	    set f [open $file]
-	    fconfigure $f -encoding utf-8 -eofchar \032
+	    fconfigure $f -encoding utf-8 -eofchar "\032 {}"
 	    while {[gets $f line] >= 0} {
 		if {[regexp {^proc[ 	]+([^ 	]*)} $line match procName]} {
 		    set procName [lindex [auto_qualify $procName "::"] 0]
@@ -404,7 +414,7 @@ proc auto_mkindex_parser::mkindex {file} {
     set scriptFile $file
 
     set fid [open $file]
-    fconfigure $fid -encoding utf-8 -eofchar \032
+    fconfigure $fid -encoding utf-8 -eofchar "\032 {}"
     set contents [read $fid]
     close $fid
 
@@ -424,7 +434,7 @@ proc auto_mkindex_parser::mkindex {file} {
     $parser eval $contents
 
     foreach name $imports {
-        catch {$parser eval [list _%@namespace forget $name]}
+	catch {$parser eval [list _%@namespace forget $name]}
     }
     return $index
 }
@@ -494,9 +504,9 @@ proc auto_mkindex_parser::commandInit {name arglist body} {
     set ns [namespace qualifiers $name]
     set tail [namespace tail $name]
     if {$ns eq ""} {
-        set fakeName [namespace current]::_%@fake_$tail
+	set fakeName [namespace current]::_%@fake_$tail
     } else {
-        set fakeName [namespace current]::[string map {:: _} _%@fake_$name]
+	set fakeName [namespace current]::[string map {:: _} _%@fake_$name]
     }
     proc $fakeName $arglist $body
 
@@ -505,8 +515,8 @@ proc auto_mkindex_parser::commandInit {name arglist body} {
     # the fully qualified names, and have the procs point to the aliases.
 
     if {[string match *::* $name]} {
-        set exportCmd [list _%@namespace export [namespace tail $name]]
-        $parser eval [list _%@namespace eval $ns $exportCmd]
+	set exportCmd [list _%@namespace export [namespace tail $name]]
+	$parser eval [list _%@namespace eval $ns $exportCmd]
 
 	# The following proc definition does not work if you want to tolerate
 	# space or something else diabolical in the procedure name, (i.e.,
@@ -518,11 +528,11 @@ proc auto_mkindex_parser::commandInit {name arglist body} {
 	# A gold star to someone that can make test autoMkindex-3.3 work
 	# properly
 
-        set alias [namespace tail $fakeName]
-        $parser invokehidden proc $name {args} "_%@eval {$alias} \$args"
-        $parser alias $alias $fakeName
+	set alias [namespace tail $fakeName]
+	$parser invokehidden proc $name {args} "_%@eval {$alias} \$args"
+	$parser alias $alias $fakeName
     } else {
-        $parser alias $name $fakeName
+	$parser alias $name $fakeName
     }
     return
 }
@@ -544,18 +554,18 @@ proc auto_mkindex_parser::fullname {name} {
     variable contextStack
 
     if {![string match ::* $name]} {
-        foreach ns $contextStack {
-            set name "${ns}::$name"
-            if {[string match ::* $name]} {
-                break
-            }
-        }
+	foreach ns $contextStack {
+	    set name "${ns}::$name"
+	    if {[string match ::* $name]} {
+		break
+	    }
+	}
     }
 
     if {[namespace qualifiers $name] eq ""} {
-        set name [namespace tail $name]
+	set name [namespace tail $name]
     } elseif {![string match ::* $name]} {
-        set name "::$name"
+	set name "::$name"
     }
 
     # Earlier, mkindex replaced all $'s with \0.  Now, we have to reverse that
@@ -645,27 +655,27 @@ auto_mkindex_parser::hook {
 
 auto_mkindex_parser::command namespace {op args} {
     switch -- $op {
-        eval {
-            variable parser
-            variable contextStack
+	eval {
+	    variable parser
+	    variable contextStack
 
-            set name [lindex $args 0]
-            set args [lrange $args 1 end]
+	    set name [lindex $args 0]
+	    set args [lrange $args 1 end]
 
-            set contextStack [linsert $contextStack 0 $name]
+	    set contextStack [linsert $contextStack 0 $name]
 	    $parser eval [list _%@namespace eval $name] $args
-            set contextStack [lrange $contextStack 1 end]
-        }
-        import {
-            variable parser
-            variable imports
-            foreach pattern $args {
-                if {$pattern ne "-force"} {
-                    lappend imports $pattern
-                }
-            }
-            catch {$parser eval "_%@namespace import $args"}
-        }
+	    set contextStack [lrange $contextStack 1 end]
+	}
+	import {
+	    variable parser
+	    variable imports
+	    foreach pattern $args {
+		if {$pattern ne "-force"} {
+		    lappend imports $pattern
+		}
+	    }
+	    catch {$parser eval "_%@namespace import $args"}
+	}
 	ensemble {
 	    variable parser
 	    variable contextStack

library/clock.tcl

@@ -2988,8 +2988,7 @@ proc ::tcl::clock::GetSystemTimeZone {} {
 	set timezone $result
     } elseif {[set result [getenv TZ]] ne {}} {
 	set timezone $result
-    }
-    if {![info exists timezone]} {
+    } else {
         # Cache the time zone only if it was detected by one of the
         # expensive methods.
         if { [info exists CachedSystemTimeZone] } {

library/dde/pkgIndex.tcl

@@ -1,3 +1,12 @@
-if {![package vsatisfies [package provide Tcl] 8.5-]} return
 if {[info sharedlibextension] != ".dll"} return
-package ifneeded dde 1.4.3 [list load [file join $dir tcldde14.dll]]
+if {[package vsatisfies [package provide Tcl] 9.0-]} {
+    package ifneeded dde 1.4.4 \
+	    [list load [file join $dir tcl9dde14.dll] Dde]
+} elseif {![package vsatisfies [package provide Tcl] 8.7]
+	&& [::tcl::pkgconfig get debug]} {
+    package ifneeded dde 1.4.4 \
+	    [list load [file join $dir tcldde14g.dll] Dde]
+} else {
+    package ifneeded dde 1.4.4 \
+	    [list load [file join $dir tcldde14.dll] Dde]
+}

library/init.tcl

@@ -442,7 +442,7 @@ proc auto_load_index {} {
 	    continue
 	} else {
 	    set error [catch {
-		fconfigure $f -encoding utf-8 -eofchar \032
+		fconfigure $f -encoding utf-8 -eofchar "\032 {}"
 		set id [gets $f]
 		if {$id eq "# Tcl autoload index file, version 2.0"} {
 		    eval [read $f]

library/install.tcl

@@ -35,7 +35,7 @@ proc ::practcl::_pkgindex_directory {path} {
       # Read the file, and override assumptions as needed
       ###
       set fin [open $file r]
-      fconfigure $fin -encoding utf-8 -eofchar \032
+      fconfigure $fin -encoding utf-8 -eofchar "\032 {}"
       set dat [read $fin]
       close $fin
       # Look for a teapot style Package statement
@@ -59,7 +59,7 @@ proc ::practcl::_pkgindex_directory {path} {
     foreach file [glob -nocomplain $path/*.tcl] {
       if { [file tail $file] == "version_info.tcl" } continue
       set fin [open $file r]
-      fconfigure $fin -encoding utf-8 -eofchar \032
+      fconfigure $fin -encoding utf-8 -eofchar "\032 {}"
       set dat [read $fin]
       close $fin
       if {![regexp "package provide" $dat]} continue
@@ -79,7 +79,7 @@ proc ::practcl::_pkgindex_directory {path} {
     return $buffer
   }
   set fin [open $pkgidxfile r]
-  fconfigure $fin -encoding utf-8 -eofchar \032
+  fconfigure $fin -encoding utf-8 -eofchar "\032 {}"
   set dat [read $fin]
   close $fin
   set trace 0