merge core-8-branch

180 files changed, 17750 insertions, 2212 deletions

diff --git a/.fossil-settings/binary-glob b/.fossil-settings/binary-glob
index ec574be..5eebf07 100644
--- a/.fossil-settings/binary-glob
+++ b/.fossil-settings/binary-glob
@@ -4,6 +4,7 @@ compat/zlib/win64/zdll.lib
 compat/zlib/win64/zlib1.dll
 compat/zlib/win64/libz.dll.a
 compat/zlib/zlib.3.pdf
+tools/empty.zip
 *.bmp
 *.gif
 *.png
\ No newline at end of file
diff --git a/.github/ISSUE_TEMPLATE.md b/.github/ISSUE_TEMPLATE.md
new file mode 100644
index 0000000..22d3860
--- /dev/null
+++ b/.github/ISSUE_TEMPLATE.md
@@ -0,0 +1,3 @@
+Important Note
+==========
+Please do not file issues with Tcl on Github. They are unlikely to be noticed in a timely fashion. Tcl issues are hosted in the [tcl fossil repository on core.tcl.tk](https://core.tcl.tk/tcl/tktnew); please post them there.
diff --git a/.github/PULL_REQUEST_TEMPLATE.md b/.github/PULL_REQUEST_TEMPLATE.md
new file mode 100644
index 0000000..da07cd2
--- /dev/null
+++ b/.github/PULL_REQUEST_TEMPLATE.md
@@ -0,0 +1,3 @@
+Important Note
+==========
+Please do not file pull requests with Tcl on Github. They are unlikely to be noticed in a timely fashion. Tcl issues (including patches) are hosted in the [tcl fossil repository on core.tcl.tk](https://core.tcl.tk/tcl/tktnew); please post them there.
diff --git a/compat/zlib/contrib/minizip/minizip.c b/compat/zlib/contrib/minizip/minizip.c
index 4288962..b5c67cc 100644
--- a/compat/zlib/contrib/minizip/minizip.c
+++ b/compat/zlib/contrib/minizip/minizip.c
@@ -12,7 +12,6 @@
          Copyright (C) 2009-2010 Mathias Svensson ( http://result42.com )
 */
 
-
 #if (!defined(_WIN32)) && (!defined(WIN32)) && (!defined(__APPLE__))
         #ifndef __USE_FILE_OFFSET64
                 #define __USE_FILE_OFFSET64
@@ -39,8 +38,7 @@
 #define FSEEKO_FUNC(stream, offset, origin) fseeko64(stream, offset, origin)
 #endif
 
-
-
+#include "tinydir.h"
 #include <stdio.h>
 #include <stdlib.h>
 #include <string.h>
@@ -172,6 +170,7 @@ void do_banner()
 void do_help()
 {
     printf("Usage : minizip [-o] [-a] [-0 to -9] [-p password] [-j] file.zip [files_to_add]\n\n" \
+           "  -r  Scan directories recursively\n" \
            "  -o  Overwrite existing file.zip\n" \
            "  -a  Append to existing file.zip\n" \
            "  -0  Store only\n" \
@@ -243,12 +242,153 @@ int isLargeFile(const char* filename)
  return largeFile;
 }
 
+void addFileToZip(zipFile zf, const char *filenameinzip, const char *password, int opt_exclude_path,int opt_compress_level) {
+    FILE * fin;
+    int size_read;
+    const char *savefilenameinzip;
+    zip_fileinfo zi;
+    unsigned long crcFile=0;
+    int zip64 = 0;
+    int err=0;
+    int size_buf=WRITEBUFFERSIZE;
+    unsigned char buf[WRITEBUFFERSIZE];
+    zi.tmz_date.tm_sec = zi.tmz_date.tm_min = zi.tmz_date.tm_hour =
+    zi.tmz_date.tm_mday = zi.tmz_date.tm_mon = zi.tmz_date.tm_year = 0;
+    zi.dosDate = 0;
+    zi.internal_fa = 0;
+    zi.external_fa = 0;
+    filetime(filenameinzip,&zi.tmz_date,&zi.dosDate);
+
+/*
+    err = zipOpenNewFileInZip(zf,filenameinzip,&zi,
+                     NULL,0,NULL,0,NULL / * comment * /,
+                     (opt_compress_level != 0) ? Z_DEFLATED : 0,
+                     opt_compress_level);
+*/
+    if ((password != NULL) && (err==ZIP_OK))
+        err = getFileCrc(filenameinzip,buf,size_buf,&crcFile);
+
+    zip64 = isLargeFile(filenameinzip);
+
+   /* The path name saved, should not include a leading slash. */
+   /*if it did, windows/xp and dynazip couldn't read the zip file. */
+     savefilenameinzip = filenameinzip;
+     while( savefilenameinzip[0] == '\\' || savefilenameinzip[0] == '/' )
+     {
+         savefilenameinzip++;
+     }
+
+     /*should the zip file contain any path at all?*/
+     if( opt_exclude_path )
+     {
+         const char *tmpptr;
+         const char *lastslash = 0;
+         for( tmpptr = savefilenameinzip; *tmpptr; tmpptr++)
+         {
+             if( *tmpptr == '\\' || *tmpptr == '/')
+             {
+                 lastslash = tmpptr;
+             }
+         }
+         if( lastslash != NULL )
+         {
+             savefilenameinzip = lastslash+1; // base filename follows last slash.
+         }
+     }
+
+     /**/
+    err = zipOpenNewFileInZip3_64(zf,savefilenameinzip,&zi,
+                     NULL,0,NULL,0,NULL /* comment*/,
+                     (opt_compress_level != 0) ? Z_DEFLATED : 0,
+                     opt_compress_level,0,
+                     /* -MAX_WBITS, DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY, */
+                     -MAX_WBITS, DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY,
+                     password,crcFile, zip64);
+
+    if (err != ZIP_OK)
+        printf("error in opening %s in zipfile\n",filenameinzip);
+    else
+    {
+        fin = FOPEN_FUNC(filenameinzip,"rb");
+        if (fin==NULL)
+        {
+            err=ZIP_ERRNO;
+            printf("error in opening %s for reading\n",filenameinzip);
+        }
+    }
+
+    if (err == ZIP_OK)
+        do
+        {
+            err = ZIP_OK;
+            size_read = (int)fread(buf,1,size_buf,fin);
+            if (size_read < size_buf)
+                if (feof(fin)==0)
+            {
+                printf("error in reading %s\n",filenameinzip);
+                err = ZIP_ERRNO;
+            }
+
+            if (size_read>0)
+            {
+                err = zipWriteInFileInZip (zf,buf,size_read);
+                if (err<0)
+                {
+                    printf("error in writing %s in the zipfile\n",
+                                     filenameinzip);
+                }
+
+            }
+        } while ((err == ZIP_OK) && (size_read>0));
+
+    if (fin)
+        fclose(fin);
+
+    if (err<0)
+        err=ZIP_ERRNO;
+    else
+    {
+        err = zipCloseFileInZip(zf);
+        if (err!=ZIP_OK)
+            printf("error in closing %s in the zipfile\n",
+                        filenameinzip);
+    }
+}
+
+
+void addPathToZip(zipFile zf, const char *filenameinzip, const char *password, int opt_exclude_path,int opt_compress_level) {
+    tinydir_dir dir;
+    int i;
+    char *newname[512];
+
+    tinydir_open_sorted(&dir, filenameinzip);
+
+    for (i = 0; i < dir.n_files; i++)
+    {
+        tinydir_file file;
+        tinydir_readfile_n(&dir, &file, i);
+        if(strcmp(file.name,".")==0) continue;
+        if(strcmp(file.name,"..")==0) continue;
+        sprintf(newname,"%s/%s",dir.path,file.name);
+        if (file.is_dir)
+        {
+            addPathToZip(zf,newname,password,opt_exclude_path,opt_compress_level);
+        } else {
+            addFileToZip(zf,newname,password,opt_exclude_path,opt_compress_level);
+        }
+    }
+
+    tinydir_close(&dir);
+}
+
+
 int main(argc,argv)
     int argc;
     char *argv[];
 {
     int i;
-    int opt_overwrite=0;
+    int opt_recursive=0;
+    int opt_overwrite=1;
     int opt_compress_level=Z_DEFAULT_COMPRESSION;
     int opt_exclude_path=0;
     int zipfilenamearg = 0;
@@ -285,7 +425,8 @@ int main(argc,argv)
                         opt_compress_level = c-'0';
                     if ((c=='j') || (c=='J'))
                         opt_exclude_path = 1;
-
+                    if ((c=='r') || (c=='R'))
+                        opt_recursive = 1;
                     if (((c=='p') || (c=='P')) && (i+1<argc))
                     {
                         password=argv[i+1];
@@ -392,117 +533,14 @@ int main(argc,argv)
                   ((argv[i][1]=='o') || (argv[i][1]=='O') ||
                    (argv[i][1]=='a') || (argv[i][1]=='A') ||
                    (argv[i][1]=='p') || (argv[i][1]=='P') ||
+                   (argv[i][1]=='r') || (argv[i][1]=='R') ||
                    ((argv[i][1]>='0') || (argv[i][1]<='9'))) &&
                   (strlen(argv[i]) == 2)))
             {
-                FILE * fin;
-                int size_read;
-                const char* filenameinzip = argv[i];
-                const char *savefilenameinzip;
-                zip_fileinfo zi;
-                unsigned long crcFile=0;
-                int zip64 = 0;
-
-                zi.tmz_date.tm_sec = zi.tmz_date.tm_min = zi.tmz_date.tm_hour =
-                zi.tmz_date.tm_mday = zi.tmz_date.tm_mon = zi.tmz_date.tm_year = 0;
-                zi.dosDate = 0;
-                zi.internal_fa = 0;
-                zi.external_fa = 0;
-                filetime(filenameinzip,&zi.tmz_date,&zi.dosDate);
-
-/*
-                err = zipOpenNewFileInZip(zf,filenameinzip,&zi,
-                                 NULL,0,NULL,0,NULL / * comment * /,
-                                 (opt_compress_level != 0) ? Z_DEFLATED : 0,
-                                 opt_compress_level);
-*/
-                if ((password != NULL) && (err==ZIP_OK))
-                    err = getFileCrc(filenameinzip,buf,size_buf,&crcFile);
-
-                zip64 = isLargeFile(filenameinzip);
-
-                                                         /* The path name saved, should not include a leading slash. */
-               /*if it did, windows/xp and dynazip couldn't read the zip file. */
-                 savefilenameinzip = filenameinzip;
-                 while( savefilenameinzip[0] == '\\' || savefilenameinzip[0] == '/' )
-                 {
-                     savefilenameinzip++;
-                 }
-
-                 /*should the zip file contain any path at all?*/
-                 if( opt_exclude_path )
-                 {
-                     const char *tmpptr;
-                     const char *lastslash = 0;
-                     for( tmpptr = savefilenameinzip; *tmpptr; tmpptr++)
-                     {
-                         if( *tmpptr == '\\' || *tmpptr == '/')
-                         {
-                             lastslash = tmpptr;
-                         }
-                     }
-                     if( lastslash != NULL )
-                     {
-                         savefilenameinzip = lastslash+1; // base filename follows last slash.
-                     }
-                 }
-
-                 /**/
-                err = zipOpenNewFileInZip3_64(zf,savefilenameinzip,&zi,
-                                 NULL,0,NULL,0,NULL /* comment*/,
-                                 (opt_compress_level != 0) ? Z_DEFLATED : 0,
-                                 opt_compress_level,0,
-                                 /* -MAX_WBITS, DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY, */
-                                 -MAX_WBITS, DEF_MEM_LEVEL, Z_DEFAULT_STRATEGY,
-                                 password,crcFile, zip64);
-
-                if (err != ZIP_OK)
-                    printf("error in opening %s in zipfile\n",filenameinzip);
-                else
-                {
-                    fin = FOPEN_FUNC(filenameinzip,"rb");
-                    if (fin==NULL)
-                    {
-                        err=ZIP_ERRNO;
-                        printf("error in opening %s for reading\n",filenameinzip);
-                    }
-                }
-
-                if (err == ZIP_OK)
-                    do
-                    {
-                        err = ZIP_OK;
-                        size_read = (int)fread(buf,1,size_buf,fin);
-                        if (size_read < size_buf)
-                            if (feof(fin)==0)
-                        {
-                            printf("error in reading %s\n",filenameinzip);
-                            err = ZIP_ERRNO;
-                        }
-
-                        if (size_read>0)
-                        {
-                            err = zipWriteInFileInZip (zf,buf,size_read);
-                            if (err<0)
-                            {
-                                printf("error in writing %s in the zipfile\n",
-                                                 filenameinzip);
-                            }
-
-                        }
-                    } while ((err == ZIP_OK) && (size_read>0));
-
-                if (fin)
-                    fclose(fin);
-
-                if (err<0)
-                    err=ZIP_ERRNO;
-                else
-                {
-                    err = zipCloseFileInZip(zf);
-                    if (err!=ZIP_OK)
-                        printf("error in closing %s in the zipfile\n",
-                                    filenameinzip);
+                if(opt_recursive) {
+                    addPathToZip(zf,argv[i],password,opt_exclude_path,opt_compress_level);
+                } else {
+                    addFileToZip(zf,argv[i],password,opt_exclude_path,opt_compress_level);
                 }
             }
         }
diff --git a/compat/zlib/contrib/minizip/tinydir.h b/compat/zlib/contrib/minizip/tinydir.h
new file mode 100755
index 0000000..eb34399
--- /dev/null
+++ b/compat/zlib/contrib/minizip/tinydir.h
@@ -0,0 +1,816 @@
+/*
+Copyright (c) 2013-2017, tinydir authors:
+- Cong Xu
+- Lautis Sun
+- Baudouin Feildel
+- Andargor <andargor@yahoo.com>
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+1. Redistributions of source code must retain the above copyright notice, this
+   list of conditions and the following disclaimer.
+2. Redistributions in binary form must reproduce the above copyright notice,
+   this list of conditions and the following disclaimer in the documentation
+   and/or other materials provided with the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR
+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+*/
+#ifndef TINYDIR_H
+#define TINYDIR_H
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#if ((defined _UNICODE) && !(defined UNICODE))
+#define UNICODE
+#endif
+
+#if ((defined UNICODE) && !(defined _UNICODE))
+#define _UNICODE
+#endif
+
+#include <errno.h>
+#include <stdlib.h>
+#include <string.h>
+#ifdef _MSC_VER
+# define WIN32_LEAN_AND_MEAN
+# include <windows.h>
+# include <tchar.h>
+# pragma warning(push)
+# pragma warning (disable : 4996)
+#else
+# include <dirent.h>
+# include <libgen.h>
+# include <sys/stat.h>
+# include <stddef.h>
+#endif
+#ifdef __MINGW32__
+# include <tchar.h>
+#endif
+
+
+/* types */
+
+/* Windows UNICODE wide character support */
+#if defined _MSC_VER || defined __MINGW32__
+# define _tinydir_char_t TCHAR
+# define TINYDIR_STRING(s) _TEXT(s)
+# define _tinydir_strlen _tcslen
+# define _tinydir_strcpy _tcscpy
+# define _tinydir_strcat _tcscat
+# define _tinydir_strcmp _tcscmp
+# define _tinydir_strrchr _tcsrchr
+# define _tinydir_strncmp _tcsncmp
+#else
+# define _tinydir_char_t char
+# define TINYDIR_STRING(s) s
+# define _tinydir_strlen strlen
+# define _tinydir_strcpy strcpy
+# define _tinydir_strcat strcat
+# define _tinydir_strcmp strcmp
+# define _tinydir_strrchr strrchr
+# define _tinydir_strncmp strncmp
+#endif
+
+#if (defined _MSC_VER || defined __MINGW32__)
+# include <windows.h>
+# define _TINYDIR_PATH_MAX MAX_PATH
+#elif defined  __linux__
+# include <limits.h>
+# define _TINYDIR_PATH_MAX PATH_MAX
+#elif defined(__unix__) || (defined(__APPLE__) && defined(__MACH__))
+# include <sys/param.h>
+# if defined(BSD)
+#  include <limits.h>
+#  define _TINYDIR_PATH_MAX PATH_MAX
+# endif
+#endif
+
+#ifndef _TINYDIR_PATH_MAX
+#define _TINYDIR_PATH_MAX 4096
+#endif
+
+#ifdef _MSC_VER
+/* extra chars for the "\\*" mask */
+# define _TINYDIR_PATH_EXTRA 2
+#else
+# define _TINYDIR_PATH_EXTRA 0
+#endif
+
+#define _TINYDIR_FILENAME_MAX 256
+
+#if (defined _MSC_VER || defined __MINGW32__)
+#define _TINYDIR_DRIVE_MAX 3
+#endif
+
+#ifdef _MSC_VER
+# define _TINYDIR_FUNC static __inline
+#elif !defined __STDC_VERSION__ || __STDC_VERSION__ < 199901L
+# define _TINYDIR_FUNC static __inline__
+#else
+# define _TINYDIR_FUNC static inline
+#endif
+
+/* readdir_r usage; define TINYDIR_USE_READDIR_R to use it (if supported) */
+#ifdef TINYDIR_USE_READDIR_R
+
+/* readdir_r is a POSIX-only function, and may not be available under various
+ * environments/settings, e.g. MinGW. Use readdir fallback */
+#if _POSIX_C_SOURCE >= 1 || _XOPEN_SOURCE || _BSD_SOURCE || _SVID_SOURCE ||\
+	_POSIX_SOURCE
+# define _TINYDIR_HAS_READDIR_R
+#endif
+#if _POSIX_C_SOURCE >= 200112L
+# define _TINYDIR_HAS_FPATHCONF
+# include <unistd.h>
+#endif
+#if _BSD_SOURCE || _SVID_SOURCE || \
+	(_POSIX_C_SOURCE >= 200809L || _XOPEN_SOURCE >= 700)
+# define _TINYDIR_HAS_DIRFD
+# include <sys/types.h>
+#endif
+#if defined _TINYDIR_HAS_FPATHCONF && defined _TINYDIR_HAS_DIRFD &&\
+	defined _PC_NAME_MAX
+# define _TINYDIR_USE_FPATHCONF
+#endif
+#if defined __MINGW32__ || !defined _TINYDIR_HAS_READDIR_R ||\
+	!(defined _TINYDIR_USE_FPATHCONF || defined NAME_MAX)
+# define _TINYDIR_USE_READDIR
+#endif
+
+/* Use readdir by default */
+#else
+# define _TINYDIR_USE_READDIR
+#endif
+
+/* MINGW32 has two versions of dirent, ASCII and UNICODE*/
+#ifndef _MSC_VER
+#if (defined __MINGW32__) && (defined _UNICODE)
+#define _TINYDIR_DIR _WDIR
+#define _tinydir_dirent _wdirent
+#define _tinydir_opendir _wopendir
+#define _tinydir_readdir _wreaddir
+#define _tinydir_closedir _wclosedir
+#else
+#define _TINYDIR_DIR DIR
+#define _tinydir_dirent dirent
+#define _tinydir_opendir opendir
+#define _tinydir_readdir readdir
+#define _tinydir_closedir closedir
+#endif
+#endif
+
+/* Allow user to use a custom allocator by defining _TINYDIR_MALLOC and _TINYDIR_FREE. */
+#if    defined(_TINYDIR_MALLOC) &&  defined(_TINYDIR_FREE)
+#elif !defined(_TINYDIR_MALLOC) && !defined(_TINYDIR_FREE)
+#else
+#error "Either define both alloc and free or none of them!"
+#endif
+
+#if !defined(_TINYDIR_MALLOC)
+	#define _TINYDIR_MALLOC(_size) malloc(_size)
+	#define _TINYDIR_FREE(_ptr)    free(_ptr)
+#endif /* !defined(_TINYDIR_MALLOC) */
+
+typedef struct tinydir_file
+{
+	_tinydir_char_t path[_TINYDIR_PATH_MAX];
+	_tinydir_char_t name[_TINYDIR_FILENAME_MAX];
+	_tinydir_char_t *extension;
+	int is_dir;
+	int is_reg;
+
+#ifndef _MSC_VER
+#ifdef __MINGW32__
+	struct _stat _s;
+#else
+	struct stat _s;
+#endif
+#endif
+} tinydir_file;
+
+typedef struct tinydir_dir
+{
+	_tinydir_char_t path[_TINYDIR_PATH_MAX];
+	int has_next;
+	size_t n_files;
+
+	tinydir_file *_files;
+#ifdef _MSC_VER
+	HANDLE _h;
+	WIN32_FIND_DATA _f;
+#else
+	_TINYDIR_DIR *_d;
+	struct _tinydir_dirent *_e;
+#ifndef _TINYDIR_USE_READDIR
+	struct _tinydir_dirent *_ep;
+#endif
+#endif
+} tinydir_dir;
+
+
+/* declarations */
+
+_TINYDIR_FUNC
+int tinydir_open(tinydir_dir *dir, const _tinydir_char_t *path);
+_TINYDIR_FUNC
+int tinydir_open_sorted(tinydir_dir *dir, const _tinydir_char_t *path);
+_TINYDIR_FUNC
+void tinydir_close(tinydir_dir *dir);
+
+_TINYDIR_FUNC
+int tinydir_next(tinydir_dir *dir);
+_TINYDIR_FUNC
+int tinydir_readfile(const tinydir_dir *dir, tinydir_file *file);
+_TINYDIR_FUNC
+int tinydir_readfile_n(const tinydir_dir *dir, tinydir_file *file, size_t i);
+_TINYDIR_FUNC
+int tinydir_open_subdir_n(tinydir_dir *dir, size_t i);
+
+_TINYDIR_FUNC
+int tinydir_file_open(tinydir_file *file, const _tinydir_char_t *path);
+_TINYDIR_FUNC
+void _tinydir_get_ext(tinydir_file *file);
+_TINYDIR_FUNC
+int _tinydir_file_cmp(const void *a, const void *b);
+#ifndef _MSC_VER
+#ifndef _TINYDIR_USE_READDIR
+_TINYDIR_FUNC
+size_t _tinydir_dirent_buf_size(_TINYDIR_DIR *dirp);
+#endif
+#endif
+
+
+/* definitions*/
+
+_TINYDIR_FUNC
+int tinydir_open(tinydir_dir *dir, const _tinydir_char_t *path)
+{
+#ifndef _MSC_VER
+#ifndef _TINYDIR_USE_READDIR
+	int error;
+	int size;	/* using int size */
+#endif
+#else
+	_tinydir_char_t path_buf[_TINYDIR_PATH_MAX];
+#endif
+	_tinydir_char_t *pathp;
+
+	if (dir == NULL || path == NULL || _tinydir_strlen(path) == 0)
+	{
+		errno = EINVAL;
+		return -1;
+	}
+	if (_tinydir_strlen(path) + _TINYDIR_PATH_EXTRA >= _TINYDIR_PATH_MAX)
+	{
+		errno = ENAMETOOLONG;
+		return -1;
+	}
+
+	/* initialise dir */
+	dir->_files = NULL;
+#ifdef _MSC_VER
+	dir->_h = INVALID_HANDLE_VALUE;
+#else
+	dir->_d = NULL;
+#ifndef _TINYDIR_USE_READDIR
+	dir->_ep = NULL;
+#endif
+#endif
+	tinydir_close(dir);
+
+	_tinydir_strcpy(dir->path, path);
+	/* Remove trailing slashes */
+	pathp = &dir->path[_tinydir_strlen(dir->path) - 1];
+	while (pathp != dir->path && (*pathp == TINYDIR_STRING('\\') || *pathp == TINYDIR_STRING('/')))
+	{
+		*pathp = TINYDIR_STRING('\0');
+		pathp++;
+	}
+#ifdef _MSC_VER
+	_tinydir_strcpy(path_buf, dir->path);
+	_tinydir_strcat(path_buf, TINYDIR_STRING("\\*"));
+#if (defined WINAPI_FAMILY) && (WINAPI_FAMILY != WINAPI_FAMILY_DESKTOP_APP)
+	dir->_h = FindFirstFileEx(path_buf, FindExInfoStandard, &dir->_f, FindExSearchNameMatch, NULL, 0);
+#else
+	dir->_h = FindFirstFile(path_buf, &dir->_f);
+#endif
+	if (dir->_h == INVALID_HANDLE_VALUE)
+	{
+		errno = ENOENT;
+#else
+	dir->_d = _tinydir_opendir(path);
+	if (dir->_d == NULL)
+	{
+#endif
+		goto bail;
+	}
+
+	/* read first file */
+	dir->has_next = 1;
+#ifndef _MSC_VER
+#ifdef _TINYDIR_USE_READDIR
+	dir->_e = _tinydir_readdir(dir->_d);
+#else
+	/* allocate dirent buffer for readdir_r */
+	size = _tinydir_dirent_buf_size(dir->_d); /* conversion to int */
+	if (size == -1) return -1;
+	dir->_ep = (struct _tinydir_dirent*)_TINYDIR_MALLOC(size);
+	if (dir->_ep == NULL) return -1;
+
+	error = readdir_r(dir->_d, dir->_ep, &dir->_e);
+	if (error != 0) return -1;
+#endif
+	if (dir->_e == NULL)
+	{
+		dir->has_next = 0;
+	}
+#endif
+
+	return 0;
+
+bail:
+	tinydir_close(dir);
+	return -1;
+}
+
+_TINYDIR_FUNC
+int tinydir_open_sorted(tinydir_dir *dir, const _tinydir_char_t *path)
+{
+	/* Count the number of files first, to pre-allocate the files array */
+	size_t n_files = 0;
+	if (tinydir_open(dir, path) == -1)
+	{
+		return -1;
+	}
+	while (dir->has_next)
+	{
+		n_files++;
+		if (tinydir_next(dir) == -1)
+		{
+			goto bail;
+		}
+	}
+	tinydir_close(dir);
+
+	if (tinydir_open(dir, path) == -1)
+	{
+		return -1;
+	}
+
+	dir->n_files = 0;
+	dir->_files = (tinydir_file *)_TINYDIR_MALLOC(sizeof *dir->_files * n_files);
+	if (dir->_files == NULL)
+	{
+		goto bail;
+	}
+	while (dir->has_next)
+	{
+		tinydir_file *p_file;
+		dir->n_files++;
+
+		p_file = &dir->_files[dir->n_files - 1];
+		if (tinydir_readfile(dir, p_file) == -1)
+		{
+			goto bail;
+		}
+
+		if (tinydir_next(dir) == -1)
+		{
+			goto bail;
+		}
+
+		/* Just in case the number of files has changed between the first and
+		second reads, terminate without writing into unallocated memory */
+		if (dir->n_files == n_files)
+		{
+			break;
+		}
+	}
+
+	qsort(dir->_files, dir->n_files, sizeof(tinydir_file), _tinydir_file_cmp);
+
+	return 0;
+
+bail:
+	tinydir_close(dir);
+	return -1;
+}
+
+_TINYDIR_FUNC
+void tinydir_close(tinydir_dir *dir)
+{
+	if (dir == NULL)
+	{
+		return;
+	}
+
+	memset(dir->path, 0, sizeof(dir->path));
+	dir->has_next = 0;
+	dir->n_files = 0;
+	_TINYDIR_FREE(dir->_files);
+	dir->_files = NULL;
+#ifdef _MSC_VER
+	if (dir->_h != INVALID_HANDLE_VALUE)
+	{
+		FindClose(dir->_h);
+	}
+	dir->_h = INVALID_HANDLE_VALUE;
+#else
+	if (dir->_d)
+	{
+		_tinydir_closedir(dir->_d);
+	}
+	dir->_d = NULL;
+	dir->_e = NULL;
+#ifndef _TINYDIR_USE_READDIR
+	_TINYDIR_FREE(dir->_ep);
+	dir->_ep = NULL;
+#endif
+#endif
+}
+
+_TINYDIR_FUNC
+int tinydir_next(tinydir_dir *dir)
+{
+	if (dir == NULL)
+	{
+		errno = EINVAL;
+		return -1;
+	}
+	if (!dir->has_next)
+	{
+		errno = ENOENT;
+		return -1;
+	}
+
+#ifdef _MSC_VER
+	if (FindNextFile(dir->_h, &dir->_f) == 0)
+#else
+#ifdef _TINYDIR_USE_READDIR
+	dir->_e = _tinydir_readdir(dir->_d);
+#else
+	if (dir->_ep == NULL)
+	{
+		return -1;
+	}
+	if (readdir_r(dir->_d, dir->_ep, &dir->_e) != 0)
+	{
+		return -1;
+	}
+#endif
+	if (dir->_e == NULL)
+#endif
+	{
+		dir->has_next = 0;
+#ifdef _MSC_VER
+		if (GetLastError() != ERROR_SUCCESS &&
+			GetLastError() != ERROR_NO_MORE_FILES)
+		{
+			tinydir_close(dir);
+			errno = EIO;
+			return -1;
+		}
+#endif
+	}
+
+	return 0;
+}
+
+_TINYDIR_FUNC
+int tinydir_readfile(const tinydir_dir *dir, tinydir_file *file)
+{
+	if (dir == NULL || file == NULL)
+	{
+		errno = EINVAL;
+		return -1;
+	}
+#ifdef _MSC_VER
+	if (dir->_h == INVALID_HANDLE_VALUE)
+#else
+	if (dir->_e == NULL)
+#endif
+	{
+		errno = ENOENT;
+		return -1;
+	}
+	if (_tinydir_strlen(dir->path) +
+		_tinydir_strlen(
+#ifdef _MSC_VER
+			dir->_f.cFileName
+#else
+			dir->_e->d_name
+#endif
+		) + 1 + _TINYDIR_PATH_EXTRA >=
+		_TINYDIR_PATH_MAX)
+	{
+		/* the path for the file will be too long */
+		errno = ENAMETOOLONG;
+		return -1;
+	}
+	if (_tinydir_strlen(
+#ifdef _MSC_VER
+			dir->_f.cFileName
+#else
+			dir->_e->d_name
+#endif
+		) >= _TINYDIR_FILENAME_MAX)
+	{
+		errno = ENAMETOOLONG;
+		return -1;
+	}
+
+	_tinydir_strcpy(file->path, dir->path);
+	_tinydir_strcat(file->path, TINYDIR_STRING("/"));
+	_tinydir_strcpy(file->name,
+#ifdef _MSC_VER
+		dir->_f.cFileName
+#else
+		dir->_e->d_name
+#endif
+	);
+	_tinydir_strcat(file->path, file->name);
+#ifndef _MSC_VER
+#ifdef __MINGW32__
+	if (_tstat(
+#else
+	if (stat(
+#endif
+		file->path, &file->_s) == -1)
+	{
+		return -1;
+	}
+#endif
+	_tinydir_get_ext(file);
+
+	file->is_dir =
+#ifdef _MSC_VER
+		!!(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY);
+#else
+		S_ISDIR(file->_s.st_mode);
+#endif
+	file->is_reg =
+#ifdef _MSC_VER
+		!!(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_NORMAL) ||
+		(
+			!(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_DEVICE) &&
+			!(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) &&
+			!(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_ENCRYPTED) &&
+#ifdef FILE_ATTRIBUTE_INTEGRITY_STREAM
+			!(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_INTEGRITY_STREAM) &&
+#endif
+#ifdef FILE_ATTRIBUTE_NO_SCRUB_DATA
+			!(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_NO_SCRUB_DATA) &&
+#endif
+			!(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_OFFLINE) &&
+			!(dir->_f.dwFileAttributes & FILE_ATTRIBUTE_TEMPORARY));
+#else
+		S_ISREG(file->_s.st_mode);
+#endif
+
+	return 0;
+}
+
+_TINYDIR_FUNC
+int tinydir_readfile_n(const tinydir_dir *dir, tinydir_file *file, size_t i)
+{
+	if (dir == NULL || file == NULL)
+	{
+		errno = EINVAL;
+		return -1;
+	}
+	if (i >= dir->n_files)
+	{
+		errno = ENOENT;
+		return -1;
+	}
+
+	memcpy(file, &dir->_files[i], sizeof(tinydir_file));
+	_tinydir_get_ext(file);
+
+	return 0;
+}
+
+_TINYDIR_FUNC
+int tinydir_open_subdir_n(tinydir_dir *dir, size_t i)
+{
+	_tinydir_char_t path[_TINYDIR_PATH_MAX];
+	if (dir == NULL)
+	{
+		errno = EINVAL;
+		return -1;
+	}
+	if (i >= dir->n_files || !dir->_files[i].is_dir)
+	{
+		errno = ENOENT;
+		return -1;
+	}
+
+	_tinydir_strcpy(path, dir->_files[i].path);
+	tinydir_close(dir);
+	if (tinydir_open_sorted(dir, path) == -1)
+	{
+		return -1;
+	}
+
+	return 0;
+}
+
+/* Open a single file given its path */
+_TINYDIR_FUNC
+int tinydir_file_open(tinydir_file *file, const _tinydir_char_t *path)
+{
+	tinydir_dir dir;
+	int result = 0;
+	int found = 0;
+	_tinydir_char_t dir_name_buf[_TINYDIR_PATH_MAX];
+	_tinydir_char_t file_name_buf[_TINYDIR_FILENAME_MAX];
+	_tinydir_char_t *dir_name;
+	_tinydir_char_t *base_name;
+#if (defined _MSC_VER || defined __MINGW32__)
+	_tinydir_char_t drive_buf[_TINYDIR_PATH_MAX];
+	_tinydir_char_t ext_buf[_TINYDIR_FILENAME_MAX];
+#endif
+
+	if (file == NULL || path == NULL || _tinydir_strlen(path) == 0)
+	{
+		errno = EINVAL;
+		return -1;
+	}
+	if (_tinydir_strlen(path) + _TINYDIR_PATH_EXTRA >= _TINYDIR_PATH_MAX)
+	{
+		errno = ENAMETOOLONG;
+		return -1;
+	}
+
+	/* Get the parent path */
+#if (defined _MSC_VER || defined __MINGW32__)
+#if ((defined _MSC_VER) && (_MSC_VER >= 1400))
+		_tsplitpath_s(
+			path,
+			drive_buf, _TINYDIR_DRIVE_MAX,
+			dir_name_buf, _TINYDIR_FILENAME_MAX,
+			file_name_buf, _TINYDIR_FILENAME_MAX,
+			ext_buf, _TINYDIR_FILENAME_MAX);
+#else
+		_tsplitpath(
+			path,
+			drive_buf,
+			dir_name_buf,
+			file_name_buf,
+			ext_buf);
+#endif
+
+/* _splitpath_s not work fine with only filename and widechar support */
+#ifdef _UNICODE
+		if (drive_buf[0] == L'\xFEFE')
+			drive_buf[0] = '\0';
+		if (dir_name_buf[0] == L'\xFEFE')
+			dir_name_buf[0] = '\0';
+#endif
+
+	if (errno)
+	{
+		errno = EINVAL;
+		return -1;
+	}
+	/* Emulate the behavior of dirname by returning "." for dir name if it's
+	empty */
+	if (drive_buf[0] == '\0' && dir_name_buf[0] == '\0')
+	{
+		_tinydir_strcpy(dir_name_buf, TINYDIR_STRING("."));
+	}
+	/* Concatenate the drive letter and dir name to form full dir name */
+	_tinydir_strcat(drive_buf, dir_name_buf);
+	dir_name = drive_buf;
+	/* Concatenate the file name and extension to form base name */
+	_tinydir_strcat(file_name_buf, ext_buf);
+	base_name = file_name_buf;
+#else
+	_tinydir_strcpy(dir_name_buf, path);
+	dir_name = dirname(dir_name_buf);
+	_tinydir_strcpy(file_name_buf, path);
+	base_name =basename(file_name_buf);
+#endif
+
+	/* Open the parent directory */
+	if (tinydir_open(&dir, dir_name) == -1)
+	{
+		return -1;
+	}
+
+	/* Read through the parent directory and look for the file */
+	while (dir.has_next)
+	{
+		if (tinydir_readfile(&dir, file) == -1)
+		{
+			result = -1;
+			goto bail;
+		}
+		if (_tinydir_strcmp(file->name, base_name) == 0)
+		{
+			/* File found */
+			found = 1;
+			break;
+		}
+		tinydir_next(&dir);
+	}
+	if (!found)
+	{
+		result = -1;
+		errno = ENOENT;
+	}
+
+bail:
+	tinydir_close(&dir);
+	return result;
+}
+
+_TINYDIR_FUNC
+void _tinydir_get_ext(tinydir_file *file)
+{
+	_tinydir_char_t *period = _tinydir_strrchr(file->name, TINYDIR_STRING('.'));
+	if (period == NULL)
+	{
+		file->extension = &(file->name[_tinydir_strlen(file->name)]);
+	}
+	else
+	{
+		file->extension = period + 1;
+	}
+}
+
+_TINYDIR_FUNC
+int _tinydir_file_cmp(const void *a, const void *b)
+{
+	const tinydir_file *fa = (const tinydir_file *)a;
+	const tinydir_file *fb = (const tinydir_file *)b;
+	if (fa->is_dir != fb->is_dir)
+	{
+		return -(fa->is_dir - fb->is_dir);
+	}
+	return _tinydir_strncmp(fa->name, fb->name, _TINYDIR_FILENAME_MAX);
+}
+
+#ifndef _MSC_VER
+#ifndef _TINYDIR_USE_READDIR
+/*
+The following authored by Ben Hutchings <ben@decadent.org.uk>
+from https://womble.decadent.org.uk/readdir_r-advisory.html
+*/
+/* Calculate the required buffer size (in bytes) for directory      *
+* entries read from the given directory handle.  Return -1 if this  *
+* this cannot be done.                                              *
+*                                                                   *
+* This code does not trust values of NAME_MAX that are less than    *
+* 255, since some systems (including at least HP-UX) incorrectly    *
+* define it to be a smaller value.                                  */
+_TINYDIR_FUNC
+size_t _tinydir_dirent_buf_size(_TINYDIR_DIR *dirp)
+{
+	long name_max;
+	size_t name_end;
+	/* parameter may be unused */
+	(void)dirp;
+
+#if defined _TINYDIR_USE_FPATHCONF
+	name_max = fpathconf(dirfd(dirp), _PC_NAME_MAX);
+	if (name_max == -1)
+#if defined(NAME_MAX)
+		name_max = (NAME_MAX > 255) ? NAME_MAX : 255;
+#else
+		return (size_t)(-1);
+#endif
+#elif defined(NAME_MAX)
+ 	name_max = (NAME_MAX > 255) ? NAME_MAX : 255;
+#else
+#error "buffer size for readdir_r cannot be determined"
+#endif
+	name_end = (size_t)offsetof(struct _tinydir_dirent, d_name) + name_max + 1;
+	return (name_end > sizeof(struct _tinydir_dirent) ?
+		name_end : sizeof(struct _tinydir_dirent));
+}
+#endif
+#endif
+
+#ifdef __cplusplus
+}
+#endif
+
+# if defined (_MSC_VER)
+# pragma warning(pop)
+# endif
+
+#endif
diff --git a/compat/zlib/win32/zdll.lib b/compat/zlib/win32/zdll.lib
index a3e9a39..a3e9a39 100755..100644
--- a/compat/zlib/win32/zdll.lib
+++ b/compat/zlib/win32/zdll.lib
diff --git a/doc/CrtObjCmd.3 b/doc/CrtObjCmd.3
index 6714bd7..87ce07e 100644
--- a/doc/CrtObjCmd.3
+++ b/doc/CrtObjCmd.3
@@ -8,7 +8,7 @@
 .so man.macros
 .BS
 .SH NAME
-Tcl_CreateObjCommand, Tcl_DeleteCommand, Tcl_DeleteCommandFromToken, Tcl_GetCommandInfo, Tcl_GetCommandInfoFromToken, Tcl_SetCommandInfo, Tcl_SetCommandInfoFromToken, Tcl_GetCommandName, Tcl_GetCommandFullName, Tcl_GetCommandFromObj \- implement new commands in C
+Tcl_CreateObjCommand, Tcl_DeleteCommand, Tcl_DeleteCommandFromToken, Tcl_GetCommandInfo, Tcl_GetCommandInfoFromToken, Tcl_SetCommandInfo, Tcl_SetCommandInfoFromToken, Tcl_GetCommandName, Tcl_GetCommandFullName, Tcl_GetCommandFromObj Tcl_RegisterCommandTypeName, Tcl_GetCommandTypeName \- implement new commands in C
 .SH SYNOPSIS
 .nf
 \fB#include <tcl.h>\fR
@@ -42,6 +42,14 @@ void
 .sp
 Tcl_Command
 \fBTcl_GetCommandFromObj\fR(\fIinterp, objPtr\fR)
+.sp
+.VS "info cmdtype feature"
+void
+\fBTcl_RegisterCommandTypeName\fR(\fIproc, typeName\fR)
+.sp
+const char *
+\fBTcl_GetCommandTypeName\fR(\fItoken\fR)
+.VE "info cmdtype feature"
 .SH ARGUMENTS
 .AS Tcl_CmdDeleteProc *deleteProc in/out
 .AP Tcl_Interp *interp in
@@ -65,6 +73,9 @@ Pointer to structure containing various information about a
 Tcl command.
 .AP Tcl_Obj *objPtr in
 Value containing the name of a Tcl command.
+.AP "const char" *typeName in
+Indicates the name of the type of command implementation associated
+with a particular \fIproc\fR, or NULL to break the association.
 .BE
 .SH DESCRIPTION
 .PP
@@ -296,6 +307,22 @@ is appended to the value specified by \fIobjPtr\fR.
 specified by the name in a \fBTcl_Obj\fR.
 The command name is resolved relative to the current namespace.
 Returns NULL if the command is not found.
+.PP
+.VS "info cmdtype feature"
+\fBTcl_RegisterCommandTypeName\fR is used to associate a name (the
+\fItypeName\fR argument) with a particular implementation function so that it
+can then be looked up with \fBTcl_GetCommandTypeName\fR, which in turn is
+called with a command token that information is wanted for and which returns
+the name of the type that was registered for the implementation function used
+for that command. (The lookup functionality is surfaced virtually directly in Tcl via
+\fBinfo cmdtype\fR.) If there is no function registered for a particular
+function, the result will be the string literal
+.QW \fBnative\fR .
+The registration of a name can be undone by registering a mapping to NULL
+instead. The result from \fBTcl_GetCommandTypeName\fR will be exactly that
+string which was registered, and not a copy; use of a compile-time constant
+string is \fIstrongly recommended\fR.
+.VE "info cmdtype feature"
 .SH "SEE ALSO"
 Tcl_CreateCommand(3), Tcl_ResetResult(3), Tcl_SetObjResult(3)
 .SH KEYWORDS
diff --git a/doc/NRE.3 b/doc/NRE.3
index 6078a53..6024b6a 100644
--- a/doc/NRE.3
+++ b/doc/NRE.3
@@ -1,6 +1,6 @@
 .\"
 .\" Copyright (c) 2008 by Kevin B. Kenny.
-.\" Copyright (c) 2018 by Nathan Coulter. 
+.\" Copyright (c) 2018 by Nathan Coulter.
 .\"
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
diff --git a/doc/SaveResult.3 b/doc/SaveResult.3
index 6dd6cb6..e62d22d 100644
--- a/doc/SaveResult.3
+++ b/doc/SaveResult.3
@@ -1,6 +1,7 @@
 '\"
 '\" Copyright (c) 1997 by Sun Microsystems, Inc.
 '\" Contributions from Don Porter, NIST, 2004. (not subject to US copyright)
+'\" Copyright (c) 2018 Nathan Coulter.
 '\"
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -9,7 +10,9 @@
 .so man.macros
 .BS
 .SH NAME
-Tcl_SaveInterpState, Tcl_RestoreInterpState, Tcl_DiscardInterpState, Tcl_SaveResult, Tcl_RestoreResult, Tcl_DiscardResult \- save and restore an interpreter's state
+Tcl_SaveInterpState, Tcl_RestoreInterpState, Tcl_DiscardInterpState,
+Tcl_SaveResult, Tcl_RestoreResult, Tcl_DiscardResult \- Save and restore the
+state of an an interpreter.
 .SH SYNOPSIS
 .nf
 \fB#include <tcl.h>\fR
@@ -30,91 +33,53 @@ int
 .SH ARGUMENTS
 .AS Tcl_InterpState savedPtr
 .AP Tcl_Interp *interp in
-Interpreter for which state should be saved.
+The interpreter for the operation.
 .AP int status in
-Return code value to save as part of interpreter state.
+The return code for the state.
 .AP Tcl_InterpState state in
-Saved state token to be restored or discarded.
+A token for saved state.
 .AP Tcl_SavedResult *savedPtr in
-Pointer to location where interpreter result should be saved or restored.
+A pointer to storage for saved state.
 .BE
 .SH DESCRIPTION
 .PP
-These routines allows a C procedure to take a snapshot of the current
-state of an interpreter so that it can be restored after a call
-to \fBTcl_Eval\fR or some other routine that modifies the interpreter
-state.  There are two triplets of routines meant to work together.
+These routines save the state of an interpreter before a call to a routine such
+as \fBTcl_Eval\fR, and restore the state afterwards.
 .PP
-The first triplet stores the snapshot of interpreter state in
-an opaque token returned by \fBTcl_SaveInterpState\fR.  That token
-value may then be passed back to one of \fBTcl_RestoreInterpState\fR
-or \fBTcl_DiscardInterpState\fR, depending on whether the interp
-state is to be restored.  So long as one of the latter two routines
-is called, Tcl will take care of memory management.
+\fBTcl_SaveInterpState\fR saves the parts of \fIinterp\fR that comprise the
+result of a script, including the resulting value, the return code passed as
+\fIstatus\fR, and any options such as \fB\-errorinfo\fR and \fB\-errorcode\fR.
+It returns a token for the saved state.  The interpreter result is not reset
+and no interpreter state is changed.
 .PP
-The second triplet stores the snapshot of only the interpreter
-result (not its complete state) in memory allocated by the caller.
-These routines are passed a pointer to \fBTcl_SavedResult\fR
-that is used to store enough information to restore the interpreter result.
-\fBTcl_SavedResult\fR can be allocated on the stack of the calling
-procedure.  These routines do not save the state of any error
-information in the interpreter (e.g. the \fB\-errorcode\fR or
-\fB\-errorinfo\fR return options, when an error is in progress).
+\fBTcl_RestoreInterpState\fR restores the state indicated by \fIstate\fR and
+returns the \fIstatus\fR originally passed in the corresponding call to
+\fBTcl_SaveInterpState\fR.
 .PP
-Because the routines \fBTcl_SaveInterpState\fR,
-\fBTcl_RestoreInterpState\fR, and \fBTcl_DiscardInterpState\fR perform
-a superset of the functions provided by the other routines,
-any new code should only make use of the more powerful routines.
-The older, weaker routines \fBTcl_SaveResult\fR, \fBTcl_RestoreResult\fR,
-and \fBTcl_DiscardResult\fR continue to exist only for the sake
-of existing programs that may already be using them.
+If a saved state is not restored, \fBTcl_DiscardInterpState\fR must be called
+to release it.  A token used to discard or restore state must not be used
+again.
 .PP
-\fBTcl_SaveInterpState\fR takes a snapshot of those portions of
-interpreter state that make up the full result of script evaluation.
-This include the interpreter result, the return code (passed in
-as the \fIstatus\fR argument, and any return options, including
-\fB\-errorinfo\fR and \fB\-errorcode\fR when an error is in progress.
-This snapshot is returned as an opaque token of type \fBTcl_InterpState\fR.
-The call to \fBTcl_SaveInterpState\fR does not itself change the
-state of the interpreter.  Unlike \fBTcl_SaveResult\fR, it does
-not reset the interpreter.
+\fBTcl_SaveResult\fR, \fBTcl_RestoreResult\fR, and \fBTcl_DiscardResult\fR are
+deprecated.  Instead use \fBTcl_SaveInterpState\fR,
+\fBTcl_RestoreInterpState\fR, and \fBTcl_DiscardInterpState\fR, which are more
+capable.
 .PP
-\fBTcl_RestoreInterpState\fR accepts a \fBTcl_InterpState\fR token
-previously returned by \fBTcl_SaveInterpState\fR and restores the
-state of the interp to the state held in that snapshot.  The return
-value of \fBTcl_RestoreInterpState\fR is the status value originally
-passed to \fBTcl_SaveInterpState\fR when the snapshot token was
-created.
+\fBTcl_SaveResult\fR moves the result of \fIinterp\fR to the location
+\fIstatePtr\fR points to and returns the interpreter result to its initial
+state.  It does not save options such as \fB\-errorcode\fR or
+\fB\-errorinfo\fR.
 .PP
-\fBTcl_DiscardInterpState\fR is called to release a \fBTcl_InterpState\fR
-token previously returned by \fBTcl_SaveInterpState\fR when that
-snapshot is not to be restored to an interp.
-.PP
-The \fBTcl_InterpState\fR token returned by \fBTcl_SaveInterpState\fR
-must eventually be passed to either \fBTcl_RestoreInterpState\fR
-or \fBTcl_DiscardInterpState\fR to avoid a memory leak.  Once
-the \fBTcl_InterpState\fR token is passed to one of them, the
-token is no longer valid and should not be used anymore.
-.PP
-\fBTcl_SaveResult\fR moves the string and value results
-of \fIinterp\fR into the location specified by \fIstatePtr\fR.
-\fBTcl_SaveResult\fR clears the result for \fIinterp\fR and
-leaves the result in its normal empty initialized state.
-.PP
-\fBTcl_RestoreResult\fR moves the string and value results from
-\fIstatePtr\fR back into \fIinterp\fR.  Any result or error that was
-already in the interpreter will be cleared.  The \fIstatePtr\fR is left
-in an uninitialized state and cannot be used until another call to
+\fBTcl_RestoreResult\fR clears any existing result or error in \fIinterp\fR and
+moves the result from \fIstatePtr\fR back to \fIinterp\fR.  \fIstatePtr\fR is
+then in an undefined state and must not be used until passed again to
 \fBTcl_SaveResult\fR.
 .PP
-\fBTcl_DiscardResult\fR releases the saved interpreter state
-stored at \fBstatePtr\fR.  The state structure is left in an
-uninitialized state and cannot be used until another call to
+\fBTcl_DiscardResult\fR releases the state stored at \fBstatePtr\fR, which is
+then in an undefined state and must not be used until passed again to
 \fBTcl_SaveResult\fR.
 .PP
-Once \fBTcl_SaveResult\fR is called to save the interpreter
-result, either \fBTcl_RestoreResult\fR or
-\fBTcl_DiscardResult\fR must be called to properly clean up the
-memory associated with the saved state.
+If a saved result is not restored, \fBTcl_DiscardResult\fR must be called to
+release it.
 .SH KEYWORDS
 result, state, interp
diff --git a/doc/Utf.3 b/doc/Utf.3
index 78d795e..922fd81 100644
--- a/doc/Utf.3
+++ b/doc/Utf.3
@@ -121,8 +121,8 @@ case-insensitive (1).
 
 .SH DESCRIPTION
 .PP
-These routines convert between UTF-8 strings and Tcl_UniChars.  A
-Tcl_UniChar is a Unicode character represented as an unsigned, fixed-size
+These routines convert between UTF-8 strings and Unicode characters.  An
+Unicode character represented as an unsigned, fixed-size
 quantity.  A UTF-8 character is a Unicode character represented as
 a varying-length sequence of up to \fBTCL_UTF_MAX\fR bytes.  A multibyte UTF-8
 sequence consists of a lead byte followed by some number of trail bytes.
@@ -130,9 +130,12 @@ sequence consists of a lead byte followed by some number of trail bytes.
 \fBTCL_UTF_MAX\fR is the maximum number of bytes that it takes to
 represent one Unicode character in the UTF-8 representation.
 .PP
-\fBTcl_UniCharToUtf\fR stores the Tcl_UniChar \fIch\fR as a UTF-8 string
+\fBTcl_UniCharToUtf\fR stores the character \fIch\fR as a UTF-8 string
 in starting at \fIbuf\fR.  The return value is the number of bytes stored
-in \fIbuf\fR.
+in \fIbuf\fR. If ch is an upper surrogate (range U+D800 - U+DBFF), then
+the return value will be 0 and nothing will be stored. If you still
+want to produce UTF-8 output for it (even though knowing it's an illegal
+code-point on its own), just call \fBTcl_UniCharToUtf\fR again using ch = -1.
 .PP
 \fBTcl_UtfToUniChar\fR reads one UTF-8 character starting at \fIsrc\fR
 and stores it as a Tcl_UniChar in \fI*chPtr\fR.  The return value is the
@@ -203,7 +206,7 @@ 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 Tcl_UniChar has been seen.
+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
@@ -211,12 +214,12 @@ returns the number of Tcl_UniChars that are represented by the UTF-8 string
 length is negative, all bytes up to the first null byte are used.
 .PP
 \fBTcl_UtfFindFirst\fR corresponds to \fBstrchr\fR for UTF-8 strings.  It
-returns a pointer to the first occurrence of the Tcl_UniChar \fIch\fR
+returns a pointer to the first occurrence of the Unicode character \fIch\fR
 in the null-terminated UTF-8 string \fIsrc\fR.  The null terminator is
 considered part of the UTF-8 string.
 .PP
 \fBTcl_UtfFindLast\fR corresponds to \fBstrrchr\fR for UTF-8 strings.  It
-returns a pointer to the last occurrence of the Tcl_UniChar \fIch\fR
+returns a pointer to the last occurrence of the Unicode character \fIch\fR
 in the null-terminated UTF-8 string \fIsrc\fR.  The null terminator is
 considered part of the UTF-8 string.
 .PP
diff --git a/doc/abstract.n b/doc/abstract.n
new file mode 100644
index 0000000..022c24b
--- /dev/null
+++ b/doc/abstract.n
@@ -0,0 +1,77 @@
+'\"
+'\" Copyright (c) 2018 Donal K. Fellows
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.TH abstract n 0.3 TclOO "TclOO Commands"
+.so man.macros
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+oo::abstract \- a class that does not allow direct instances of itself
+.SH SYNOPSIS
+.nf
+package require TclOO
+
+\fBoo::abstract\fI method \fR?\fIarg ...\fR?
+.fi
+.SH "CLASS HIERARCHY"
+.nf
+\fBoo::object\fR
+   \(-> \fBoo::class\fR
+       \(-> \fBoo::abstract\fR
+.fi
+.BE
+.SH DESCRIPTION
+Abstract classes are classes that can contain definitions, but which cannot be
+directly manufactured; they are intended to only ever be inherited from and
+instantiated indirectly. The characteristic methods of \fBoo::class\fR
+(\fBcreate\fR and \fBnew\fR) are not exported by an instance of
+\fBoo::abstract\fR.
+.PP
+Note that \fBoo::abstract\fR is not itself an instance of \fBoo::abstract\fR.
+.SS CONSTRUCTOR
+The \fBoo::abstract\fR class does not define an explicit constructor; this
+means that it is effectively the same as the constructor of the
+\fBoo::class\fR class.
+.SS DESTRUCTOR
+The \fBoo::abstract\fR class does not define an explicit destructor;
+destroying an instance of it is just like destroying an ordinary class (and
+will destroy all its subclasses).
+.SS "EXPORTED METHODS"
+The \fBoo::abstract\fR class defines no new exported methods.
+.SS "NON-EXPORTED METHODS"
+The \fBoo::abstract\fR class explicitly states that \fBcreate\fR,
+\fBcreateWithNamespace\fR, and \fBnew\fR are unexported.
+.SH EXAMPLES
+.PP
+This example defines a simple class hierarchy and creates a new instance of
+it. It then invokes a method of the object before destroying the hierarchy and
+showing that the destruction is transitive.
+.PP
+.CS
+\fBoo::abstract\fR create fruit {
+    method eat {} {
+        puts "yummy!"
+    }
+}
+oo::class create banana {
+    superclass fruit
+    method peel {} {
+        puts "skin now off"
+    }
+}
+set b [banana \fBnew\fR]
+$b peel              \fI\(-> prints 'skin now off'\fR
+$b eat               \fI\(-> prints 'yummy!'\fR
+set f [fruit new]    \fI\(-> error 'unknown method "new"...'\fR
+.CE
+.SH "SEE ALSO"
+oo::define(n), oo::object(n)
+.SH KEYWORDS
+abstract class, class, metaclass, object
+.\" Local variables:
+.\" mode: nroff
+.\" fill-column: 78
+.\" End:
diff --git a/doc/append.n b/doc/append.n
index e3bf224..99b4ece 100644
--- a/doc/append.n
+++ b/doc/append.n
@@ -20,6 +20,11 @@ Append all of the \fIvalue\fR arguments to the current value
 of variable \fIvarName\fR.  If \fIvarName\fR does not exist,
 it is given a value equal to the concatenation of all the
 \fIvalue\fR arguments.
+.VS TIP508
+If \fIvarName\fR indicate an element that does not exist of an array that has
+a default value set, the concatenation of the default value and all the
+\fIvalue\fR arguments will be stored in the array element.
+.VE TIP508
 The result of this command is the new value stored in variable
 \fIvarName\fR.
 This command provides an efficient way to build up long
@@ -44,6 +49,7 @@ puts $var
 concat(n), lappend(n)
 .SH KEYWORDS
 append, variable
-'\" Local Variables:
-'\" mode: nroff
-'\" End:
+.\" Local variables:
+.\" mode: nroff
+.\" fill-column: 78
+.\" End:
diff --git a/doc/array.n b/doc/array.n
index d6d4dff..bbfcd9f 100644
--- a/doc/array.n
+++ b/doc/array.n
@@ -5,7 +5,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\"
-.TH array n 8.3 Tcl "Tcl Built-In Commands"
+.TH array n 8.7 Tcl "Tcl Built-In Commands"
 .so man.macros
 .BS
 '\" Note:  do not modify the .SH NAME line immediately below!
@@ -36,6 +36,53 @@ with an empty name, since the return value from
 \fBarray nextelement\fR will not indicate whether the search
 has been completed.
 .TP
+\fBarray default \fIsubcommand arrayName args...\fR
+.VS TIP508
+Manages the default value of the array. Arrays initially have no default
+value, but this command allows you to set one; the default value will be
+returned when reading from an element of the array \farrayName\fR if the read
+would otherwise result in an error. Note that this may cause the \fBappend\fR,
+\fBdict\fR, \fBincr\fR and \fBlappend\fR commands to change their behavior in
+relation to non-existing array elements.
+.RS
+.PP
+The \fIsubcommand\fR argument controls what exact operation will be performed
+on the default value of \fIarrayName\fR. Supported \fIsubcommand\fRs are:
+.VE TIP508
+.TP
+\fBarray default exists \fIarrayName\fR
+.VS TIP508
+This returns a boolean value indicating whether a default value has been set
+for the array \fIarrayName\fR. Returns a false value if \fIarrayName\fR does
+not exist. Raises an error if \fIarrayName\fR is an existing variable that is
+not an array.
+.VE TIP508
+.TP
+\fBarray default get \fIarrayName\fR
+.VS TIP508
+This returns the current default value for the array \fIarrayName\fR.  Raises
+an error if \fIarrayName\fR is an existing variable that is not an array, or
+if \fIarrayName\fR is an array without a default value.
+.VE TIP508
+.TP
+\fBarray default set \fIarrayName value\fR
+.VS TIP508
+This sets the default value for the array \fIarrayName\fR to \fIvalue\fR.
+Returns the empty string. Raises an error if \fIarrayName\fR is an existing
+variable that is not an array, or if \fIarrayName\fR is an illegal name for an
+array. If \fIarrayName\fR does not currently exist, it is created as an empty
+array as well as having its default value set.
+.VE TIP508
+.TP
+\fBarray default unset \fIarrayName\fR
+.VS TIP508
+This removes the default value for the array \fIarrayName\fR and returns the
+empty string. Does nothing if \fIarrayName\fR does not have a default
+value. Raises an error if \fIarrayName\fR is an existing variable that is not
+an array.
+.VE TIP508
+.RE
+.TP
 \fBarray donesearch \fIarrayName searchId\fR
 This command terminates an array search and destroys all the
 state associated with that search.  \fISearchId\fR indicates
@@ -194,3 +241,7 @@ foreach color [lsort [\fBarray names\fR colorcount]] {
 list(n), string(n), variable(n), trace(n), foreach(n)
 .SH KEYWORDS
 array, element names, search
+.\" Local variables:
+.\" mode: nroff
+.\" fill-column: 78
+.\" End:
diff --git a/doc/callback.n b/doc/callback.n
new file mode 100644
index 0000000..95838a9
--- /dev/null
+++ b/doc/callback.n
@@ -0,0 +1,88 @@
+'\"
+'\" Copyright (c) 2018 Donal K. Fellows
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.TH callback n 0.3 TclOO "TclOO Commands"
+.so man.macros
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+callback, mymethod \- generate callbacks to methods
+.SH SYNOPSIS
+.nf
+package require TclOO
+
+\fBcallback\fR \fImethodName\fR ?\fIarg ...\fR?
+\fBmymethod\fR \fImethodName\fR ?\fIarg ...\fR?
+.fi
+.BE
+.SH DESCRIPTION
+The \fBcallback\fR command,
+'\" Based on notes in the tcllib docs, we know the provenance of mymethod
+also called \fBmymethod\fR for compatibility with the ooutil and snit packages
+of Tcllib,
+and which should only be used from within the context of a call to a method
+(i.e. inside a method, constructor or destructor body) is used to generate a
+script fragment that will invoke the method, \fImethodName\fR, on the current
+object (as reported by \fBself\fR) when executed. Any additional arguments
+provided will be provided as leading arguments to the callback. The resulting
+script fragment shall be a proper list.
+.PP
+Note that it is up to the caller to ensure that the current object is able to
+handle the call of \fImethodName\fR; this command does not check that.
+\fImethodName\fR may refer to any exported or unexported method, but may not
+refer to a private method as those can only be invoked directly from within
+methods. If there is no such method present at the point when the callback is
+invoked, the standard \fBunknown\fR method handler will be called.
+.SH EXAMPLE
+This is a simple echo server class. The \fBcallback\fR command is used in two
+places, to arrange for the incoming socket connections to be handled by the
+\fIAccept\fR method, and to arrange for the incoming bytes on those
+connections to be handled by the \fIReceive\fR method.
+.PP
+.CS
+oo::class create EchoServer {
+    variable server clients
+    constructor {port} {
+        set server [socket -server [\fBcallback\fR Accept] $port]
+        set clients {}
+    }
+    destructor {
+        chan close $server
+        foreach client [dict keys $clients] {
+            chan close $client
+        }
+    }
+
+    method Accept {channel clientAddress clientPort} {
+        dict set clients $channel [dict create \e
+                address $clientAddress port $clientPort]
+        chan event $channel readable [\fBcallback\fR Receive $channel]
+    }
+    method Receive {channel} {
+        if {[chan gets $channel line] >= 0} {
+            my echo $channel $line
+        } else {
+            chan close $channel
+            dict unset clients $channel
+        }
+    }
+
+    method echo {channel line} {
+        dict with clients $channel {
+            chan puts $channel \e
+                    [format {[%s:%d] %s} $address $port $line]
+        }
+    }
+}
+.CE
+.SH "SEE ALSO"
+chan(n), fileevent(n), my(n), self(n), socket(n), trace(n)
+.SH KEYWORDS
+callback, object
+.\" Local Variables:
+.\" mode: nroff
+.\" fill-column: 78
+.\" End:
diff --git a/doc/classvariable.n b/doc/classvariable.n
new file mode 100644
index 0000000..0798bb2
--- /dev/null
+++ b/doc/classvariable.n
@@ -0,0 +1,78 @@
+'\"
+'\" Copyright (c) 2011-2015 Andreas Kupries
+'\" Copyright (c) 2018 Donal K. Fellows
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.TH classvariable n 0.3 TclOO "TclOO Commands"
+.so man.macros
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+classvariable \- create link from local variable to variable in class
+.SH SYNOPSIS
+.nf
+package require TclOO
+
+\fBclassvariable\fR \fIvariableName\fR ?\fI...\fR?
+.fi
+.BE
+.SH DESCRIPTION
+The \fBclassvariable\fR command is available within methods. It takes a series
+of one or more variable names and makes them available in the method's scope;
+those variable names must not be qualified and must not refer to array
+elements. The originating scope for the variables is the namespace of the
+class that the method was defined by. In other words, the referenced variables
+are shared between all instances of that class.
+.PP
+Note: This command is equivalent to the command \fBtypevariable\fR provided by
+the snit package in tcllib for approximately the same purpose. If used in a
+method defined directly on a class instance (e.g., through the
+\fBoo::objdefine\fR \fBmethod\fR definition) this is very much like just
+using:
+.PP
+.CS
+namespace upvar [namespace current] $var $var
+.CE
+.PP
+for each variable listed to \fBclassvariable\fR.
+.SH EXAMPLE
+This class counts how many instances of it have been made.
+.PP
+.CS
+oo::class create Counted {
+    initialise {
+        variable count 0
+    }
+
+    variable number
+    constructor {} {
+        \fBclassvariable\fR count
+        set number [incr count]
+    }
+
+    method report {} {
+        \fBclassvariable\fR count
+        puts "This is instance $number of $count"
+    }
+}
+
+set a [Counted new]
+set b [Counted new]
+$a report
+        \fI\(-> This is instance 1 of 2\fR
+set c [Counted new]
+$b report
+        \fI\(-> This is instance 2 of 3\fR
+$c report
+        \fI\(-> This is instance 3 of 3\fR
+.CE
+.SH "SEE ALSO"
+global(n), namespace(n), oo::class(n), oo::define(n), upvar(n), variable(n)
+.SH KEYWORDS
+class, class variable, variable
+.\" Local Variables:
+.\" mode: nroff
+.\" fill-column: 78
+.\" End:
diff --git a/doc/clock.n b/doc/clock.n
index ac50e36..e8fb8f7 100644
--- a/doc/clock.n
+++ b/doc/clock.n
@@ -452,6 +452,19 @@ If this situation occurs, the first occurrence of the time is chosen.
 (For this reason, it is wise to have the input string contain the
 time zone when converting local times.  This caveat does not apply to
 UTC times.)
+.PP
+If the interpretation of the groups yields an impossible time because
+a field is out of range, enough of that field's unit will be added to
+or subtracted from the time to bring it in range. Thus, if attempting to
+scan or format day 0 of the month, one day will be subtracted from day
+1 of the month, yielding the last day of the previous month.
+.PP
+If the interpretation of the groups yields an impossible time because
+a Daylight Saving Time change skips over that time, or an ambiguous
+time because a Daylight Saving Time change skips back so that the clock
+observes the given time twice, and no time zone specifier (\fB%z\fR
+or \fB%Z\fR) is present in the format, the time is interpreted as
+if the clock had not changed.
 .SH "FORMAT GROUPS"
 .PP
 The following format groups are recognized by the \fBclock scan\fR and
diff --git a/doc/define.n b/doc/define.n
index b489e5f..883d5fa 100644
--- a/doc/define.n
+++ b/doc/define.n
@@ -1,5 +1,5 @@
 '\"
-'\" Copyright (c) 2007 Donal K. Fellows
+'\" Copyright (c) 2007-2018 Donal K. Fellows
 '\"
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -39,6 +39,27 @@ used as the \fIdefScript\fR argument.
 The following commands are supported in the \fIdefScript\fR for
 \fBoo::define\fR, each of which may also be used in the \fIsubcommand\fR form:
 .TP
+\fBclassmethod\fI name\fR ?\fIargList bodyScrip\fR?
+.VS TIP478
+This creates a class method, or (if \fIargList\fR and \fIbodyScript\fR are
+omitted) promotes an existing method on the class object to be a class
+method. The \fIname\fR, \fIargList\fR and \fIbodyScript\fR arguments are as in
+the \fBmethod\fR definition, below.
+.RS
+.PP
+Class methods can be called on either the class itself or on the instances of
+that class. When they are called, the current object (see the \fBself\R and
+\fBmy\fR commands) is the class on which they are called or the class of the
+instance on which they are called, depending on whether they are called on the
+class or an instance of the class, respectively. If called on a subclass or
+instance of the subclass, the current object is the subclass.
+.PP
+In a private definition context, the methods as invoked on classes are
+\fInot\fR private, but the methods as invoked on instances of classes are
+private.
+.RE
+.VE TIP478
+.TP
 \fBconstructor\fI argList bodyScript\fR
 .
 This creates or updates the constructor for a class. The formal arguments to
@@ -110,6 +131,15 @@ below), this command creates private forwarded methods.
 .VE TIP500
 .RE
 .TP
+\fBinitialise\fI script\fR
+.TP
+\fBinitialize\fI script\fR
+.VS TIP478
+This evaluates \fIscript\fR in a context which supports local variables and
+where the current namespace is the instance namespace of the class object
+itself. This is useful for setting up, e.g., class-scoped variables.
+.VE TIP478
+.TP
 \fBmethod\fI name argList bodyScript\fR
 .
 This creates or updates a method that is implemented as a procedure-like
@@ -396,7 +426,7 @@ Some of the configurable definitions of a class or object are \fIslotted
 definitions\fR. This means that the configuration is implemented by a slot
 object, that is an instance of the class \fBoo::Slot\fR, which manages a list
 of values (class names, variable names, etc.) that comprises the contents of
-the slot. The class defines three operations (as methods) that may be done on
+the slot. The class defines five operations (as methods) that may be done on
 the slot:
 .TP
 \fIslot\fR \fB\-append\fR ?\fImember ...\fR?
@@ -407,6 +437,16 @@ This appends the given \fImember\fR elements to the slot definition.
 .
 This sets the slot definition to the empty list.
 .TP
+\fIslot\fR \fB\-prepend\fR ?\fImember ...\fR?
+.VS TIP516
+This prepends the given \fImember\fR elements to the slot definition.
+.VE TIP516
+.TP
+\fIslot\fR \fB\-remove\fR ?\fImember ...\fR?
+.VS TIP516
+This removes the given \fImember\fR elements from the slot definition.
+.VE TIP516
+.TP
 \fIslot\fR \fB\-set\fR ?\fImember ...\fR?
 .
 This replaces the slot definition with the given \fImember\fR elements.
@@ -424,15 +464,52 @@ and these methods which provide the implementation interface:
 .TP
 \fIslot\fR \fBGet\fR
 .
-Returns a list that is the current contents of the slot. This method must
-always be called from a stack frame created by a call to \fBoo::define\fR or
-\fBoo::objdefine\fR.
+Returns a list that is the current contents of the slot, but does not modify
+the slot. This method must always be called from a stack frame created by a
+call to \fBoo::define\fR or \fBoo::objdefine\fR. This method \fIshould not\fR
+return an error unless it is called from outside a definition context or with
+the wrong number of arguments.
+.RS
+.PP
+.VS TIP516
+The elements of the list should be fully resolved, if that is a meaningful
+concept to the slot.
+.VE TIP516
+.RE
+.TP
+\fIslot\fR \fBResolve\fR \fIslotElement\fR
+.VS TIP516
+Returns \fIslotElement\fR with a resolution operation applied to it, but does
+not modify the slot. For slots of simple strings, this is an operation that
+does nothing, whereas for slots of classes, this maps a class name to its
+fully-qualified class name.  This method must always be called from a stack
+frame created by a call to \fBoo::define\fR or \fBoo::objdefine\fR.  This
+method \fIshould not\fR return an error unless it is called from outside a
+definition context or with the wrong number of arguments; unresolvable
+arguments should be returned as is (as not all slot operations strictly
+require that values are resolvable to work).
+.RS
+.PP
+Implementations \fIshould not\fR enforce uniqueness and ordering constraints
+in this method; that is the responsibility of the \fBSet\fR method.
+.RE
+.VE TIP516
 .TP
 \fIslot\fR \fBSet \fIelementList\fR
 .
 Sets the contents of the slot to the list \fIelementList\fR and returns the
 empty string. This method must always be called from a stack frame created by
-a call to \fBoo::define\fR or \fBoo::objdefine\fR.
+a call to \fBoo::define\fR or \fBoo::objdefine\fR. This method may return an
+error if it rejects the change to the slot contents (e.g., because of invalid
+values) as well as if it is called from outside a definition context or with
+the wrong number of arguments.
+.RS
+.PP
+This method \fImay\fR reorder and filter the elements if this is necessary in
+order to satisfy the underlying constraints of the slot. (For example, slots
+of classes enforce a uniqueness constraint that places each element in the
+earliest location in the slot that it can.)
+.RE
 .PP
 The implementation of these methods is slot-dependent (and responsible for
 accessing the correct part of the class or object definition). Slots also have
@@ -440,6 +517,14 @@ an unknown method handler to tie all these pieces together, and they hide
 their \fBdestroy\fR method so that it is not invoked inadvertently. It is
 \fIrecommended\fR that any user changes to the slot mechanism be restricted to
 defining new operations whose names start with a hyphen.
+.PP
+.VS TIP516
+Most slot operations will initially \fBResolve\fR their argument list, combine
+it with the results of the \fBGet\fR method, and then \fBSet\fR the result.
+Some operations omit one or both of the first two steps; omitting the third
+would result in an idempotent read-only operation (but the standard mechanism
+for reading from slots is via \fBinfo class\fR and \fBinfo object\fR).
+.VE TIP516
 .SH EXAMPLES
 This example demonstrates how to use both forms of the \fBoo::define\fR and
 \fBoo::objdefine\fR commands (they work in the same way), as well as
@@ -496,6 +581,84 @@ oo::class create B {
 inst m1              \fI\(-> prints "red brick"\fR
 inst m2              \fI\(-> prints "blue brick"\fR
 .CE
+.PP
+.VS TIP478
+This example shows how to create and use class variables. It is a class that
+counts how many instances of itself have been made.
+.PP
+.CS
+oo::class create Counted
+\fBoo::define\fR Counted {
+    \fBinitialise\fR {
+        variable count 0
+    }
+
+    \fBvariable\fR number
+    \fBconstructor\fR {} {
+        classvariable count
+        set number [incr count]
+    }
+
+    \fBmethod\fR report {} {
+        classvariable count
+        puts "This is instance $number of $count"
+    }
+}
+
+set a [Counted new]
+set b [Counted new]
+$a report
+        \fI\(-> This is instance 1 of 2\fR
+set c [Counted new]
+$b report
+        \fI\(-> This is instance 2 of 3\fR
+$c report
+        \fI\(-> This is instance 3 of 3\fR
+.CE
+.PP
+This example demonstrates how to use class methods. (Note that the constructor
+for \fBoo::class\fR calls \fBoo::define\fR on the class.)
+.PP
+.CS
+oo::class create DBTable {
+    \fBclassmethod\fR find {description} {
+        puts "DB: locate row from [self] matching $description"
+        return [my new]
+    }
+    \fBclassmethod\fR insert {description} {
+        puts "DB: create row in [self] matching $description"
+        return [my new]
+    }
+    \fBmethod\fR update {description} {
+        puts "DB: update row [self] with $description"
+    }
+    \fBmethod\fR delete {} {
+        puts "DB: delete row [self]"
+        my destroy; # Just delete the object, not the DB row
+    }
+}
+
+oo::class create Users {
+    \fBsuperclass\fR DBTable
+}
+oo::class create Groups {
+    \fBsuperclass\fR DBTable
+}
+
+set u1 [Users insert "username=abc"]
+        \fI\(-> DB: create row from ::Users matching username=abc\fR
+set u2 [Users insert "username=def"]
+        \fI\(-> DB: create row from ::Users matching username=def\fR
+$u2 update "group=NULL"
+        \fI\(-> DB: update row ::oo::Obj124 with group=NULL\fR
+$u1 delete
+        \fI\(-> DB: delete row ::oo::Obj123\fR
+set g [Group find "groupname=webadmins"]
+        \fI\(-> DB: locate row ::Group with groupname=webadmins\fR
+$g update "emailaddress=admins"
+        \fI\(-> DB: update row ::oo::Obj125 with emailaddress=admins\fR
+.CE
+.VE TIP478
 .SH "SEE ALSO"
 next(n), oo::class(n), oo::object(n)
 .SH KEYWORDS
diff --git a/doc/dict.n b/doc/dict.n
index cd7e94c..1829768 100644
--- a/doc/dict.n
+++ b/doc/dict.n
@@ -27,6 +27,11 @@ key maps to in the dictionary value contained in the given variable,
 writing the resulting dictionary value back to that variable.
 Non-existent keys are treated as if they map to an empty string. The
 updated dictionary value is returned.
+.VS TIP508
+If \fIdictionaryVarable\fR indicates an element that does not exist of an
+array that has a default value set, the default value and will be used as the
+value of the dictionary prior to the appending operation.
+.VE TIP508
 .TP
 \fBdict create \fR?\fIkey value ...\fR?
 .
@@ -124,6 +129,11 @@ resulting dictionary value back to that variable. Non-existent keys
 are treated as if they map to 0. It is an error to increment a value
 for an existing key if that value is not an integer. The updated
 dictionary value is returned.
+.VS TIP508
+If \fIdictionaryVarable\fR indicates an element that does not exist of an
+array that has a default value set, the default value and will be used as the
+value of the dictionary prior to the incrementing operation.
+.VE TIP508
 .TP
 \fBdict info \fIdictionaryValue\fR
 .
@@ -149,6 +159,11 @@ keys are treated as if they map to an empty list, and it is legal for
 there to be no items to append to the list. It is an error for the
 value that the key maps to to not be representable as a list. The
 updated dictionary value is returned.
+.VS TIP508
+If \fIdictionaryVarable\fR indicates an element that does not exist of an
+array that has a default value set, the default value and will be used as the
+value of the dictionary prior to the list-appending operation.
+.VE TIP508
 .TP
 \fBdict map \fR{\fIkeyVariable valueVariable\fR} \fIdictionaryValue body\fR
 .
@@ -206,6 +221,11 @@ value and places an updated dictionary value in that variable
 containing a mapping from the given key to the given value. When
 multiple keys are present, this operation creates or updates a chain
 of nested dictionaries. The updated dictionary value is returned.
+.VS TIP508
+If \fIdictionaryVarable\fR indicates an element that does not exist of an
+array that has a default value set, the default value and will be used as the
+value of the dictionary prior to the value insert/update operation.
+.VE TIP508
 .TP
 \fBdict size \fIdictionaryValue\fR
 .
@@ -221,6 +241,11 @@ through nested dictionaries to the mapping to remove. At least one key
 must be specified, but the last key on the key-path need not exist.
 All other components on the path must exist. The updated dictionary
 value is returned.
+.VS TIP508
+If \fIdictionaryVarable\fR indicates an element that does not exist of an
+array that has a default value set, the default value and will be used as the
+value of the dictionary prior to the value remove operation.
+.VE TIP508
 .TP
 \fBdict update \fIdictionaryVariable key varName \fR?\fIkey varName ...\fR? \fIbody\fR
 .
@@ -236,6 +261,11 @@ are silently discarded), even if the result of \fIbody\fR is an error
 or some other kind of exceptional exit. The result of \fBdict
 update\fR is (unless some kind of error occurs) the result of the
 evaluation of \fIbody\fR.
+.VS TIP508
+If \fIdictionaryVarable\fR indicates an element that does not exist of an
+array that has a default value set, the default value and will be used as the
+value of the dictionary prior to the update operation.
+.VE TIP508
 .RS
 .PP
 Each \fIvarName\fR is mapped in the scope enclosing the \fBdict update\fR;
@@ -270,6 +300,11 @@ dictionary be discarded, and this also happens if the contents of
 dictionaries no longer exists. The result of \fBdict with\fR is
 (unless some kind of error occurs) the result of the evaluation of
 \fIbody\fR.
+.VS TIP508
+If \fIdictionaryVarable\fR indicates an element that does not exist of an
+array that has a default value set, the default value and will be used as the
+value of the dictionary prior to the updating operation.
+.VE TIP508
 .RS
 .PP
 The variables are mapped in the scope enclosing the \fBdict with\fR;
diff --git a/doc/exec.n b/doc/exec.n
index 70ace32..99dfdc5 100644
--- a/doc/exec.n
+++ b/doc/exec.n
@@ -217,6 +217,19 @@ information is instead sent to the console, if one is present, or is
 discarded.
 .RS
 .PP
+Note that the current escape resp. quoting of arguments for windows works only
+with executables using CommandLineToArgv, CRT-library or similar, as well as
+with the windows batch files (excepting the newline, see below).
+Although it is the common escape algorithm, but, in fact, the way how the
+executable parses the command-line (resp. splits it into single arguments)
+is decisive.
+.PP
+Unfortunately, there is currently no way to supply newline character within
+an argument to the batch files (\fB.cmd\fR or \fB.bat\fR) or to the command
+processor (\fBcmd.exe /c\fR), because this causes truncation of command-line
+(also the argument chain) on the first newline character.
+But it works properly with an executable (using CommandLineToArgv, etc).
+.PP
 The Tk console text widget does not provide real standard IO capabilities.
 Under Tk, when redirecting from standard input, all applications will see an
 immediate end-of-file; information redirected to standard output or standard
@@ -409,6 +422,10 @@ that sometimes pop up:
 With the file \fIcmp.bat\fR looking something like:
 .PP
 .CS
+@gcc %*
+.CE
+or like another variant using single parameters:
+.CS
 @gcc %1 %2 %3 %4 %5 %6 %7 %8 %9
 .CE
 .SS "WORKING WITH COMMAND BUILT-INS"
diff --git a/doc/http.n b/doc/http.n
index 40ced23..7e633b3 100644
--- a/doc/http.n
+++ b/doc/http.n
@@ -6,14 +6,14 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\"
-.TH "http" n 2.7 http "Tcl Bundled Packages"
+.TH "http" n 2.9 http "Tcl Bundled Packages"
 .so man.macros
 .BS
 '\" Note:  do not modify the .SH NAME line immediately below!
 .SH NAME
 http \- Client-side implementation of the HTTP/1.1 protocol
 .SH SYNOPSIS
-\fBpackage require http ?2.7?\fR
+\fBpackage require http ?2.8?\fR
 .\" See Also -useragent option documentation in body!
 .sp
 \fB::http::config ?\fI\-option value\fR ...?
@@ -22,6 +22,8 @@ http \- Client-side implementation of the HTTP/1.1 protocol
 .sp
 \fB::http::formatQuery\fR \fIkey value\fR ?\fIkey value\fR ...?
 .sp
+\fB::http::quoteString\fR \fIvalue\fR
+.sp
 \fB::http::reset\fR \fItoken\fR ?\fIwhy\fR?
 .sp
 \fB::http::wait \fItoken\fR
@@ -44,12 +46,14 @@ http \- Client-side implementation of the HTTP/1.1 protocol
 .sp
 \fB::http::register \fIproto port command\fR
 .sp
+\fB::http::registerError \fIport\fR ?\fImessage\fR?
+.sp
 \fB::http::unregister \fIproto\fR
 .BE
 .SH DESCRIPTION
 .PP
 The \fBhttp\fR package provides the client side of the HTTP/1.1
-protocol, as defined in RFC 2616.
+protocol, as defined in RFC 7230 to RFC 7235, which supersede RFC 2616.
 The package implements the GET, POST, and HEAD operations
 of HTTP/1.1.  It allows configuration of a proxy host to get through
 firewalls.  The package is compatible with the \fBSafesock\fR security
@@ -95,6 +99,19 @@ comma-separated list of mime type patterns that you are
 willing to receive.  For example,
 .QW "image/gif, image/jpeg, text/*" .
 .TP
+\fB\-pipeline\fR \fIboolean\fR
+.
+Specifies whether HTTP/1.1 transactions on a persistent socket will be
+pipelined.  See the \fBPERSISTENT SOCKETS\fR section for details. The default
+is 1.
+.TP
+\fB\-postfresh\fR \fIboolean\fR
+.
+Specifies whether requests that use the \fBPOST\fR method will always use a
+fresh socket, overriding the \fB-keepalive\fR option of
+command \fBhttp::geturl\fR.  See the \fBPERSISTENT SOCKETS\fR section for details.
+The default is 0.
+.TP
 \fB\-proxyhost\fR \fIhostname\fR
 .
 The name of the proxy host, if any.  If this value is the
@@ -116,20 +133,47 @@ an empty list.  The default filter returns the values of the
 \fB\-proxyhost\fR and \fB\-proxyport\fR settings if they are
 non-empty.
 .TP
+\fB\-repost\fR \fIboolean\fR
+.
+Specifies what to do if a POST request over a persistent connection fails
+because the server has half-closed the connection.  If boolean \fBtrue\fR, the
+request
+will be automatically retried; if boolean \fBfalse\fR it will not, and the
+application
+that uses \fBhttp::geturl\fR is expected to seek user confirmation before
+retrying the POST.  The value \fBtrue\fR should be used only under certain
+conditions. See the \fBPERSISTENT SOCKETS\fR section for details. The
+default is 0.
+.TP
 \fB\-urlencoding\fR \fIencoding\fR
 .
 The \fIencoding\fR used for creating the x-url-encoded URLs with
-\fB::http::formatQuery\fR.  The default is \fButf-8\fR, as specified by RFC
+\fB::http::formatQuery\fR and \fB::http::quoteString\fR.
+The default is \fButf-8\fR, as specified by RFC
 2718.  Prior to http 2.5 this was unspecified, and that behavior can be
 returned by specifying the empty string (\fB{}\fR), although
 \fIiso8859-1\fR is recommended to restore similar behavior but without the
-\fB::http::formatQuery\fR throwing an error processing non-latin-1
-characters.
+\fB::http::formatQuery\fR or \fB::http::quoteString\fR
+throwing an error processing non-latin-1 characters.
 .TP
 \fB\-useragent\fR \fIstring\fR
 .
-The value of the User-Agent header in the HTTP request.  The default is
-.QW "\fBTcl http client package 2.7\fR" .
+The value of the User-Agent header in the HTTP request.  In an unsafe
+interpreter, the default value depends upon the operating system, and
+the version numbers of \fBhttp\fR and \fBTcl\fR, and is (for example)
+.QW "\fBMozilla/5.0 (Windows; U; Windows NT 10.0) http/2.8.12 Tcl/8.6.8\fR" .
+A safe interpreter cannot determine its operating system, and so the default
+in a safe interpreter is to use a Windows 10 value with the current version
+numbers of \fBhttp\fR and \fBTcl\fR.
+.TP
+\fB\-zip\fR \fIboolean\fR
+.
+If the value is boolean \fBtrue\fR, then by default requests will send a header
+.QW "\fBAccept-Encoding: gzip,deflate,compress\fR" .
+If the value is boolean \fBfalse\fR, then by default this header will not be sent.
+In either case the default can be overridden for an individual request by
+supplying a custom \fBAccept-Encoding\fR header in the \fB-headers\fR option
+of \fBhttp::geturl\fR. The default is 1.
 .RE
 .TP
 \fB::http::geturl\fR \fIurl\fR ?\fIoptions\fR?
@@ -227,7 +271,7 @@ Pragma: no-cache
 .TP
 \fB\-keepalive\fR \fIboolean\fR
 .
-If true, attempt to keep the connection open for servicing
+If boolean \fBtrue\fR, attempt to keep the connection open for servicing
 multiple requests.  Default is 0.
 .TP
 \fB\-method\fR \fItype\fR
@@ -334,6 +378,11 @@ encodes the keys and values, and generates one string that has the
 proper & and = separators.  The result is suitable for the
 \fB\-query\fR value passed to \fB::http::geturl\fR.
 .TP
+\fB::http::quoteString\fR \fIvalue\fR
+.
+This procedure does x-url-encoding of string.  It takes a single argument and
+encodes it.
+.TP
 \fB::http::reset\fR \fItoken\fR ?\fIwhy\fR?
 .
 This command resets the HTTP transaction identified by \fItoken\fR, if any.
@@ -415,6 +464,17 @@ set token [::http::geturl https://my.secure.site/]
 .CE
 .RE
 .TP
+\fB::http::registerError\fR \fIport\fR ?\fImessage\fR?
+.
+This procedure allows a registered protocol handler to deliver an error
+message for use by \fBhttp\fR.  Calling this command does not raise an
+error. The command is useful when a registered protocol detects an problem
+(for example, an invalid TLS certificate) that will cause an error to
+propagate to \fBhttp\fR.  The command allows \fBhttp\fR to provide a
+precise error message rather than a general one.  The command returns the
+value provided by the last call with argument \fImessage\fR, or the empty
+string if no such call has been made.
+.TP
 \fB::http::unregister\fR \fIproto\fR
 .
 This procedure unregisters a protocol handler that was previously
@@ -504,6 +564,14 @@ The following elements of
 the array are supported:
 .RS
 .TP
+\fBbinary\fR
+.
+This is boolean \fBtrue\fR if (after decoding any compression specified
+by the
+.QW "Content-Encoding"
+response header) the HTTP response is binary.  It is boolean \fBfalse\fR
+if the HTTP response is text.
+.TP
 \fBbody\fR
 .
 The contents of the URL.  This will be empty if the \fB\-channel\fR
@@ -602,6 +670,106 @@ A copy of the \fBContent-Type\fR meta-data value.
 .
 The requested URL.
 .RE
+.SH "PERSISTENT CONNECTIONS"
+.PP
+.SS "BASICS"
+.PP
+See RFC 7230 Sec 6, which supersedes RFC 2616 Sec 8.1.
+.PP
+A persistent connection allows multiple HTTP/1.1 transactions to be
+carried over the same TCP connection.  Pipelining allows a
+client to make multiple requests over a persistent connection without
+waiting for each response.  The server sends responses in the same order
+that the requests were received.
+.PP
+If a POST request fails to complete, typically user confirmation is
+needed before sending the request again.  The user may wish to verify
+whether the server was modified by the failed POST request, before
+sending the same request again.
+.PP
+A HTTP request will use a persistent socket if the call to
+\fBhttp::geturl\fR has the option \fB-keepalive true\fR. It will use
+pipelining where permitted if the \fBhttp::config\fR option
+\fB-pipeline\fR is boolean \fBtrue\fR (its default value).
+.PP
+The http package maintains no more than one persistent connection to each
+server (i.e. each value of
+.QW "domain:port" ).
+If \fBhttp::geturl\fR is called to make a request over a persistent
+connection while the connection is busy with another request, the new
+request will be held in a queue until the connection is free.
+.PP
+The http package does not support HTTP/1.0 persistent connections
+controlled by the \fBKeep-Alive\fR header.
+.SS "SPECIAL CASES"
+.PP
+This subsection discusses issues related to closure of the
+persistent connection by the server, automatic retry of failed requests,
+the special treatment necessary for POST requests, and the options for
+dealing with these cases.
+.PP
+In accordance with RFC 7230, \fBhttp::geturl\fR does not pipeline
+requests that use the POST method.  If a POST uses a persistent
+connection and is not the first request on that connection,
+\fBhttp::geturl\fR waits until it has received the response for the previous
+request; or (if \fBhttp::config\fR option \fB-postfresh\fR is boolean \fBtrue\fR) it
+uses a new connection for each POST.
+.PP
+If the server is processing a number of pipelined requests, and sends a
+response header
+.QW "\fBConnection: close\fR"
+with one of the responses (other than the last), then subsequent responses
+are unfulfilled. \fBhttp::geturl\fR will send the unfulfilled requests again
+over a new connection.
+.PP
+A difficulty arises when a HTTP client sends a request over a persistent
+connection that has been idle for a while.  The HTTP server may
+half-close an apparently idle connection while the client is sending a
+request, but before the request arrives at the server: in this case (an
+.QW "asynchronous close event" )
+the request will fail.  The difficulty arises because the client cannot
+be certain whether the POST modified the state of the server.  For HEAD or
+GET requests, \fBhttp::geturl\fR opens another connection and retransmits
+the failed request. However, if the request was a POST, RFC 7230 forbids
+automatic retry by default, suggesting either user confirmation, or
+confirmation by user-agent software that has semantic understanding of
+the application.  The \fBhttp::config\fR option \fB-repost\fR allows for
+either possibility.
+.PP
+Asynchronous close events can occur only in a short interval of time.  The
+\fBhttp\fR package monitors each persistent connection for closure by the
+server.  Upon detection, the connection is also closed at the client end,
+and subsequent requests will use a fresh connection.
+.PP
+If the \fBhttp::geturl\fR command is called with option \fB-keepalive true\fR,
+then it will both try to use an existing persistent connection
+(if one is available), and it will send the server a
+.QW "\fBConnection: keep-alive\fR"
+request header asking to keep the connection open for future requests.
+.PP
+The \fBhttp::config\fR options \fB-pipeline\fR, \fB-postfresh\fR, and
+\fB-repost\fR relate to persistent connections.
+.PP
+Option \fB-pipeline\fR, if boolean \fBtrue\fR, will pipeline GET and HEAD requests
+made
+over a persistent connection.  POST requests will not be pipelined - if the
+POST is not the first transaction on the connection, its request will not
+be sent until the previous response has finished.  GET and HEAD requests
+made after a POST will not be sent until the POST response has been
+delivered, and will not be sent if the POST fails.
+.PP
+Option \fB-postfresh\fR, if boolean \fBtrue\fR, will override the \fBhttp::geturl\fR option
+\fB-keepalive\fR, and always open a fresh connection for a POST request.
+.PP
+Option \fB-repost\fR, if \fBtrue\fR, permits automatic retry of a POST request
+that fails because it uses a persistent connection that the server has
+half-closed (an
+.QW "asynchronous close event" ).
+Subsequent GET and HEAD requests in a failed pipeline will also be retried.
+\fIThe -repost option should be used only if the application understands
+that the retry is appropriate\fR - specifically, the application must know
+that if the failed POST successfully modified the state of the server, a repeat POST
+would have no adverse effect.
 .SH EXAMPLE
 .PP
 This example creates a procedure to copy a URL to a file while printing a
diff --git a/doc/incr.n b/doc/incr.n
index b4be95c..f491903 100644
--- a/doc/incr.n
+++ b/doc/incr.n
@@ -27,6 +27,11 @@ and also returned as result.
 Starting with the Tcl 8.5 release, the variable \fIvarName\fR passed
 to \fBincr\fR may be unset, and in that case, it will be set to
 the value \fIincrement\fR or to the default increment value of \fB1\fR.
+.VS TIP508
+If \fIvarName\fR indicate an element that does not exist of an array that has
+a default value set, the sum of the default value and the \fIincrement\fR (or
+1) will be stored in the array element.
+.VE TIP508
 .SH EXAMPLES
 .PP
 Add one to the contents of the variable \fIx\fR:
@@ -59,3 +64,7 @@ an error if it is not):
 expr(n), set(n)
 .SH KEYWORDS
 add, increment, variable, value
+.\" Local variables:
+.\" mode: nroff
+.\" fill-column: 78
+.\" End:
diff --git a/doc/info.n b/doc/info.n
index 02470af..5732a13 100644
--- a/doc/info.n
+++ b/doc/info.n
@@ -44,6 +44,42 @@ described in \fBCLASS INTROSPECTION\fR below.
 Returns a count of the total number of commands that have been invoked
 in this interpreter.
 .TP
+\fBinfo cmdtype \fIcommandName\fR
+.VS TIP426
+Returns a description of the kind of command named by \fIcommandName\fR.  The
+supported types are:
+.RS
+.IP \fBalias\fR
+Indicates that \fIcommandName\fR was created by \fBinterp alias\fR. Note that
+safe interpreters can only see a subset of aliases (specifically those between
+two commands within themselves).
+.IP \fBcoroutine\fR
+Indicates that \fIcommandName\fR was created by \fBcoroutine\fR.
+.IP \fBensemble\fR
+Indicates that \fIcommandName\fR was created by \fBnamespace ensemble\fR.
+.IP \fBimport\fR
+Indicates that \fIcommandName\fR was created by \fBnamespace import\fR.
+.IP \fBnative\fR
+Indicates that \fIcommandName\fR was created by the \fBTcl_CreateObjProc\fR
+interface directly without further registration of the type of command.
+.IP \fBobject\fR
+Indicates that \fIcommandName\fR is the public command that represents an
+instance of \fBoo::object\fR or one of its subclasses.
+.IP \fBprivateObject\fR
+Indicates that \fIcommandName\fR is the private command (\fBmy\fR by default)
+that represents an instance of \fBoo::object\fR or one of its subclasses.
+.IP \fBproc\fR
+Indicates that \fIcommandName\fR was created by \fBproc\fR.
+.IP \fBslave\fR
+Indicates that \fIcommandName\fR was created by \fBinterp create\fR.
+.IP \fBzlibStream\fR
+Indicates that \fIcommandName\fR was created by \fBzlib stream\fR.
+.PP
+There may be other registered types as well; this is a set that is extensible
+at the implementation level with \fBTcl_RegisterCommandTypeName\fR.
+.RE
+.VE TIP426
+.TP
 \fBinfo commands \fR?\fIpattern\fR?
 .
 If \fIpattern\fR is not specified,
diff --git a/doc/lappend.n b/doc/lappend.n
index 80d075a..66bea5f 100644
--- a/doc/lappend.n
+++ b/doc/lappend.n
@@ -22,6 +22,12 @@ and appends each of the \fIvalue\fR arguments to that list as a separate
 element, with spaces between elements.
 If \fIvarName\fR does not exist, it is created as a list with elements
 given by the \fIvalue\fR arguments.
+.VS TIP508
+If \fIvarName\fR indicate an element that does not exist of an array that has
+a default value set, list that is comprised of the default value with all the
+\fIvalue\fR arguments appended as elements will be stored in the array
+element.
+.VE TIP508
 \fBLappend\fR is similar to \fBappend\fR except that the \fIvalue\fRs
 are appended as list elements rather than raw text.
 This command provides a relatively efficient way to build up
@@ -47,3 +53,7 @@ list(n), lindex(n), linsert(n), llength(n), lset(n),
 lsort(n), lrange(n)
 .SH KEYWORDS
 append, element, list, variable
+.\" Local variables:
+.\" mode: nroff
+.\" fill-column: 78
+.\" End:
diff --git a/doc/link.n b/doc/link.n
new file mode 100644
index 0000000..7219342
--- /dev/null
+++ b/doc/link.n
@@ -0,0 +1,124 @@
+'\"
+'\" Copyright (c) 2011-2015 Andreas Kupries
+'\" Copyright (c) 2018 Donal K. Fellows
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.TH link n 0.3 TclOO "TclOO Commands"
+.so man.macros
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+link \- create link from command to method of object
+.SH SYNOPSIS
+.nf
+package require TclOO
+
+\fBlink\fR \fImethodName\fR ?\fI...\fR?
+\fBlink\fR \fB{\fIcommandName methodName\fB}\fR ?\fI...\fR?
+.fi
+.BE
+.SH DESCRIPTION
+The \fBlink\fR command is available within methods. It takes a series of one
+or more method names (\fImethodName ...\fR) and/or pairs of command- and
+method-name (\fB{\fIcommandName methodName\fB}\fR) and makes the named methods
+available as commands without requiring the explicit use of the name of the
+object or the \fBmy\fR command. The method does not need to exist at the time
+that the link is made; if the link command is invoked when the method does not
+exist, the standard \fBunknown\fR method handling system is used.
+.PP
+The command name under which the method becomes available defaults to the
+method name, except where explicitly specified through an alias/method pair.
+Formally, every argument must be a list; if the list has two elements, the
+first element is the name of the command to create and the second element is
+the name of the method of the current object to which the command links;
+otherwise, the name of the command and the name of the method are the same
+string (the first element of the list).
+.PP
+If the name of the command is not a fully-qualified command name, it will be
+resolved with respect to the current namespace (i.e., the object namespace).
+.SH EXAMPLES
+This demonstrates linking a single method in various ways. First it makes a
+simple link, then a renamed link, then an external link. Note that the method
+itself is unexported, but that it can still be called directly from outside
+the class.
+.PP
+.CS
+oo::class create ABC {
+    method Foo {} {
+        puts "This is Foo in [self]"
+    }
+
+    constructor {} {
+        \fBlink\fR Foo
+        # The method foo is now directly accessible as foo here
+        \fBlink\fR {bar Foo}
+        # The method foo is now directly accessible as bar
+        \fBlink\fR {::ExternalCall Foo}
+        # The method foo is now directly accessible in the global
+        # namespace as ExternalCall
+    }
+
+    method grill {} {
+        puts "Step 1:"
+        Foo
+        puts "Step 2:"
+        bar
+    }
+}
+
+ABC create abc
+abc grill
+        \fI\(-> Step 1:\fR
+        \fI\(-> This is foo in ::abc\fR
+        \fI\(-> Step 2:\fR
+        \fI\(-> This is foo in ::abc\fR
+# Direct access via the linked command
+puts "Step 3:"; ExternalCall
+        \fI\(-> Step 3:\fR
+        \fI\(-> This is foo in ::abc\fR
+.CE
+.PP
+This example shows that multiple linked commands can be made in a call to
+\fBlink\fR, and that they can handle arguments.
+.PP
+.CS
+oo::class create Ex {
+    constructor {} {
+        \fBlink\fR a b c
+        # The methods a, b, and c (defined below) are all now
+        # directly acessible within methods under their own names.
+    }
+
+    method a {} {
+        puts "This is a"
+    }
+    method b {x} {
+        puts "This is b($x)"
+    }
+    method c {y z} {
+        puts "This is c($y,$z)"
+    }
+
+    method call {p q r} {
+        a
+        b $p
+        c $q $r
+    }
+}
+
+set o [Ex new]
+$o 3 5 7
+        \fI\(-> This is a\fR
+        \fI\(-> This is b(3)\fR
+        \fI\(-> This is c(5,7)\fR
+.CE
+.SH "SEE ALSO"
+interp(n), my(n), oo::class(n), oo::define(n)
+.SH KEYWORDS
+command, method, object
+.\" Local Variables:
+.\" mode: nroff
+.\" fill-column: 78
+.\" End:
diff --git a/doc/lreplace.n b/doc/lreplace.n
index d19f0cd..35a9130 100644
--- a/doc/lreplace.n
+++ b/doc/lreplace.n
@@ -30,13 +30,26 @@ list, and \fBend\fR refers to the last element of the list.
 If \fIlist\fR is empty, then \fIfirst\fR and \fIlast\fR are ignored.
 .PP
 If \fIfirst\fR is less than zero, it is considered to refer to before the
-first element of the list.  For non-empty lists, the element indicated
-by \fIfirst\fR must exist or \fIfirst\fR must indicate before the
+first element of the list.
+.VS TIP505
+If \fIfirst\fR indicates a position greater than the index of the last element
+of the list, it is treated as if it is an index one greater than the last
+element. This allows this command to append elements to the list.
+.VE TIP505
+For non-empty lists, the element indicated
+by \fIfirst\fR must exist, or \fIfirst\fR must indicate before the
 start of the list.
 .PP
 If \fIlast\fR is less than \fIfirst\fR, then any specified elements
 will be inserted into the list before the point specified by \fIfirst\fR
 with no elements being deleted.
+.VS TIP505
+If \fIlast\fR is greater than the index of the last item of the list, it is
+treated as if it is an index one greater than the last element. This means
+that if it is also greater than than \fIfirst\fR, all elements from
+\fIfirst\fR to the end of the list will be replaced, and otherwise the
+elements will be appended.
+.VE TIP505
 .PP
 The \fIelement\fR arguments specify zero or more new arguments to
 be added to the list in place of those that were deleted.
@@ -78,9 +91,26 @@ proc lremove {listVariable value} {
     set var [\fBlreplace\fR $var $idx $idx]
 }
 .CE
+.PP
+.VS TIP505
+Adding elements to the end of the list; note that \fBend+2\fR will initially
+be treated as if it is \fB6\fR here, but both that and \fB12345\fR are greater
+than the index of the final item so they behave identically:
+.PP
+.CS
+% set var {a b c d e}
+a b c d e
+% set var [\fBlreplace\fR $var 12345 end+2 f g h i]
+a b c d e f g h i
+.CE
+.VE TIP505
 .SH "SEE ALSO"
 list(n), lappend(n), lindex(n), linsert(n), llength(n), lsearch(n),
 lset(n), lrange(n), lsort(n),
 string(n)
 .SH KEYWORDS
 element, list, replace
+.\" Local variables:
+.\" mode: nroff
+.\" fill-column: 78
+.\" End:
diff --git a/doc/my.n b/doc/my.n
index 26d861a..262186f 100644
--- a/doc/my.n
+++ b/doc/my.n
@@ -9,30 +9,45 @@
 .BS
 '\" Note:  do not modify the .SH NAME line immediately below!
 .SH NAME
-my \- invoke any method of current object
+my, myclass \- invoke any method of current object or its class
 .SH SYNOPSIS
 .nf
 package require TclOO
 
 \fBmy\fI methodName\fR ?\fIarg ...\fR?
+\fBmyclass\fI methodName\fR ?\fIarg ...\fR?
 .fi
 .BE
 .SH DESCRIPTION
 .PP
 The \fBmy\fR command is used to allow methods of objects to invoke methods
-of the object (or its class). In particular, the set of valid values for
+of the object (or its class),
+.VS TIP478
+and he \fBmyclass\fR command is used to allow methods of objects to invoke
+methods of the current class of the object \fIas an object\fR.
+.VE TIP478
+In particular, the set of valid values for
 \fImethodName\fR is the set of all methods supported by an object and its
 superclasses, including those that are not exported
 .VS TIP500
 and private methods of the object or class when used within another method
 defined by that object or class.
 .VE TIP500
-The object upon which the method is invoked is the one that owns the namespace
-that the \fBmy\fR command is contained in initially (\fBNB:\fR the link
+.PP
+The object upon which the method is invoked via \fBmy\fR is the one that owns
+the namespace that the \fBmy\fR command is contained in initially (\fBNB:\fR the link
 remains if the command is renamed), which is the currently invoked object by
 default.
+.VS TIP478
+Similarly, the object on which the method is invoked via \fBmyclass\fR is the
+object that is the current class of the object that owns the namespace that
+the \fBmyclass\fR command is contained in initially. As with \fBmy\fR, the
+link remains even if the command is renamed into another namespace, and
+defaults to being the manufacturing class of the current object.
+.VE TIP478
 .PP
-Each object has its own \fBmy\fR command, contained in its instance namespace.
+Each object has its own \fBmy\fR and \fBmyclass\fR commands, contained in its
+instance namespace.
 .SH EXAMPLES
 .PP
 This example shows basic use of \fBmy\fR to use the \fBvariables\fR method of
@@ -54,7 +69,8 @@ o count              \fI\(-> prints "3"\fR
 .PP
 This example shows how you can use \fBmy\fR to make callbacks to private
 methods from outside the object (from a \fBtrace\fR), using
-\fBnamespace code\fR to enter the correct context:
+\fBnamespace code\fR to enter the correct context. (See the \fBcallback\fR
+command for the recommended way of doing this.)
 .PP
 .CS
 oo::class create HasCallback {
@@ -73,6 +89,38 @@ set o [HasCallback new]
 trace add variable xyz write [$o makeCallback]
 set xyz "called"     \fI\(-> prints "callback: xyz {} write"\fR
 .CE
+.PP
+.VS TIP478
+This example shows how to access a private method of a class from an instance
+of that class. (See the \fBclassmethod\fR declaration in \fBoo::define\fR for
+a higher level interface for doing this.)
+.PP
+.CS
+oo::class create CountedSteps {
+    self {
+        variable count
+        method Count {} {
+            return [incr count]
+        }
+    }
+    method advanceTwice {} {
+        puts "in [self] step A: [\fBmyclass\fR Count]"
+        puts "in [self] step B: [\fBmyclass\fR Count]"
+    }
+}
+
+CountedSteps create x
+CountedSteps create y
+x advanceTwice       \fI\(-> prints "in ::x step A: 1"\fR
+                     \fI\(-> prints "in ::x step B: 2"\fR
+y advanceTwice       \fI\(-> prints "in ::y step A: 3"\fR
+                     \fI\(-> prints "in ::y step B: 4"\fR
+x advanceTwice       \fI\(-> prints "in ::x step A: 5"\fR
+                     \fI\(-> prints "in ::x step B: 6"\fR
+y advanceTwice       \fI\(-> prints "in ::y step A: 7"\fR
+                     \fI\(-> prints "in ::y step B: 8"\fR
+.CE
+.VE TIP478
 .SH "SEE ALSO"
 next(n), oo::object(n), self(n)
 .SH KEYWORDS
diff --git a/doc/process.n b/doc/process.n
index fbe307b..536b98b 100644
--- a/doc/process.n
+++ b/doc/process.n
@@ -24,11 +24,11 @@ Returns the list of subprocess PIDs.
 .TP
 \fB::tcl::process status\fR ?\fIswitches\fR? ?\fIpids\fR?
 .
-Returns a dictionary mapping subprocess PIDs to their respective status. If 
-\fIpids\fR is specified as a list of PIDs then the command only returns the 
-status of the matching subprocesses if they exist, and raises an error 
+Returns a dictionary mapping subprocess PIDs to their respective status. If
+\fIpids\fR is specified as a list of PIDs then the command only returns the
+status of the matching subprocesses if they exist, and raises an error
 otherwise. For active processes, the status is an empty value. For terminated
-processes, the status is a list with the following format: 
+processes, the status is a list with the following format:
 .QW "{code ?\fImsg errorCode\fR?}" ,
 where:
 .RS
@@ -45,7 +45,7 @@ is the human-readable error message,
 .
 uses the same format as the \fBerrorCode\fR global variable
 .RE
-Note that \fBmsg\fR and \fBerrorCode\fR are only present for abnormally 
+Note that \fBmsg\fR and \fBerrorCode\fR are only present for abnormally
 terminated processes (i.e. those where \fBcode\fR is nonzero). Under the hood
 this command calls \fBTcl_WaitPid\fR with the \fBWNOHANG\fR flag set for
 non-blocking behavior, unless the \fB\-wait\fR switch is set (see below).
diff --git a/doc/singleton.n b/doc/singleton.n
new file mode 100644
index 0000000..568a8bd
--- /dev/null
+++ b/doc/singleton.n
@@ -0,0 +1,99 @@
+'\"
+'\" Copyright (c) 2018 Donal K. Fellows
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.TH singleton n 0.3 TclOO "TclOO Commands"
+.so man.macros
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+oo::singleton \- a class that does only allows one instance of itself
+.SH SYNOPSIS
+.nf
+package require TclOO
+
+\fBoo::singleton\fI method \fR?\fIarg ...\fR?
+.fi
+.SH "CLASS HIERARCHY"
+.nf
+\fBoo::object\fR
+   \(-> \fBoo::class\fR
+       \(-> \fBoo::singleton\fR
+.fi
+.BE
+.SH DESCRIPTION
+Singleton classes are classes that only permit at most one instance of
+themselves to exist. They unexport the \fBcreate\fR and
+\fBcreateWithNamespace\fR methods entirely, and override the \fBnew\fR method
+so that it only makes a new instance if there is no existing instance.  It is
+not recommended to inherit from a singleton class; singleton-ness is \fInot\fR
+inherited. It is not recommended that a singleton class's constructor take any
+arguments.
+.PP
+Instances have their\fB destroy\fR method overridden with a method that always
+returns an error in order to discourage destruction of the object, but
+destruction remains possible if strictly necessary (e.g., by destroying the
+class or using \fBrename\fR to delete it). They also have a (non-exported)
+\fB<cloned>\fR method defined on them that similarly always returns errors to
+make attempts to use the singleton instance with \fBoo::copy\fR fail.
+.SS CONSTRUCTOR
+The \fBoo::singleton\fR class does not define an explicit constructor; this
+means that it is effectively the same as the constructor of the
+\fBoo::class\fR class.
+.SS DESTRUCTOR
+The \fBoo::singleton\fR class does not define an explicit destructor;
+destroying an instance of it is just like destroying an ordinary class (and
+will destroy the singleton object).
+.SS "EXPORTED METHODS"
+.TP
+\fIcls \fBnew \fR?\fIarg ...\fR?
+.
+This returns the current instance of the singleton class, if one exists, and
+creates a new instance only if there is no existing instance. The additional
+arguments, \fIarg ...\fR, are only used if a new instance is actually
+manufactured; that construction is via the \fBoo::class\fR class's \fBnew\fR
+method.
+.RS
+.PP
+This is an override of the behaviour of a superclass's method with an
+identical call signature to the superclass's implementation.
+.RE
+.SS "NON-EXPORTED METHODS"
+The \fBoo::singleton\fR class explicitly states that \fBcreate\fR and
+\fBcreateWithNamespace\fR are unexported; callers should not assume that they
+have control over either the name or the namespace name of the singleton instance.
+.SH EXAMPLE
+.PP
+This example demonstrates that there is only one instance even though the
+\fBnew\fR method is called three times.
+.PP
+.CS
+\fBoo::singleton\fR create Highlander {
+    method say {} {
+        puts "there can be only one"
+    }
+}
+
+set h1 [Highlander new]
+set h2 [Highlander new]
+if {$h1 eq $h2} {
+    puts "equal objects"    \fI\(-> prints "equal objects"\fR
+}
+set h3 [Highlander new]
+if {$h1 eq $h3} {
+    puts "equal objects"    \fI\(-> prints "equal objects"\fR
+}
+.CE
+.PP
+Note that the name of the instance of the singleton is not guaranteed to be
+anything in particular.
+.SH "SEE ALSO"
+oo::class(n)
+.SH KEYWORDS
+class, metaclass, object, single instance
+.\" Local variables:
+.\" mode: nroff
+.\" fill-column: 78
+.\" End:
diff --git a/doc/tclsh.1 b/doc/tclsh.1
index 0e59b4f..c37eb81 100644
--- a/doc/tclsh.1
+++ b/doc/tclsh.1
@@ -143,6 +143,15 @@ incomplete commands.
 .SH "STANDARD CHANNELS"
 .PP
 See \fBTcl_StandardChannels\fR for more explanations.
+.SH ZIPVFS
+.PP
+When a zipfile is concatenated to the end of a \fBtclsh\fR, on
+startup the contents of the zip archive will be mounted as the
+virtual file system /zvfs. If a top level directory tcl8.6 is
+present in the zip archive, it will become the directory loaded
+as env(TCL_LIBRARY). If a file named \fBmain.tcl\fR is present
+in the top level directory of the zip archive, it will be sourced
+instead of the shell's normal command line handing.
 .SH "SEE ALSO"
 auto_path(n), encoding(n), env(n), fconfigure(n)
 .SH KEYWORDS
diff --git a/doc/uplevel.n b/doc/uplevel.n
index 4decc6d..cda1652 100644
--- a/doc/uplevel.n
+++ b/doc/uplevel.n
@@ -24,9 +24,9 @@ the result of that evaluation.
 If \fIlevel\fR is an integer then
 it gives a distance (up the procedure calling stack) to move before
 executing the command.  If \fIlevel\fR consists of \fB#\fR followed by
-a number then the number gives an absolute level number.  If \fIlevel\fR
+a integer then the level gives an absolute level.  If \fIlevel\fR
 is omitted then it defaults to \fB1\fR.  \fILevel\fR cannot be
-defaulted if the first \fIcommand\fR argument starts with a digit or \fB#\fR.
+defaulted if the first \fIcommand\fR argument is an integer or starts with \fB#\fR.
 .PP
 For example, suppose that procedure \fBa\fR was invoked
 from top-level, and that it called \fBb\fR, and that \fBb\fR called \fBc\fR.
diff --git a/doc/zipfs.3 b/doc/zipfs.3
new file mode 100644
index 0000000..ce5d5eb
--- /dev/null
+++ b/doc/zipfs.3
@@ -0,0 +1,70 @@
+'\"
+'\" Copyright (c) 2015 Jan Nijtmans <jan.nijtmans@gmail.com>
+'\" Copyright (c) 2015 Christian Werner <chw@ch-werner.de>
+'\" Copyright (c) 2017 Sean Woods <yoda@etoyoc.com>
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.TH Tclzipfs 3 8.7 Tcl "Tcl Library Procedures"
+.so man.macros
+.BS
+.SH NAME
+TclZipfs_AppHook, Tclzipfs_Mount, Tclzipfs_Unmount,  \- handle ZIP files as VFS
+.SH SYNOPSIS
+.nf
+.sp
+int
+\fBTclZipfs_AppHook(\fIint *argc, char ***argv\fR)
+.sp
+int
+\fBTclzipfs_Mount\fR(\fIinterp, mntpt, zipname, passwd\fR)
+.sp
+int
+\fBTclzipfs_Unmount\fR(\fIinterp, zipname\fR)
+.SH ARGUMENTS
+.AP "int" *argc in
+Number of command line arguments from main()
+.AP "char" ***argv in
+Pointer to an array of strings containing the command
+line arguments to main()
+.AS Tcl_Interp **termPtr
+.AP Tcl_Interp *interp in
+Interpreter in which the zip file system is mounted.  The interpreter's result is
+modified to hold the result or error message from the script.
+.AP "const char" *zipname in
+Name of a zipfile.
+.AP "const char" *mntpt in
+Name of a mount point.
+.AP "const char" *passwd in
+An (optional) password.
+.BE
+.SH DESCRIPTION
+\fBTclZipfs_AppHook()\fR is a utility function to perform standard
+application initialization procedures. If the current application has
+a mountable zip file system, that file system is mounted under \fIZIPROOT\fR\fB/app\fR.
+If a file named \fBmain.tcl\fR is located in that file system, it is treated
+as the startup script for the process. If the file \fIZIPROOT\fR\fB/app/tcl_library/init.tcl\fR
+is present, \fBtcl_library\fR is set to  \fIZIPROOT\fR\fB/app/tcl_library.
+.PP
+On Windows, \fBTclZipfs_AppHook()\fR has a slightly different signature, it uses
+WCHAR in stead of char. As a result, it only works if your application is compiled
+using -DUNICODE.
+.PP
+If the \fBtcl_library\fR was not found in the application, the system will then search for it
+as either a VFS attached to the application dynamic library, or as a zip archive named
+libtcl_\fIMAJOR\fR_\fIMINOR\fR_\fIpatchLevel\fR.zip either in the present working directory
+or in the standard tcl install location.
+.PP
+\fBTclzipfs_Mount()\fR mount the ZIP archive \fIzipname\fR on the mount
+point given in \fImntpt\fR using the optional ZIP password \fIpasswd\fR.
+Errors during that process are reported in the interpreter \fIinterp\fR.
+If \fImountpoint\fR is a NULL pointer, information on all currently mounted
+ZIP file systems is written into \fIinterp\fR's result as a sequence of
+mount points and ZIP file names.
+.PP
+\fBTclzipfs_Unmount()\fR undoes the effect of \fBTclzipfs_Mount()\fR,
+i.e. it unmounts the mounted ZIP file system at \fImountpoint\fR. Errors are
+reported in the interpreter \fIinterp\fR.
+.SH KEYWORDS
+compress, filesystem, zip
diff --git a/doc/zipfs.n b/doc/zipfs.n
new file mode 100644
index 0000000..31a0707
--- /dev/null
+++ b/doc/zipfs.n
@@ -0,0 +1,125 @@
+'\"
+'\" Copyright (c) 2015 Jan Nijtmans <jan.nijtmans@gmail.com>
+'\" Copyright (c) 2015 Christian Werner <chw@ch-werner.de>
+'\" Copyright (c) 2015 Sean Woods <yoda@etoyoc.com>
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.TH zipfs n 1.0 Zipfs "zipfs Commands"
+.so man.macros
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+zipfs \- Mount and work with ZIP files within Tcl
+.SH SYNOPSIS
+.nf
+\fBpackage require zipfs \fR?\fB1.0\fR?
+.sp
+\fBzipfs exists\fR \fIfilename\fR
+\fBzipfs find\fR \fIdir\fR
+\fBzipfs info\fR \fIfilename\fR
+\fBzipfs list\fR \fB?(-glob|-regexp)?\fR \fI?pattern?\fR
+\fBzipfs mkimg\fR \fIoutfile\fR \fIindir\fR \fI?strip?\fR \fI?password?\fR \fI?infile?\fR
+\fBzipfs mkkey\fR \fIpassword\fR
+\fBzipfs mkzip\fR \fIoutfile\fR \fIindir\fR \fI?strip?\fR \fI?password?\fR
+\fBzipfs mount\fR \fI?mountpoint?\fR \fI?zipfile?\fR \fI?password?\fR
+\fBzipfs root\fR
+\fBzipfs unmount\fR \fImountpoint\fR
+.fi
+.BE
+.SH DESCRIPTION
+.PP
+The \fBzipfs\fR package provides tcl with the ability to mount
+the contents of a zip file as a virtual file system.
+.TP
+\fBzipfs exists\fR \fIfilename\fR
+.
+Return 1 if the given filename exists in the mounted zipfs and 0 if it does not.
+.TP
+\fBzipfs find\fR \fIdir\fR
+.
+Recursively lists files including and below the directory \fIdir\fR.
+The result list consists of relative path names starting from the
+given directory. This command is also used by the \fBzipfs mkzip\fR
+and \fBzipfs mkimg\fR commands.
+.TP
+\fBzipfs info\fR \fIfile\fR
+.
+Return information about the given file in the mounted zipfs.  The information
+consists of (1) the name of the ZIP archive file that contains the file,
+(2) the size of the file after decompressions, (3) the compressed size of
+the file, and (4) the offset of the compressed data in the ZIP archive file.
+.RS
+.PP
+Note: querying the mount point gives the start of zip data offset in (4),
+which can be used to truncate the zip info off an executable.
+.RE
+.TP
+\fBzipfs list\fR \fB?(-glob|-regexp)?\fR \fI?pattern?\fR
+.
+Return a list of all files in the mounted zipfs.  The order of the names
+in the list is arbitrary.
+.TP
+\fBzipfs mkimg\fR \fIoutfile\fR \fIindir\fR \fI?strip?\fR \fI?password?\fR \fI?infile?\fR
+.
+Creates an image (potentially a new executable file) similar to
+\fBzipfs mkzip\fR. If the \fIinfile\fR parameter is specified,
+this file is prepended in front of the ZIP archive, otherwise the file
+returned by \fBTcl_NameOfExecutable(3)\fR (i.e. the executable file of
+the running process) is used. If the \fIpassword\fR parameter is not empty,
+an obfuscated version of that password is placed between the image and ZIP
+chunks of the output file and the contents of the ZIP chunk are protected
+with that password.
+.RS
+.PP
+Caution: highly experimental, not usable on Android, only partially tested
+on Linux and Windows.
+.RE
+.TP
+\fBzipfs mkkey\fR \fIpassword\fR
+.
+For the clear text \fIpassword\fR argument an obfuscated string version
+is returned with the same format used in the \fBzipfs mkimg\fR command.
+.TP
+\fBzipfs mkzip\fR \fIoutfile\fR \fIindir\fR \fI?strip?\fR \fI?password?\fR
+.
+Creates a ZIP archive file named \fIoutfile\fR from the contents of the input
+directory \fIindir\fR (contained regular files only) with optional ZIP
+password \fIpassword\fR. While processing the files below \fIindir\fR the
+optional file name prefix given in \fIstrip\fR is stripped off the beginning
+of the respective file name.
+.RS
+.PP
+Caution: the choice of the \fIindir\fR parameter
+(less the optional stripped prefix) determines the later root name of the
+archive's content.
+.RE
+.TP
+\fBzipfs mount ?\fImountpoint\fR? ?\fIzipfile\fR? ?\fIpassword\fR?
+.
+The \fBzipfs mount\fR command mounts a ZIP archive file as a VFS.
+After this command executes, files contained in \fIzipfile\fR
+will appear to Tcl to be regular files at the mount point.
+.RS
+.PP
+With no \fIzipfile\fR, returns the zipfile mounted at \fImountpoint\fR.
+With no \fImountpoint\fR, return all zipfile/mount pairs.
+If \fImountpoint\fR is specified as an empty string, mount on file path.
+.RE
+.TP
+\fBzipfs root\fR
+Returns a constant string which indicates the mount point for zipfs volumes
+for the current platform. On Windows, this value is zipfs:/. On Unux, //zipfs:/
+.RE
+.TP
+\fBzipfs unmount \fImountpoint\fR
+.
+Unmounts a previously mounted ZIP archive mounted to \fImountpoint\fR.
+.SH "SEE ALSO"
+tclsh(1), file(n), zlib(n)
+.SH "KEYWORDS"
+compress, filesystem, zip
+'\" Local Variables:
+'\" mode: nroff
+'\" End:
diff --git a/generic/tcl.decls b/generic/tcl.decls
index da551bb..61247e6 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -104,7 +104,7 @@ declare 20 {
 declare 21 {
     int Tcl_DbIsShared(Tcl_Obj *objPtr, const char *file, int line)
 }
-declare 22 {
+declare 22 {deprecated {No longer in use, changed to macro}} {
     Tcl_Obj *Tcl_DbNewBooleanObj(int boolValue, const char *file, int line)
 }
 declare 23 {
@@ -119,7 +119,7 @@ declare 25 {
     Tcl_Obj *Tcl_DbNewListObj(int objc, Tcl_Obj *const *objv,
 	    const char *file, int line)
 }
-declare 26 {
+declare 26 {deprecated {No longer in use, changed to macro}} {
     Tcl_Obj *Tcl_DbNewLongObj(long longValue, const char *file, int line)
 }
 declare 27 {
@@ -152,7 +152,7 @@ declare 35 {
     int Tcl_GetDoubleFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
 	    double *doublePtr)
 }
-declare 36 {
+declare 36 {deprecated {No longer in use, changed to macro}} {
     int Tcl_GetIndexFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
 	    const char *const *tablePtr, const char *msg, int flags, int *indexPtr)
 }
@@ -198,7 +198,7 @@ declare 48 {
     int Tcl_ListObjReplace(Tcl_Interp *interp, Tcl_Obj *listPtr, int first,
 	    int count, int objc, Tcl_Obj *const objv[])
 }
-declare 49 {
+declare 49 {deprecated {No longer in use, changed to macro}} {
     Tcl_Obj *Tcl_NewBooleanObj(int boolValue)
 }
 declare 50 {
@@ -207,13 +207,13 @@ declare 50 {
 declare 51 {
     Tcl_Obj *Tcl_NewDoubleObj(double doubleValue)
 }
-declare 52 {
+declare 52 {deprecated {No longer in use, changed to macro}} {
     Tcl_Obj *Tcl_NewIntObj(int intValue)
 }
 declare 53 {
     Tcl_Obj *Tcl_NewListObj(int objc, Tcl_Obj *const objv[])
 }
-declare 54 {
+declare 54 {deprecated {No longer in use, changed to macro}} {
     Tcl_Obj *Tcl_NewLongObj(long longValue)
 }
 declare 55 {
@@ -222,7 +222,7 @@ declare 55 {
 declare 56 {
     Tcl_Obj *Tcl_NewStringObj(const char *bytes, int length)
 }
-declare 57 {
+declare 57 {deprecated {No longer in use, changed to macro}} {
     void Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue)
 }
 declare 58 {
@@ -235,13 +235,13 @@ declare 59 {
 declare 60 {
     void Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue)
 }
-declare 61 {
+declare 61 {deprecated {No longer in use, changed to macro}} {
     void Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue)
 }
 declare 62 {
     void Tcl_SetListObj(Tcl_Obj *objPtr, int objc, Tcl_Obj *const objv[])
 }
-declare 63 {
+declare 63 {deprecated {No longer in use, changed to macro}} {
     void Tcl_SetLongObj(Tcl_Obj *objPtr, long longValue)
 }
 declare 64 {
@@ -250,10 +250,10 @@ declare 64 {
 declare 65 {
     void Tcl_SetStringObj(Tcl_Obj *objPtr, const char *bytes, int length)
 }
-declare 66 {
+declare 66 {deprecated {No longer in use, changed to macro}} {
     void Tcl_AddErrorInfo(Tcl_Interp *interp, const char *message)
 }
-declare 67 {
+declare 67 {deprecated {No longer in use, changed to macro}} {
     void Tcl_AddObjErrorInfo(Tcl_Interp *interp, const char *message,
 	    int length)
 }
@@ -472,7 +472,7 @@ declare 129 {
 declare 130 {
     int Tcl_EvalFile(Tcl_Interp *interp, const char *fileName)
 }
-declare 131 {
+declare 131 {deprecated {No longer in use, changed to macro}} {
     int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
 }
 declare 132 {
@@ -624,7 +624,7 @@ declare 173 {
 declare 174 {
     const char *Tcl_GetStringResult(Tcl_Interp *interp)
 }
-declare 175 {
+declare 175 {deprecated {No longer in use, changed to macro}} {
     const char *Tcl_GetVar(Tcl_Interp *interp, const char *varName,
 	    int flags)
 }
@@ -635,7 +635,7 @@ declare 176 {
 declare 177 {
     int Tcl_GlobalEval(Tcl_Interp *interp, const char *command)
 }
-declare 178 {
+declare 178 {deprecated {No longer in use, changed to macro}} {
     int Tcl_GlobalEvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
 }
 declare 179 {
@@ -834,7 +834,7 @@ declare 235 {
 declare 236 {
     void Tcl_SetStdChannel(Tcl_Channel channel, int type)
 }
-declare 237 {
+declare 237 {deprecated {No longer in use, changed to macro}} {
     const char *Tcl_SetVar(Tcl_Interp *interp, const char *varName,
 	    const char *newValue, int flags)
 }
@@ -869,7 +869,7 @@ declare 245 {
 declare 246 {deprecated {}} {
     int Tcl_TellOld(Tcl_Channel chan)
 }
-declare 247 {
+declare 247 {deprecated {No longer in use, changed to macro}} {
     int Tcl_TraceVar(Tcl_Interp *interp, const char *varName, int flags,
 	    Tcl_VarTraceProc *proc, ClientData clientData)
 }
@@ -890,14 +890,14 @@ declare 251 {
 declare 252 {
     int Tcl_UnregisterChannel(Tcl_Interp *interp, Tcl_Channel chan)
 }
-declare 253 {
+declare 253 {deprecated {No longer in use, changed to macro}} {
     int Tcl_UnsetVar(Tcl_Interp *interp, const char *varName, int flags)
 }
 declare 254 {
     int Tcl_UnsetVar2(Tcl_Interp *interp, const char *part1, const char *part2,
 	    int flags)
 }
-declare 255 {
+declare 255 {deprecated {No longer in use, changed to macro}} {
     void Tcl_UntraceVar(Tcl_Interp *interp, const char *varName, int flags,
 	    Tcl_VarTraceProc *proc, ClientData clientData)
 }
@@ -909,7 +909,7 @@ declare 256 {
 declare 257 {
     void Tcl_UpdateLinkedVar(Tcl_Interp *interp, const char *varName)
 }
-declare 258 {
+declare 258 {deprecated {No longer in use, changed to macro}} {
     int Tcl_UpVar(Tcl_Interp *interp, const char *frameName,
 	    const char *varName, const char *localName, int flags)
 }
@@ -920,7 +920,7 @@ declare 259 {
 declare 260 {
     int Tcl_VarEval(Tcl_Interp *interp, ...)
 }
-declare 261 {
+declare 261 {deprecated {No longer in use, changed to macro}} {
     ClientData Tcl_VarTraceInfo(Tcl_Interp *interp, const char *varName,
 	    int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData)
 }
@@ -955,7 +955,7 @@ declare 270 {
     const char *Tcl_ParseVar(Tcl_Interp *interp, const char *start,
 	    const char **termPtr)
 }
-declare 271 {
+declare 271 {deprecated {No longer in use, changed to macro}} {
     const char *Tcl_PkgPresent(Tcl_Interp *interp, const char *name,
 	    const char *version, int exact)
 }
@@ -964,12 +964,12 @@ declare 272 {
 	    const char *name, const char *version, int exact,
 	    void *clientDataPtr)
 }
-declare 273 {
+declare 273 {deprecated {No longer in use, changed to macro}} {
     int Tcl_PkgProvide(Tcl_Interp *interp, const char *name,
 	    const char *version)
 }
 # TIP #268: The internally used new Require function is in slot 573.
-declare 274 {
+declare 274 {deprecated {No longer in use, changed to macro}} {
     const char *Tcl_PkgRequire(Tcl_Interp *interp, const char *name,
 	    const char *version, int exact)
 }
@@ -1350,7 +1350,7 @@ declare 380 {
 declare 381 {
     int Tcl_GetUniChar(Tcl_Obj *objPtr, int index)
 }
-declare 382 {
+declare 382 {deprecated {No longer in use, changed to macro}} {
     Tcl_UniChar *Tcl_GetUnicode(Tcl_Obj *objPtr)
 }
 declare 383 {
@@ -2330,9 +2330,30 @@ declare 631 {
 	    ClientData callbackData)
 }
 
-# ----- BASELINE -- FOR -- 8.7.0 ----- #
-
+# TIP #430
+declare 632 {
+    int TclZipfs_Mount(
+    Tcl_Interp *interp,
+    const char *mntpt,
+    const char *zipname,
+    const char *passwd)
+}
+declare 633 {
+    int TclZipfs_Unmount(Tcl_Interp *interp, const char *zipname)
+}
+declare 634 {
+    Tcl_Obj *TclZipfs_TclLibrary(void)
+}
+declare 635 {
+    int TclZipfs_Mount_Buffer(
+    Tcl_Interp *interp,
+    const char *mntpt,
+    unsigned char *data,
+    size_t datalen,
+    int copy)
+}
 
+# ----- BASELINE -- FOR -- 8.7.0 ----- #
 
 ##############################################################################
 
@@ -2379,6 +2400,10 @@ export {
     void Tcl_Main(int argc, char **argv, Tcl_AppInitProc *appInitProc)
 }
 export {
+    void Tcl_MainEx(int argc, char **argv, Tcl_AppInitProc *appInitProc,
+    Tcl_Interp *interp)
+}
+export {
     const char *Tcl_InitStubs(Tcl_Interp *interp, const char *version,
 	int exact)
 }
diff --git a/generic/tcl.h b/generic/tcl.h
index de314fa..2ced16b 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -2396,12 +2396,15 @@ const char *		TclTomMathInitializeStubs(Tcl_Interp *interp,
  */
 
 #define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \
-	    ((Tcl_SetPanicProc(Tcl_ConsolePanic), Tcl_CreateInterp)()))
+	    (((Tcl_SetPanicProc)(Tcl_ConsolePanic), Tcl_CreateInterp)()))
 EXTERN void		Tcl_MainEx(int argc, char **argv,
 			    Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
 EXTERN const char *	Tcl_PkgInitStubsCheck(Tcl_Interp *interp,
 			    const char *version, int exact);
 EXTERN void		Tcl_GetMemoryInfo(Tcl_DString *dsPtr);
+#ifndef _WIN32
+EXTERN int		TclZipfs_AppHook(int *argc, char ***argv);
+#endif
 
 /*
  *----------------------------------------------------------------------------
diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 7368f97..6356a00 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -2253,7 +2253,7 @@ GetListIndexOperand(
     if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &value) != TCL_OK) {
 	return TCL_ERROR;
     }
-     
+
     /* Convert to an integer, advance to the next token and return. */
     /*
      * NOTE: Indexing a list with an index before it yields the
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 9c2736c..da43a5d 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -71,7 +71,18 @@ typedef struct {
 } CancelInfo;
 static Tcl_HashTable cancelTable;
 static int cancelTableInitialized = 0;	/* 0 means not yet initialized. */
-TCL_DECLARE_MUTEX(cancelLock)
+TCL_DECLARE_MUTEX(cancelLock);
+
+/*
+ * Table used to map command implementation functions to a human-readable type
+ * name, for [info type]. The keys in the table are function addresses, and
+ * the values in the table are static char* containing strings in Tcl's
+ * internal encoding (almost UTF-8).
+ */
+
+static Tcl_HashTable commandTypeTable;
+static int commandTypeInit = 0;
+TCL_DECLARE_MUTEX(commandTypeLock);
 
 /*
  * Declarations for managing contexts for non-recursive coroutines. Contexts
@@ -431,6 +442,13 @@ TclFinalizeEvaluation(void)
 	cancelTableInitialized = 0;
     }
     Tcl_MutexUnlock(&cancelLock);
+
+    Tcl_MutexLock(&commandTypeLock);
+    if (commandTypeInit) {
+        Tcl_DeleteHashTable(&commandTypeTable);
+        commandTypeInit = 0;
+    }
+    Tcl_MutexUnlock(&commandTypeLock);
 }
 
 /*
@@ -504,9 +522,23 @@ Tcl_CreateInterp(void)
 	    Tcl_InitHashTable(&cancelTable, TCL_ONE_WORD_KEYS);
 	    cancelTableInitialized = 1;
 	}
+
 	Tcl_MutexUnlock(&cancelLock);
     }
 
+    if (commandTypeInit == 0) {
+        TclRegisterCommandTypeName(TclObjInterpProc, "proc");
+        TclRegisterCommandTypeName(TclEnsembleImplementationCmd, "ensemble");
+        TclRegisterCommandTypeName(TclAliasObjCmd, "alias");
+        TclRegisterCommandTypeName(TclLocalAliasObjCmd, "alias");
+        TclRegisterCommandTypeName(TclSlaveObjCmd, "slave");
+        TclRegisterCommandTypeName(TclInvokeImportedCmd, "import");
+        TclRegisterCommandTypeName(TclOOPublicObjectCmd, "object");
+        TclRegisterCommandTypeName(TclOOPrivateObjectCmd, "privateObject");
+        TclRegisterCommandTypeName(TclOOMyClassObjCmd, "privateClass");
+        TclRegisterCommandTypeName(TclNRInterpCoroutine, "coroutine");
+    }
+
     /*
      * Initialize support for namespaces and create the global namespace
      * (whose name is ""; an alias is "::"). This also initializes the Tcl
@@ -999,6 +1031,9 @@ Tcl_CreateInterp(void)
     if (TclZlibInit(interp) != TCL_OK) {
 	Tcl_Panic("%s", TclGetString(Tcl_GetObjResult(interp)));
     }
+    if (TclZipfs_Init(interp) != TCL_OK) {
+	Tcl_Panic("%s", Tcl_GetString(Tcl_GetObjResult(interp)));
+    }
 #endif
 
     TOP_CB(iPtr) = NULL;
@@ -1015,6 +1050,71 @@ DeleteOpCmdClientData(
 }
 
 /*
+ * ---------------------------------------------------------------------
+ *
+ * TclRegisterCommandTypeName, TclGetCommandTypeName --
+ *
+ *      Command type registration and lookup mechanism. Everything is keyed by
+ *      the Tcl_ObjCmdProc for the command, and that is used as the *key* into
+ *      the hash table that maps to constant strings that are names. (It is
+ *      recommended that those names be ASCII.)
+ *
+ * ---------------------------------------------------------------------
+ */
+
+void
+TclRegisterCommandTypeName(
+    Tcl_ObjCmdProc *implementationProc,
+    const char *nameStr)
+{
+    Tcl_HashEntry *hPtr;
+
+    Tcl_MutexLock(&commandTypeLock);
+    if (commandTypeInit == 0) {
+        Tcl_InitHashTable(&commandTypeTable, TCL_ONE_WORD_KEYS);
+        commandTypeInit = 1;
+    }
+    if (nameStr != NULL) {
+        int isNew;
+
+        hPtr = Tcl_CreateHashEntry(&commandTypeTable,
+                (void *) implementationProc, &isNew);
+        Tcl_SetHashValue(hPtr, (void *) nameStr);
+    } else {
+        hPtr = Tcl_FindHashEntry(&commandTypeTable,
+                (void *) implementationProc);
+        if (hPtr != NULL) {
+            Tcl_DeleteHashEntry(hPtr);
+        }
+    }
+    Tcl_MutexUnlock(&commandTypeLock);
+}
+
+const char *
+TclGetCommandTypeName(
+    Tcl_Command command)
+{
+    Command *cmdPtr = (Command *) command;
+    void *procPtr = cmdPtr->objProc;
+    const char *name = "native";
+
+    if (procPtr == NULL) {
+        procPtr = cmdPtr->nreProc;
+    }
+    Tcl_MutexLock(&commandTypeLock);
+    if (commandTypeInit) {
+        Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&commandTypeTable, procPtr);
+
+        if (hPtr && Tcl_GetHashValue(hPtr)) {
+            name = (const char *) Tcl_GetHashValue(hPtr);
+        }
+    }
+    Tcl_MutexUnlock(&commandTypeLock);
+
+    return name;
+}
+
+/*
  *----------------------------------------------------------------------
  *
  * TclHideUnsafeCommands --
@@ -7513,7 +7613,7 @@ ExprAbsFunc(
 		}
 	    }
 	    goto unChanged;
-	} else if (l == LLONG_MIN) {
+	} else if (l == WIDE_MIN) {
 	    TclInitBignumFromWideInt(&big, l);
 	    goto tooLarge;
 	}
@@ -7638,7 +7738,7 @@ ExprEntierFunc(
 
     if (type == TCL_NUMBER_DOUBLE) {
 	d = *((const double *) ptr);
-	if ((d >= (double)LONG_MAX) || (d <= (double)LONG_MIN)) {
+	if ((d >= (double)WIDE_MAX) || (d <= (double)WIDE_MIN)) {
 	    mp_int big;
 
 	    if (Tcl_InitBignumFromDouble(interp, d, &big) != TCL_OK) {
@@ -7648,9 +7748,9 @@ ExprEntierFunc(
 	    Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big));
 	    return TCL_OK;
 	} else {
-	    long result = (long) d;
+	    Tcl_WideInt result = (Tcl_WideInt) d;
 
-	    Tcl_SetObjResult(interp, Tcl_NewLongObj(result));
+	    Tcl_SetObjResult(interp, Tcl_NewWideIntObj(result));
 	    return TCL_OK;
 	}
     }
@@ -7680,27 +7780,14 @@ ExprIntFunc(
     int objc,			/* Actual parameter count. */
     Tcl_Obj *const *objv)	/* Actual parameter vector. */
 {
-    long iResult;
+    Tcl_WideInt wResult;
     Tcl_Obj *objPtr;
     if (ExprEntierFunc(NULL, interp, objc, objv) != TCL_OK) {
 	return TCL_ERROR;
     }
     objPtr = Tcl_GetObjResult(interp);
-    if (TclGetLongFromObj(NULL, objPtr, &iResult) != TCL_OK) {
-	/*
-	 * Truncate the bignum; keep only bits in long range.
-	 */
-
-	mp_int big;
-
-	Tcl_GetBignumFromObj(NULL, objPtr, &big);
-	mp_mod_2d(&big, (int) CHAR_BIT * sizeof(long), &big);
-	objPtr = Tcl_NewBignumObj(&big);
-	Tcl_IncrRefCount(objPtr);
-	TclGetLongFromObj(NULL, objPtr, &iResult);
-	Tcl_DecrRefCount(objPtr);
-    }
-    Tcl_SetObjResult(interp, Tcl_NewLongObj(iResult));
+    TclGetWideBitsFromObj(NULL, objPtr, &wResult);
+    Tcl_SetObjResult(interp, Tcl_NewLongObj((long)wResult));
     return TCL_OK;
 }
 
@@ -7713,26 +7800,11 @@ ExprWideFunc(
     Tcl_Obj *const *objv)	/* Actual parameter vector. */
 {
     Tcl_WideInt wResult;
-    Tcl_Obj *objPtr;
 
     if (ExprEntierFunc(NULL, interp, objc, objv) != TCL_OK) {
 	return TCL_ERROR;
     }
-    objPtr = Tcl_GetObjResult(interp);
-    if (TclGetWideIntFromObj(NULL, objPtr, &wResult) != TCL_OK) {
-	/*
-	 * Truncate the bignum; keep only bits in wide int range.
-	 */
-
-	mp_int big;
-
-	Tcl_GetBignumFromObj(NULL, objPtr, &big);
-	mp_mod_2d(&big, (int) CHAR_BIT * sizeof(Tcl_WideInt), &big);
-	objPtr = Tcl_NewBignumObj(&big);
-	Tcl_IncrRefCount(objPtr);
-	TclGetWideIntFromObj(NULL, objPtr, &wResult);
-	Tcl_DecrRefCount(objPtr);
-    }
+    TclGetWideBitsFromObj(NULL, Tcl_GetObjResult(interp), &wResult);
     Tcl_SetObjResult(interp, Tcl_NewWideIntObj(wResult));
     return TCL_OK;
 }
@@ -7835,7 +7907,7 @@ ExprRandFunc(
 	 * Make sure 1 <= randSeed <= (2^31) - 2. See below.
 	 */
 
-	iPtr->randSeed &= (unsigned long) 0x7fffffff;
+	iPtr->randSeed &= 0x7fffffff;
 	if ((iPtr->randSeed == 0) || (iPtr->randSeed == 0x7fffffff)) {
 	    iPtr->randSeed ^= 123459876;
 	}
@@ -7979,7 +8051,7 @@ ExprSrandFunc(
     Tcl_Obj *const *objv)	/* Parameter vector. */
 {
     Interp *iPtr = (Interp *) interp;
-    long i = 0;			/* Initialized to avoid compiler warning. */
+    Tcl_WideInt w = 0;			/* Initialized to avoid compiler warning. */
 
     /*
      * Convert argument and use it to reset the seed.
@@ -7990,20 +8062,8 @@ ExprSrandFunc(
 	return TCL_ERROR;
     }
 
-    if (TclGetLongFromObj(NULL, objv[1], &i) != TCL_OK) {
-	Tcl_Obj *objPtr;
-	mp_int big;
-
-	if (Tcl_GetBignumFromObj(interp, objv[1], &big) != TCL_OK) {
-	    /* TODO: more ::errorInfo here? or in caller? */
-	    return TCL_ERROR;
-	}
-
-	mp_mod_2d(&big, (int) CHAR_BIT * sizeof(long), &big);
-	objPtr = Tcl_NewBignumObj(&big);
-	Tcl_IncrRefCount(objPtr);
-	TclGetLongFromObj(NULL, objPtr, &i);
-	Tcl_DecrRefCount(objPtr);
+    if (TclGetWideBitsFromObj(NULL, objv[1], &w) != TCL_OK) {
+	return TCL_ERROR;
     }
 
     /*
@@ -8012,8 +8072,7 @@ ExprSrandFunc(
      */
 
     iPtr->flags |= RAND_SEED_INITIALIZED;
-    iPtr->randSeed = i;
-    iPtr->randSeed &= (unsigned long) 0x7fffffff;
+    iPtr->randSeed = (long) w & 0x7fffffff;
     if ((iPtr->randSeed == 0) || (iPtr->randSeed == 0x7fffffff)) {
 	iPtr->randSeed ^= 123459876;
     }
@@ -8500,18 +8559,12 @@ TclNRTailcallObjCmd(
     if (objc > 1) {
         Tcl_Obj *listPtr, *nsObjPtr;
         Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr;
-        Tcl_Namespace *ns1Ptr;
 
         /* The tailcall data is in a Tcl list: the first element is the
          * namespace, the rest the command to be tailcalled. */
 
-        listPtr = Tcl_NewListObj(objc, objv);
-
         nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1);
-        if ((TCL_OK != TclGetNamespaceFromObj(interp, nsObjPtr, &ns1Ptr))
-                || (nsPtr != ns1Ptr)) {
-            Tcl_Panic("Tailcall failed to find the proper namespace");
-        }
+        listPtr = Tcl_NewListObj(objc, objv);
  	TclListObjSetElement(interp, listPtr, 0, nsObjPtr);
 
         iPtr->varFramePtr->tailcallPtr = listPtr;
diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index cb5a5cb..24f228e 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -1963,7 +1963,6 @@ FormatNumber(
     Tcl_Obj *src,		/* Number to format. */
     unsigned char **cursorPtr)	/* Pointer to index into destination buffer. */
 {
-    long value;
     double dvalue;
     Tcl_WideInt wvalue;
     float fvalue;
@@ -2025,7 +2024,7 @@ FormatNumber(
     case 'w':
     case 'W':
     case 'm':
-	if (Tcl_GetWideIntFromObj(interp, src, &wvalue) != TCL_OK) {
+	if (TclGetWideBitsFromObj(interp, src, &wvalue) != TCL_OK) {
 	    return TCL_ERROR;
 	}
 	if (NeedReversing(type)) {
@@ -2055,19 +2054,19 @@ FormatNumber(
     case 'i':
     case 'I':
     case 'n':
-	if (TclGetLongFromObj(interp, src, &value) != TCL_OK) {
+	if (TclGetWideBitsFromObj(interp, src, &wvalue) != TCL_OK) {
 	    return TCL_ERROR;
 	}
 	if (NeedReversing(type)) {
-	    *(*cursorPtr)++ = UCHAR(value);
-	    *(*cursorPtr)++ = UCHAR(value >> 8);
-	    *(*cursorPtr)++ = UCHAR(value >> 16);
-	    *(*cursorPtr)++ = UCHAR(value >> 24);
+	    *(*cursorPtr)++ = UCHAR(wvalue);
+	    *(*cursorPtr)++ = UCHAR(wvalue >> 8);
+	    *(*cursorPtr)++ = UCHAR(wvalue >> 16);
+	    *(*cursorPtr)++ = UCHAR(wvalue >> 24);
 	} else {
-	    *(*cursorPtr)++ = UCHAR(value >> 24);
-	    *(*cursorPtr)++ = UCHAR(value >> 16);
-	    *(*cursorPtr)++ = UCHAR(value >> 8);
-	    *(*cursorPtr)++ = UCHAR(value);
+	    *(*cursorPtr)++ = UCHAR(wvalue >> 24);
+	    *(*cursorPtr)++ = UCHAR(wvalue >> 16);
+	    *(*cursorPtr)++ = UCHAR(wvalue >> 8);
+	    *(*cursorPtr)++ = UCHAR(wvalue);
 	}
 	return TCL_OK;
 
@@ -2077,15 +2076,15 @@ FormatNumber(
     case 's':
     case 'S':
     case 't':
-	if (TclGetLongFromObj(interp, src, &value) != TCL_OK) {
+	if (TclGetWideBitsFromObj(interp, src, &wvalue) != TCL_OK) {
 	    return TCL_ERROR;
 	}
 	if (NeedReversing(type)) {
-	    *(*cursorPtr)++ = UCHAR(value);
-	    *(*cursorPtr)++ = UCHAR(value >> 8);
+	    *(*cursorPtr)++ = UCHAR(wvalue);
+	    *(*cursorPtr)++ = UCHAR(wvalue >> 8);
 	} else {
-	    *(*cursorPtr)++ = UCHAR(value >> 8);
-	    *(*cursorPtr)++ = UCHAR(value);
+	    *(*cursorPtr)++ = UCHAR(wvalue >> 8);
+	    *(*cursorPtr)++ = UCHAR(wvalue);
 	}
 	return TCL_OK;
 
@@ -2093,10 +2092,10 @@ FormatNumber(
 	 * 8-bit integer values.
 	 */
     case 'c':
-	if (TclGetLongFromObj(interp, src, &value) != TCL_OK) {
+	if (TclGetWideBitsFromObj(interp, src, &wvalue) != TCL_OK) {
 	    return TCL_ERROR;
 	}
-	*(*cursorPtr)++ = UCHAR(value);
+	*(*cursorPtr)++ = UCHAR(wvalue);
 	return TCL_OK;
 
     default:
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 49c8c56..94cb8aa 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -514,63 +514,6 @@ Tcl_ContinueObjCmd(
 }
 
 /*
- *----------------------------------------------------------------------
- *
- * Tcl_EncodingObjCmd --
- *
- *	This command manipulates encodings.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	See the user documentation.
- *
- *----------------------------------------------------------------------
- */
-
-int
-Tcl_EncodingObjCmd(
-    ClientData dummy,		/* Not used. */
-    Tcl_Interp *interp,		/* Current interpreter. */
-    int objc,			/* Number of arguments. */
-    Tcl_Obj *const objv[])	/* Argument objects. */
-{
-    int index;
-
-    static const char *const optionStrings[] = {
-	"convertfrom", "convertto", "dirs", "names", "system",
-	NULL
-    };
-    enum options {
-	ENC_CONVERTFROM, ENC_CONVERTTO, ENC_DIRS, ENC_NAMES, ENC_SYSTEM
-    };
-
-    if (objc < 2) {
-	Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
-	return TCL_ERROR;
-    }
-    if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
-	    &index) != TCL_OK) {
-	return TCL_ERROR;
-    }
-
-    switch ((enum options) index) {
-    case ENC_CONVERTTO:
-	return EncodingConverttoObjCmd(dummy, interp, objc, objv);
-    case ENC_CONVERTFROM:
-	return EncodingConvertfromObjCmd(dummy, interp, objc, objv);
-    case ENC_DIRS:
-	return EncodingDirsObjCmd(dummy, interp, objc, objv);
-    case ENC_NAMES:
-	return EncodingNamesObjCmd(dummy, interp, objc, objv);
-    case ENC_SYSTEM:
-	return EncodingSystemObjCmd(dummy, interp, objc, objv);
-    }
-    return TCL_OK;
-}
-
-/*
  *-----------------------------------------------------------------------------
  *
  * TclInitEncodingCmd --
@@ -1455,9 +1398,9 @@ FileAttrAccessTimeCmd(
 	 * platforms. [Bug 698146]
 	 */
 
-	long newTime;
+	Tcl_WideInt newTime;
 
-	if (TclGetLongFromObj(interp, objv[2], &newTime) != TCL_OK) {
+	if (TclGetWideIntFromObj(interp, objv[2], &newTime) != TCL_OK) {
 	    return TCL_ERROR;
 	}
 
@@ -1536,9 +1479,9 @@ FileAttrModifyTimeCmd(
 	 * platforms. [Bug 698146]
 	 */
 
-	long newTime;
+	Tcl_WideInt newTime;
 
-	if (TclGetLongFromObj(interp, objv[2], &newTime) != TCL_OK) {
+	if (TclGetWideIntFromObj(interp, objv[2], &newTime) != TCL_OK) {
 	    return TCL_ERROR;
 	}
 
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 3d058a4..1dae740 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -138,6 +138,8 @@ static int		InfoScriptCmd(ClientData dummy, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *const objv[]);
 static int		InfoSharedlibCmd(ClientData dummy, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *const objv[]);
+static int		InfoCmdTypeCmd(ClientData dummy, Tcl_Interp *interp,
+			    int objc, Tcl_Obj *const objv[]);
 static int		InfoTclVersionCmd(ClientData dummy, Tcl_Interp *interp,
 			    int objc, Tcl_Obj *const objv[]);
 static SortElement *	MergeLists(SortElement *leftPtr, SortElement *rightPtr,
@@ -156,6 +158,7 @@ static const EnsembleImplMap defaultInfoMap[] = {
     {"args",		   InfoArgsCmd,		    TclCompileBasic1ArgCmd, NULL, NULL, 0},
     {"body",		   InfoBodyCmd,		    TclCompileBasic1ArgCmd, NULL, NULL, 0},
     {"cmdcount",	   InfoCmdCountCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
+    {"cmdtype",		   InfoCmdTypeCmd,	    TclCompileBasic1ArgCmd, NULL, NULL, 1},
     {"commands",	   InfoCommandsCmd,	    TclCompileInfoCommandsCmd, NULL, NULL, 0},
     {"complete",	   InfoCompleteCmd,	    TclCompileBasic1ArgCmd, NULL, NULL, 0},
     {"coroutine",	   TclInfoCoroutineCmd,     TclCompileInfoCoroutineCmd, NULL, NULL, 0},
@@ -2132,6 +2135,60 @@ InfoTclVersionCmd(
 /*
  *----------------------------------------------------------------------
  *
+ * InfoCmdTypeCmd --
+ *
+ *	Called to implement the "info cmdtype" command that returns the type
+ *	of a given command. Handles the following syntax:
+ *
+ *	    info cmdtype cmdName
+ *
+ * Results:
+ *	Returns TCL_OK if successful and TCL_ERROR if there is an error.
+ *
+ * Side effects:
+ *	Returns a type name. If there is an error, the result is an error
+ *	message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InfoCmdTypeCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    Tcl_Command command;
+
+    if (objc != 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "commandName");
+	return TCL_ERROR;
+    }
+    command = Tcl_FindCommand(interp, Tcl_GetString(objv[1]), NULL,
+	    TCL_LEAVE_ERR_MSG);
+    if (command == NULL) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * There's one special case: safe slave interpreters can't see aliases as
+     * aliases as they're part of the security mechanisms.
+     */
+
+    if (Tcl_IsSafe(interp)
+	    && (((Command *) command)->objProc == TclAliasObjCmd)) {
+	Tcl_AppendResult(interp, "native", NULL);
+    } else {
+	Tcl_SetObjResult(interp,
+		Tcl_NewStringObj(TclGetCommandTypeName(command), -1));
+    }
+    return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * Tcl_JoinObjCmd --
  *
  *	This procedure is invoked to process the "join" Tcl command. See the
@@ -2730,21 +2787,10 @@ Tcl_LreplaceObjCmd(
     if (first < 0) {
 	first = 0;
     }
-
-    /*
-     * Complain if the user asked for a start element that is greater than the
-     * list length. This won't ever trigger for the "end-*" case as that will
-     * be properly constrained by TclGetIntForIndex because we use listLen-1
-     * (to allow for replacing the last elem).
-     */
-
-    if ((first >= listLen) && (listLen > 0)) {
-	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		"list doesn't contain element %s", TclGetString(objv[2])));
-	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LREPLACE", "BADIDX",
-		NULL);
-	return TCL_ERROR;
+    if (first > listLen) {
+	first = listLen;
     }
+
     if (last >= listLen) {
 	last = listLen - 1;
     }
@@ -3333,7 +3379,7 @@ Tcl_LsearchObjCmd(
 	 * sense in doing this when the match sense is inverted.
 	 */
 
-	/* 
+	/*
 	 * With -stride, lower, upper and i are kept as multiples of groupSize.
 	 */
 
@@ -4015,7 +4061,7 @@ Tcl_LsortObjCmd(
 		/*
 		 * Do not shrink the actual memory block used; that doesn't
 		 * work with TclStackAlloc-allocated memory. [Bug 2918962]
-		 * 
+		 *
 		 * TODO: Consider a pointer increment to replace this
 		 * array shift.
 		 */
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index d64299e..0bd6cb4 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -1447,6 +1447,9 @@ StringIndexCmd(
 	    char buf[4];
 
 	    length = Tcl_UniCharToUtf(ch, buf);
+	    if (!length) {
+		length = Tcl_UniCharToUtf(-1, buf);
+	    }
 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, length));
 	}
     }
diff --git a/generic/tclCompCmdsGR.c b/generic/tclCompCmdsGR.c
index 858a0c5..f9cf3d8 100644
--- a/generic/tclCompCmdsGR.c
+++ b/generic/tclCompCmdsGR.c
@@ -34,7 +34,7 @@ static int		IndexTailVarIfKnown(Tcl_Interp *interp,
  * TclGetIndexFromToken --
  *
  *	Parse a token to determine if an index value is known at
- *	compile time. 
+ *	compile time.
  *
  * Returns:
  *	TCL_OK if parsing succeeded, and TCL_ERROR if it failed.
@@ -1474,7 +1474,7 @@ TclCompileLreplaceCmd(
 {
     Tcl_Token *tokenPtr, *listTokenPtr;
     DefineLineInformation;	/* TIP #280 */
-    int idx1, idx2, i, offset, offset2;
+    int idx1, idx2, i;
     int emptyPrefix=1, suffixStart = 0;
 
     if (parsePtr->numWords < 4) {
@@ -1495,23 +1495,6 @@ TclCompileLreplaceCmd(
     }
 
     /*
-     * idx1, idx2 are the conventional encoded forms of the tokens parsed
-     * as all forms of index values.  Values of idx1 that come before the
-     * list are treated the same as if they were the start of the list.
-     * Values of idx2 that come after the list are treated the same as if
-     * they were the end of the list.
-     */
-
-    if (idx1 == TCL_INDEX_AFTER) {
-	/*
-	 * [lreplace] treats idx1 value end+1 differently from end+2, etc.
-	 * The operand encoding cannot distinguish them, so we must bail
-	 * out to direct evaluation.
-	 */
-	return TCL_ERROR;
-    }
-
-    /*
      * General structure of the [lreplace] result is
      *		prefix replacement suffix
      * In a few cases we can predict various parts will be empty and
@@ -1522,7 +1505,9 @@ TclCompileLreplaceCmd(
      * we must defer to direct evaluation.
      */
 
-    if (idx2 == TCL_INDEX_BEFORE) {
+    if (idx1 == TCL_INDEX_AFTER) {
+	suffixStart = idx1;
+    } else if (idx2 == TCL_INDEX_BEFORE) {
 	suffixStart = idx1;
     } else if (idx2 == TCL_INDEX_END) {
 	suffixStart = TCL_INDEX_AFTER;
@@ -1553,42 +1538,6 @@ TclCompileLreplaceCmd(
 
 	emptyPrefix = 0;
     }
-     
-    /*
-     * [lreplace] raises an error when idx1 points after the list, but
-     * only when the list is not empty. This is maximum stupidity.
-     *
-     * TODO: TIP this nonsense away!
-     */
-    if (idx1 >= TCL_INDEX_START) {
-	if (emptyPrefix) {
-	    TclEmitOpcode(	INST_DUP,			envPtr);
-	} else {
-	    TclEmitInstInt4(	INST_OVER, 1,			envPtr);
-	}
-	TclEmitOpcode(		INST_LIST_LENGTH,		envPtr);
-	TclEmitOpcode(		INST_DUP,			envPtr);
-	offset = CurrentOffset(envPtr);
-	TclEmitInstInt1(	INST_JUMP_FALSE1, 0,		envPtr);
-
-	/* List is not empty */
-	TclEmitPush(TclAddLiteralObj(envPtr, Tcl_NewIntObj(idx1),
-							NULL),	envPtr);
-	TclEmitOpcode(		INST_GT,			envPtr);
-	offset2 = CurrentOffset(envPtr);
-	TclEmitInstInt1(	INST_JUMP_TRUE1, 0,		envPtr);
-
-	/* Idx1 >= list length ===> raise an error */
-	TclEmitPush(TclAddLiteralObj(envPtr, Tcl_ObjPrintf(
-		"list doesn't contain element %d", idx1), NULL), envPtr);
-	CompileReturnInternal(envPtr, INST_RETURN_IMM, TCL_ERROR, 0,
-		Tcl_ObjPrintf("-errorcode {TCL OPERATION LREPLACE BADIDX}"));
-	TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset,
-		envPtr->codeStart + offset + 1);
-	TclEmitOpcode(		INST_POP,			envPtr);
-	TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset2,
-		envPtr->codeStart + offset2 + 1);
-    }
 
     if ((idx1 == suffixStart) && (parsePtr->numWords == 4)) {
 	/*
diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c
index cf088bb..9434e54 100644
--- a/generic/tclCompCmdsSZ.c
+++ b/generic/tclCompCmdsSZ.c
@@ -1002,13 +1002,13 @@ TclCompileStringReplaceCmd(
     if (parsePtr->numWords < 4 || parsePtr->numWords > 5) {
 	return TCL_ERROR;
     }
- 
+
     /* Bytecode to compute/push string argument being replaced */
     valueTokenPtr = TokenAfter(parsePtr->tokenPtr);
     CompileWord(envPtr, valueTokenPtr, interp, 1);
 
     /*
-     * Check for first index known and useful at compile time. 
+     * Check for first index known and useful at compile time.
      */
     tokenPtr = TokenAfter(valueTokenPtr);
     if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_BEFORE, TCL_INDEX_AFTER,
@@ -1017,7 +1017,7 @@ TclCompileStringReplaceCmd(
     }
 
     /*
-     * Check for last index known and useful at compile time. 
+     * Check for last index known and useful at compile time.
      */
     tokenPtr = TokenAfter(tokenPtr);
     if (TclGetIndexFromToken(tokenPtr, TCL_INDEX_BEFORE, TCL_INDEX_AFTER,
@@ -1025,7 +1025,7 @@ TclCompileStringReplaceCmd(
 	goto genericReplace;
     }
 
-    /* 
+    /*
      * [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
@@ -1108,12 +1108,12 @@ TclCompileStringReplaceCmd(
      * 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_BEFORE)
      * or (last == TCL_INDEX_AFTER). These also permit simplification
      * of the prefix|replace|suffix construction. The other constraints,
-     * though, interfere with getting a guarantee that first <= last. 
+     * though, interfere with getting a guarantee that first <= last.
      */
 
     if ((first == TCL_INDEX_BEFORE) && (last >= TCL_INDEX_START)) {
@@ -1141,7 +1141,7 @@ TclCompileStringReplaceCmd(
 	/* 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.
diff --git a/generic/tclDate.c b/generic/tclDate.c
index e4dd000..717a1b3 100644
--- a/generic/tclDate.c
+++ b/generic/tclDate.c
@@ -1348,7 +1348,7 @@ yyparse (info)
 int yychar;
 
 /* The semantic value of the look-ahead symbol.  */
-YYSTYPE yylval;
+YYSTYPE yylval = {0};
 
 /* Number of syntax errors so far.  */
 int yynerrs;
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 592d945..3fb5355 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -119,7 +119,8 @@ EXTERN void		Tcl_DbIncrRefCount(Tcl_Obj *objPtr, const char *file,
 EXTERN int		Tcl_DbIsShared(Tcl_Obj *objPtr, const char *file,
 				int line);
 /* 22 */
-EXTERN Tcl_Obj *	Tcl_DbNewBooleanObj(int boolValue, const char *file,
+TCL_DEPRECATED("No longer in use, changed to macro")
+Tcl_Obj *		Tcl_DbNewBooleanObj(int boolValue, const char *file,
 				int line);
 /* 23 */
 EXTERN Tcl_Obj *	Tcl_DbNewByteArrayObj(const unsigned char *bytes,
@@ -131,7 +132,8 @@ EXTERN Tcl_Obj *	Tcl_DbNewDoubleObj(double doubleValue,
 EXTERN Tcl_Obj *	Tcl_DbNewListObj(int objc, Tcl_Obj *const *objv,
 				const char *file, int line);
 /* 26 */
-EXTERN Tcl_Obj *	Tcl_DbNewLongObj(long longValue, const char *file,
+TCL_DEPRECATED("No longer in use, changed to macro")
+Tcl_Obj *		Tcl_DbNewLongObj(long longValue, const char *file,
 				int line);
 /* 27 */
 EXTERN Tcl_Obj *	Tcl_DbNewObj(const char *file, int line);
@@ -158,7 +160,8 @@ EXTERN int		Tcl_GetDouble(Tcl_Interp *interp, const char *src,
 EXTERN int		Tcl_GetDoubleFromObj(Tcl_Interp *interp,
 				Tcl_Obj *objPtr, double *doublePtr);
 /* 36 */
-EXTERN int		Tcl_GetIndexFromObj(Tcl_Interp *interp,
+TCL_DEPRECATED("No longer in use, changed to macro")
+int			Tcl_GetIndexFromObj(Tcl_Interp *interp,
 				Tcl_Obj *objPtr, const char *const *tablePtr,
 				const char *msg, int flags, int *indexPtr);
 /* 37 */
@@ -198,24 +201,28 @@ EXTERN int		Tcl_ListObjReplace(Tcl_Interp *interp,
 				Tcl_Obj *listPtr, int first, int count,
 				int objc, Tcl_Obj *const objv[]);
 /* 49 */
-EXTERN Tcl_Obj *	Tcl_NewBooleanObj(int boolValue);
+TCL_DEPRECATED("No longer in use, changed to macro")
+Tcl_Obj *		Tcl_NewBooleanObj(int boolValue);
 /* 50 */
 EXTERN Tcl_Obj *	Tcl_NewByteArrayObj(const unsigned char *bytes,
 				int length);
 /* 51 */
 EXTERN Tcl_Obj *	Tcl_NewDoubleObj(double doubleValue);
 /* 52 */
-EXTERN Tcl_Obj *	Tcl_NewIntObj(int intValue);
+TCL_DEPRECATED("No longer in use, changed to macro")
+Tcl_Obj *		Tcl_NewIntObj(int intValue);
 /* 53 */
 EXTERN Tcl_Obj *	Tcl_NewListObj(int objc, Tcl_Obj *const objv[]);
 /* 54 */
-EXTERN Tcl_Obj *	Tcl_NewLongObj(long longValue);
+TCL_DEPRECATED("No longer in use, changed to macro")
+Tcl_Obj *		Tcl_NewLongObj(long longValue);
 /* 55 */
 EXTERN Tcl_Obj *	Tcl_NewObj(void);
 /* 56 */
 EXTERN Tcl_Obj *	Tcl_NewStringObj(const char *bytes, int length);
 /* 57 */
-EXTERN void		Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue);
+TCL_DEPRECATED("No longer in use, changed to macro")
+void			Tcl_SetBooleanObj(Tcl_Obj *objPtr, int boolValue);
 /* 58 */
 EXTERN unsigned char *	Tcl_SetByteArrayLength(Tcl_Obj *objPtr, int length);
 /* 59 */
@@ -224,22 +231,26 @@ EXTERN void		Tcl_SetByteArrayObj(Tcl_Obj *objPtr,
 /* 60 */
 EXTERN void		Tcl_SetDoubleObj(Tcl_Obj *objPtr, double doubleValue);
 /* 61 */
-EXTERN void		Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue);
+TCL_DEPRECATED("No longer in use, changed to macro")
+void			Tcl_SetIntObj(Tcl_Obj *objPtr, int intValue);
 /* 62 */
 EXTERN void		Tcl_SetListObj(Tcl_Obj *objPtr, int objc,
 				Tcl_Obj *const objv[]);
 /* 63 */
-EXTERN void		Tcl_SetLongObj(Tcl_Obj *objPtr, long longValue);
+TCL_DEPRECATED("No longer in use, changed to macro")
+void			Tcl_SetLongObj(Tcl_Obj *objPtr, long longValue);
 /* 64 */
 EXTERN void		Tcl_SetObjLength(Tcl_Obj *objPtr, int length);
 /* 65 */
 EXTERN void		Tcl_SetStringObj(Tcl_Obj *objPtr, const char *bytes,
 				int length);
 /* 66 */
-EXTERN void		Tcl_AddErrorInfo(Tcl_Interp *interp,
+TCL_DEPRECATED("No longer in use, changed to macro")
+void			Tcl_AddErrorInfo(Tcl_Interp *interp,
 				const char *message);
 /* 67 */
-EXTERN void		Tcl_AddObjErrorInfo(Tcl_Interp *interp,
+TCL_DEPRECATED("No longer in use, changed to macro")
+void			Tcl_AddObjErrorInfo(Tcl_Interp *interp,
 				const char *message, int length);
 /* 68 */
 EXTERN void		Tcl_AllowExceptions(Tcl_Interp *interp);
@@ -422,7 +433,8 @@ EXTERN int		Tcl_Eval(Tcl_Interp *interp, const char *script);
 EXTERN int		Tcl_EvalFile(Tcl_Interp *interp,
 				const char *fileName);
 /* 131 */
-EXTERN int		Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
+TCL_DEPRECATED("No longer in use, changed to macro")
+int			Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
 /* 132 */
 EXTERN void		Tcl_EventuallyFree(ClientData clientData,
 				Tcl_FreeProc *freeProc);
@@ -549,7 +561,8 @@ EXTERN Tcl_Channel	Tcl_GetStdChannel(int type);
 /* 174 */
 EXTERN const char *	Tcl_GetStringResult(Tcl_Interp *interp);
 /* 175 */
-EXTERN const char *	Tcl_GetVar(Tcl_Interp *interp, const char *varName,
+TCL_DEPRECATED("No longer in use, changed to macro")
+const char *		Tcl_GetVar(Tcl_Interp *interp, const char *varName,
 				int flags);
 /* 176 */
 EXTERN const char *	Tcl_GetVar2(Tcl_Interp *interp, const char *part1,
@@ -558,7 +571,8 @@ EXTERN const char *	Tcl_GetVar2(Tcl_Interp *interp, const char *part1,
 EXTERN int		Tcl_GlobalEval(Tcl_Interp *interp,
 				const char *command);
 /* 178 */
-EXTERN int		Tcl_GlobalEvalObj(Tcl_Interp *interp,
+TCL_DEPRECATED("No longer in use, changed to macro")
+int			Tcl_GlobalEvalObj(Tcl_Interp *interp,
 				Tcl_Obj *objPtr);
 /* 179 */
 EXTERN int		Tcl_HideCommand(Tcl_Interp *interp,
@@ -713,7 +727,8 @@ EXTERN void		Tcl_SetObjResult(Tcl_Interp *interp,
 /* 236 */
 EXTERN void		Tcl_SetStdChannel(Tcl_Channel channel, int type);
 /* 237 */
-EXTERN const char *	Tcl_SetVar(Tcl_Interp *interp, const char *varName,
+TCL_DEPRECATED("No longer in use, changed to macro")
+const char *		Tcl_SetVar(Tcl_Interp *interp, const char *varName,
 				const char *newValue, int flags);
 /* 238 */
 EXTERN const char *	Tcl_SetVar2(Tcl_Interp *interp, const char *part1,
@@ -743,7 +758,8 @@ EXTERN int		Tcl_StringMatch(const char *str, const char *pattern);
 TCL_DEPRECATED("")
 int			Tcl_TellOld(Tcl_Channel chan);
 /* 247 */
-EXTERN int		Tcl_TraceVar(Tcl_Interp *interp, const char *varName,
+TCL_DEPRECATED("No longer in use, changed to macro")
+int			Tcl_TraceVar(Tcl_Interp *interp, const char *varName,
 				int flags, Tcl_VarTraceProc *proc,
 				ClientData clientData);
 /* 248 */
@@ -764,13 +780,15 @@ EXTERN void		Tcl_UnlinkVar(Tcl_Interp *interp,
 EXTERN int		Tcl_UnregisterChannel(Tcl_Interp *interp,
 				Tcl_Channel chan);
 /* 253 */
-EXTERN int		Tcl_UnsetVar(Tcl_Interp *interp, const char *varName,
+TCL_DEPRECATED("No longer in use, changed to macro")
+int			Tcl_UnsetVar(Tcl_Interp *interp, const char *varName,
 				int flags);
 /* 254 */
 EXTERN int		Tcl_UnsetVar2(Tcl_Interp *interp, const char *part1,
 				const char *part2, int flags);
 /* 255 */
-EXTERN void		Tcl_UntraceVar(Tcl_Interp *interp,
+TCL_DEPRECATED("No longer in use, changed to macro")
+void			Tcl_UntraceVar(Tcl_Interp *interp,
 				const char *varName, int flags,
 				Tcl_VarTraceProc *proc,
 				ClientData clientData);
@@ -783,7 +801,8 @@ EXTERN void		Tcl_UntraceVar2(Tcl_Interp *interp,
 EXTERN void		Tcl_UpdateLinkedVar(Tcl_Interp *interp,
 				const char *varName);
 /* 258 */
-EXTERN int		Tcl_UpVar(Tcl_Interp *interp, const char *frameName,
+TCL_DEPRECATED("No longer in use, changed to macro")
+int			Tcl_UpVar(Tcl_Interp *interp, const char *frameName,
 				const char *varName, const char *localName,
 				int flags);
 /* 259 */
@@ -793,7 +812,8 @@ EXTERN int		Tcl_UpVar2(Tcl_Interp *interp, const char *frameName,
 /* 260 */
 EXTERN int		Tcl_VarEval(Tcl_Interp *interp, ...);
 /* 261 */
-EXTERN ClientData	Tcl_VarTraceInfo(Tcl_Interp *interp,
+TCL_DEPRECATED("No longer in use, changed to macro")
+ClientData		Tcl_VarTraceInfo(Tcl_Interp *interp,
 				const char *varName, int flags,
 				Tcl_VarTraceProc *procPtr,
 				ClientData prevClientData);
@@ -825,17 +845,20 @@ EXTERN char *		Tcl_HashStats(Tcl_HashTable *tablePtr);
 EXTERN const char *	Tcl_ParseVar(Tcl_Interp *interp, const char *start,
 				const char **termPtr);
 /* 271 */
-EXTERN const char *	Tcl_PkgPresent(Tcl_Interp *interp, const char *name,
+TCL_DEPRECATED("No longer in use, changed to macro")
+const char *		Tcl_PkgPresent(Tcl_Interp *interp, const char *name,
 				const char *version, int exact);
 /* 272 */
 EXTERN const char *	Tcl_PkgPresentEx(Tcl_Interp *interp,
 				const char *name, const char *version,
 				int exact, void *clientDataPtr);
 /* 273 */
-EXTERN int		Tcl_PkgProvide(Tcl_Interp *interp, const char *name,
+TCL_DEPRECATED("No longer in use, changed to macro")
+int			Tcl_PkgProvide(Tcl_Interp *interp, const char *name,
 				const char *version);
 /* 274 */
-EXTERN const char *	Tcl_PkgRequire(Tcl_Interp *interp, const char *name,
+TCL_DEPRECATED("No longer in use, changed to macro")
+const char *		Tcl_PkgRequire(Tcl_Interp *interp, const char *name,
 				const char *version, int exact);
 /* 275 */
 TCL_DEPRECATED("see TIP #422")
@@ -1125,7 +1148,8 @@ EXTERN int		Tcl_GetCharLength(Tcl_Obj *objPtr);
 /* 381 */
 EXTERN int		Tcl_GetUniChar(Tcl_Obj *objPtr, int index);
 /* 382 */
-EXTERN Tcl_UniChar *	Tcl_GetUnicode(Tcl_Obj *objPtr);
+TCL_DEPRECATED("No longer in use, changed to macro")
+Tcl_UniChar *		Tcl_GetUnicode(Tcl_Obj *objPtr);
 /* 383 */
 EXTERN Tcl_Obj *	Tcl_GetRange(Tcl_Obj *objPtr, int first, int last);
 /* 384 */
@@ -1838,6 +1862,18 @@ EXTERN Tcl_Channel	Tcl_OpenTcpServerEx(Tcl_Interp *interp,
 				unsigned int flags,
 				Tcl_TcpAcceptProc *acceptProc,
 				ClientData callbackData);
+/* 632 */
+EXTERN int		TclZipfs_Mount(Tcl_Interp *interp, const char *mntpt,
+				const char *zipname, const char *passwd);
+/* 633 */
+EXTERN int		TclZipfs_Unmount(Tcl_Interp *interp,
+				const char *zipname);
+/* 634 */
+EXTERN Tcl_Obj *	TclZipfs_TclLibrary(void);
+/* 635 */
+EXTERN int		TclZipfs_Mount_Buffer(Tcl_Interp *interp,
+				const char *mntpt, unsigned char *data,
+				size_t datalen, int copy);
 
 typedef struct {
     const struct TclPlatStubs *tclPlatStubs;
@@ -1887,11 +1923,11 @@ typedef struct TclStubs {
     void (*tcl_DbDecrRefCount) (Tcl_Obj *objPtr, const char *file, int line); /* 19 */
     void (*tcl_DbIncrRefCount) (Tcl_Obj *objPtr, const char *file, int line); /* 20 */
     int (*tcl_DbIsShared) (Tcl_Obj *objPtr, const char *file, int line); /* 21 */
-    Tcl_Obj * (*tcl_DbNewBooleanObj) (int boolValue, const char *file, int line); /* 22 */
+    TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_Obj * (*tcl_DbNewBooleanObj) (int boolValue, const char *file, int line); /* 22 */
     Tcl_Obj * (*tcl_DbNewByteArrayObj) (const unsigned char *bytes, int length, const char *file, int line); /* 23 */
     Tcl_Obj * (*tcl_DbNewDoubleObj) (double doubleValue, const char *file, int line); /* 24 */
     Tcl_Obj * (*tcl_DbNewListObj) (int objc, Tcl_Obj *const *objv, const char *file, int line); /* 25 */
-    Tcl_Obj * (*tcl_DbNewLongObj) (long longValue, const char *file, int line); /* 26 */
+    TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_Obj * (*tcl_DbNewLongObj) (long longValue, const char *file, int line); /* 26 */
     Tcl_Obj * (*tcl_DbNewObj) (const char *file, int line); /* 27 */
     Tcl_Obj * (*tcl_DbNewStringObj) (const char *bytes, int length, const char *file, int line); /* 28 */
     Tcl_Obj * (*tcl_DuplicateObj) (Tcl_Obj *objPtr); /* 29 */
@@ -1901,7 +1937,7 @@ typedef struct TclStubs {
     unsigned char * (*tcl_GetByteArrayFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 33 */
     int (*tcl_GetDouble) (Tcl_Interp *interp, const char *src, double *doublePtr); /* 34 */
     int (*tcl_GetDoubleFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr); /* 35 */
-    int (*tcl_GetIndexFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, const char *const *tablePtr, const char *msg, int flags, int *indexPtr); /* 36 */
+    TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_GetIndexFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, const char *const *tablePtr, const char *msg, int flags, int *indexPtr); /* 36 */
     int (*tcl_GetInt) (Tcl_Interp *interp, const char *src, int *intPtr); /* 37 */
     int (*tcl_GetIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr); /* 38 */
     int (*tcl_GetLongFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr); /* 39 */
@@ -1914,25 +1950,25 @@ typedef struct TclStubs {
     int (*tcl_ListObjIndex) (Tcl_Interp *interp, Tcl_Obj *listPtr, int index, Tcl_Obj **objPtrPtr); /* 46 */
     int (*tcl_ListObjLength) (Tcl_Interp *interp, Tcl_Obj *listPtr, int *lengthPtr); /* 47 */
     int (*tcl_ListObjReplace) (Tcl_Interp *interp, Tcl_Obj *listPtr, int first, int count, int objc, Tcl_Obj *const objv[]); /* 48 */
-    Tcl_Obj * (*tcl_NewBooleanObj) (int boolValue); /* 49 */
+    TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_Obj * (*tcl_NewBooleanObj) (int boolValue); /* 49 */
     Tcl_Obj * (*tcl_NewByteArrayObj) (const unsigned char *bytes, int length); /* 50 */
     Tcl_Obj * (*tcl_NewDoubleObj) (double doubleValue); /* 51 */
-    Tcl_Obj * (*tcl_NewIntObj) (int intValue); /* 52 */
+    TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_Obj * (*tcl_NewIntObj) (int intValue); /* 52 */
     Tcl_Obj * (*tcl_NewListObj) (int objc, Tcl_Obj *const objv[]); /* 53 */
-    Tcl_Obj * (*tcl_NewLongObj) (long longValue); /* 54 */
+    TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_Obj * (*tcl_NewLongObj) (long longValue); /* 54 */
     Tcl_Obj * (*tcl_NewObj) (void); /* 55 */
     Tcl_Obj * (*tcl_NewStringObj) (const char *bytes, int length); /* 56 */
-    void (*tcl_SetBooleanObj) (Tcl_Obj *objPtr, int boolValue); /* 57 */
+    TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_SetBooleanObj) (Tcl_Obj *objPtr, int boolValue); /* 57 */
     unsigned char * (*tcl_SetByteArrayLength) (Tcl_Obj *objPtr, int length); /* 58 */
     void (*tcl_SetByteArrayObj) (Tcl_Obj *objPtr, const unsigned char *bytes, int length); /* 59 */
     void (*tcl_SetDoubleObj) (Tcl_Obj *objPtr, double doubleValue); /* 60 */
-    void (*tcl_SetIntObj) (Tcl_Obj *objPtr, int intValue); /* 61 */
+    TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_SetIntObj) (Tcl_Obj *objPtr, int intValue); /* 61 */
     void (*tcl_SetListObj) (Tcl_Obj *objPtr, int objc, Tcl_Obj *const objv[]); /* 62 */
-    void (*tcl_SetLongObj) (Tcl_Obj *objPtr, long longValue); /* 63 */
+    TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_SetLongObj) (Tcl_Obj *objPtr, long longValue); /* 63 */
     void (*tcl_SetObjLength) (Tcl_Obj *objPtr, int length); /* 64 */
     void (*tcl_SetStringObj) (Tcl_Obj *objPtr, const char *bytes, int length); /* 65 */
-    void (*tcl_AddErrorInfo) (Tcl_Interp *interp, const char *message); /* 66 */
-    void (*tcl_AddObjErrorInfo) (Tcl_Interp *interp, const char *message, int length); /* 67 */
+    TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_AddErrorInfo) (Tcl_Interp *interp, const char *message); /* 66 */
+    TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_AddObjErrorInfo) (Tcl_Interp *interp, const char *message, int length); /* 67 */
     void (*tcl_AllowExceptions) (Tcl_Interp *interp); /* 68 */
     void (*tcl_AppendElement) (Tcl_Interp *interp, const char *element); /* 69 */
     void (*tcl_AppendResult) (Tcl_Interp *interp, ...); /* 70 */
@@ -1996,7 +2032,7 @@ typedef struct TclStubs {
     const char * (*tcl_ErrnoMsg) (int err); /* 128 */
     int (*tcl_Eval) (Tcl_Interp *interp, const char *script); /* 129 */
     int (*tcl_EvalFile) (Tcl_Interp *interp, const char *fileName); /* 130 */
-    int (*tcl_EvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 131 */
+    TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_EvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 131 */
     void (*tcl_EventuallyFree) (ClientData clientData, Tcl_FreeProc *freeProc); /* 132 */
     TCL_NORETURN1 void (*tcl_Exit) (int status); /* 133 */
     int (*tcl_ExposeCommand) (Tcl_Interp *interp, const char *hiddenCmdToken, const char *cmdName); /* 134 */
@@ -2048,10 +2084,10 @@ typedef struct TclStubs {
     Tcl_Interp * (*tcl_GetSlave) (Tcl_Interp *interp, const char *slaveName); /* 172 */
     Tcl_Channel (*tcl_GetStdChannel) (int type); /* 173 */
     const char * (*tcl_GetStringResult) (Tcl_Interp *interp); /* 174 */
-    const char * (*tcl_GetVar) (Tcl_Interp *interp, const char *varName, int flags); /* 175 */
+    TCL_DEPRECATED_API("No longer in use, changed to macro") const char * (*tcl_GetVar) (Tcl_Interp *interp, const char *varName, int flags); /* 175 */
     const char * (*tcl_GetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 176 */
     int (*tcl_GlobalEval) (Tcl_Interp *interp, const char *command); /* 177 */
-    int (*tcl_GlobalEvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 178 */
+    TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_GlobalEvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 178 */
     int (*tcl_HideCommand) (Tcl_Interp *interp, const char *cmdName, const char *hiddenCmdToken); /* 179 */
     int (*tcl_Init) (Tcl_Interp *interp); /* 180 */
     void (*tcl_InitHashTable) (Tcl_HashTable *tablePtr, int keyType); /* 181 */
@@ -2110,7 +2146,7 @@ typedef struct TclStubs {
     void (*tcl_SetObjErrorCode) (Tcl_Interp *interp, Tcl_Obj *errorObjPtr); /* 234 */
     void (*tcl_SetObjResult) (Tcl_Interp *interp, Tcl_Obj *resultObjPtr); /* 235 */
     void (*tcl_SetStdChannel) (Tcl_Channel channel, int type); /* 236 */
-    const char * (*tcl_SetVar) (Tcl_Interp *interp, const char *varName, const char *newValue, int flags); /* 237 */
+    TCL_DEPRECATED_API("No longer in use, changed to macro") const char * (*tcl_SetVar) (Tcl_Interp *interp, const char *varName, const char *newValue, int flags); /* 237 */
     const char * (*tcl_SetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, const char *newValue, int flags); /* 238 */
     const char * (*tcl_SignalId) (int sig); /* 239 */
     const char * (*tcl_SignalMsg) (int sig); /* 240 */
@@ -2120,21 +2156,21 @@ typedef struct TclStubs {
     void (*tcl_StaticPackage) (Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 244 */
     int (*tcl_StringMatch) (const char *str, const char *pattern); /* 245 */
     TCL_DEPRECATED_API("") int (*tcl_TellOld) (Tcl_Channel chan); /* 246 */
-    int (*tcl_TraceVar) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 247 */
+    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 */
     int (*tcl_TraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 248 */
     char * (*tcl_TranslateFileName) (Tcl_Interp *interp, const char *name, Tcl_DString *bufferPtr); /* 249 */
     int (*tcl_Ungets) (Tcl_Channel chan, const char *str, int len, int atHead); /* 250 */
     void (*tcl_UnlinkVar) (Tcl_Interp *interp, const char *varName); /* 251 */
     int (*tcl_UnregisterChannel) (Tcl_Interp *interp, Tcl_Channel chan); /* 252 */
-    int (*tcl_UnsetVar) (Tcl_Interp *interp, const char *varName, int flags); /* 253 */
+    TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_UnsetVar) (Tcl_Interp *interp, const char *varName, int flags); /* 253 */
     int (*tcl_UnsetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 254 */
-    void (*tcl_UntraceVar) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 255 */
+    TCL_DEPRECATED_API("No longer in use, changed to macro") void (*tcl_UntraceVar) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 255 */
     void (*tcl_UntraceVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData); /* 256 */
     void (*tcl_UpdateLinkedVar) (Tcl_Interp *interp, const char *varName); /* 257 */
-    int (*tcl_UpVar) (Tcl_Interp *interp, const char *frameName, const char *varName, const char *localName, int flags); /* 258 */
+    TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_UpVar) (Tcl_Interp *interp, const char *frameName, const char *varName, const char *localName, int flags); /* 258 */
     int (*tcl_UpVar2) (Tcl_Interp *interp, const char *frameName, const char *part1, const char *part2, const char *localName, int flags); /* 259 */
     int (*tcl_VarEval) (Tcl_Interp *interp, ...); /* 260 */
-    ClientData (*tcl_VarTraceInfo) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData); /* 261 */
+    TCL_DEPRECATED_API("No longer in use, changed to macro") ClientData (*tcl_VarTraceInfo) (Tcl_Interp *interp, const char *varName, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData); /* 261 */
     ClientData (*tcl_VarTraceInfo2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData); /* 262 */
     int (*tcl_Write) (Tcl_Channel chan, const char *s, int slen); /* 263 */
     void (*tcl_WrongNumArgs) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], const char *message); /* 264 */
@@ -2144,10 +2180,10 @@ typedef struct TclStubs {
     TCL_DEPRECATED_API("see TIP #422") void (*tcl_AppendStringsToObjVA) (Tcl_Obj *objPtr, va_list argList); /* 268 */
     char * (*tcl_HashStats) (Tcl_HashTable *tablePtr); /* 269 */
     const char * (*tcl_ParseVar) (Tcl_Interp *interp, const char *start, const char **termPtr); /* 270 */
-    const char * (*tcl_PkgPresent) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 271 */
+    TCL_DEPRECATED_API("No longer in use, changed to macro") const char * (*tcl_PkgPresent) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 271 */
     const char * (*tcl_PkgPresentEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 272 */
-    int (*tcl_PkgProvide) (Tcl_Interp *interp, const char *name, const char *version); /* 273 */
-    const char * (*tcl_PkgRequire) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 274 */
+    TCL_DEPRECATED_API("No longer in use, changed to macro") int (*tcl_PkgProvide) (Tcl_Interp *interp, const char *name, const char *version); /* 273 */
+    TCL_DEPRECATED_API("No longer in use, changed to macro") const char * (*tcl_PkgRequire) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 274 */
     TCL_DEPRECATED_API("see TIP #422") void (*tcl_SetErrorCodeVA) (Tcl_Interp *interp, va_list argList); /* 275 */
     TCL_DEPRECATED_API("see TIP #422") int (*tcl_VarEvalVA) (Tcl_Interp *interp, va_list argList); /* 276 */
     Tcl_Pid (*tcl_WaitPid) (Tcl_Pid pid, int *statPtr, int options); /* 277 */
@@ -2255,7 +2291,7 @@ typedef struct TclStubs {
     void (*tcl_SetUnicodeObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int numChars); /* 379 */
     int (*tcl_GetCharLength) (Tcl_Obj *objPtr); /* 380 */
     int (*tcl_GetUniChar) (Tcl_Obj *objPtr, int index); /* 381 */
-    Tcl_UniChar * (*tcl_GetUnicode) (Tcl_Obj *objPtr); /* 382 */
+    TCL_DEPRECATED_API("No longer in use, changed to macro") Tcl_UniChar * (*tcl_GetUnicode) (Tcl_Obj *objPtr); /* 382 */
     Tcl_Obj * (*tcl_GetRange) (Tcl_Obj *objPtr, int first, int last); /* 383 */
     void (*tcl_AppendUnicodeToObj) (Tcl_Obj *objPtr, const Tcl_UniChar *unicode, int length); /* 384 */
     int (*tcl_RegExpMatchObj) (Tcl_Interp *interp, Tcl_Obj *textObj, Tcl_Obj *patternObj); /* 385 */
@@ -2505,6 +2541,10 @@ typedef struct TclStubs {
     int (*tcl_FSUnloadFile) (Tcl_Interp *interp, Tcl_LoadHandle handlePtr); /* 629 */
     void (*tcl_ZlibStreamSetCompressionDictionary) (Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); /* 630 */
     Tcl_Channel (*tcl_OpenTcpServerEx) (Tcl_Interp *interp, const char *service, const char *host, unsigned int flags, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData); /* 631 */
+    int (*tclZipfs_Mount) (Tcl_Interp *interp, const char *mntpt, const char *zipname, const char *passwd); /* 632 */
+    int (*tclZipfs_Unmount) (Tcl_Interp *interp, const char *zipname); /* 633 */
+    Tcl_Obj * (*tclZipfs_TclLibrary) (void); /* 634 */
+    int (*tclZipfs_Mount_Buffer) (Tcl_Interp *interp, const char *mntpt, unsigned char *data, size_t datalen, int copy); /* 635 */
 } TclStubs;
 
 extern const TclStubs *tclStubsPtr;
@@ -3799,6 +3839,14 @@ extern const TclStubs *tclStubsPtr;
 	(tclStubsPtr->tcl_ZlibStreamSetCompressionDictionary) /* 630 */
 #define Tcl_OpenTcpServerEx \
 	(tclStubsPtr->tcl_OpenTcpServerEx) /* 631 */
+#define TclZipfs_Mount \
+	(tclStubsPtr->tclZipfs_Mount) /* 632 */
+#define TclZipfs_Unmount \
+	(tclStubsPtr->tclZipfs_Unmount) /* 633 */
+#define TclZipfs_TclLibrary \
+	(tclStubsPtr->tclZipfs_TclLibrary) /* 634 */
+#define TclZipfs_Mount_Buffer \
+	(tclStubsPtr->tclZipfs_Mount_Buffer) /* 635 */
 
 #endif /* defined(USE_TCL_STUBS) */
 
@@ -3810,15 +3858,12 @@ extern const TclStubs *tclStubsPtr;
 #   undef Tcl_GetStringResult
 #   undef Tcl_Init
 #   undef Tcl_SetPanicProc
-#   undef Tcl_SetVar
 #   undef Tcl_ObjSetVar2
 #   undef Tcl_StaticPackage
 #   define Tcl_CreateInterp() (tclStubsPtr->tcl_CreateInterp())
 #   define Tcl_GetStringResult(interp) (tclStubsPtr->tcl_GetStringResult(interp))
 #   define Tcl_Init(interp) (tclStubsPtr->tcl_Init(interp))
 #   define Tcl_SetPanicProc(proc) (tclStubsPtr->tcl_SetPanicProc(proc))
-#   define Tcl_SetVar(interp, varName, newValue, flags) \
-	    (tclStubsPtr->tcl_SetVar(interp, varName, newValue, flags))
 #   define Tcl_ObjSetVar2(interp, part1, part2, newValue, flags) \
 	    (tclStubsPtr->tcl_ObjSetVar2(interp, part1, part2, newValue, flags))
 #endif
@@ -3828,6 +3873,7 @@ extern const TclStubs *tclStubsPtr;
 #   define Tcl_MainEx Tcl_MainExW
     EXTERN void Tcl_MainExW(int argc, wchar_t **argv,
 	    Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
+    EXTERN int		TclZipfs_AppHook(int *argc, wchar_t ***argv);
 #endif
 
 #undef TCL_STORAGE_CLASS
@@ -3974,9 +4020,11 @@ extern const TclStubs *tclStubsPtr;
 #undef Tcl_DbNewLongObj
 #define Tcl_DbNewLongObj(value, file, line) Tcl_DbNewWideIntObj((long)(value), file, line)
 #undef Tcl_SetIntObj
-#define Tcl_SetIntObj(objPtr, value)	Tcl_SetWideIntObj(objPtr, (int)(value))
+#define Tcl_SetIntObj(objPtr, value)	Tcl_SetWideIntObj((objPtr), (int)(value))
 #undef Tcl_SetLongObj
-#define Tcl_SetLongObj(objPtr, value)	Tcl_SetWideIntObj(objPtr, (long)(value))
+#define Tcl_SetLongObj(objPtr, value)	Tcl_SetWideIntObj((objPtr), (long)(value))
+#undef Tcl_GetUnicode
+#define Tcl_GetUnicode(objPtr)	Tcl_GetUnicodeFromObj((objPtr), NULL)
 
 /*
  * Deprecated Tcl procedures:
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index a0f6491..1d952ec 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -153,7 +153,7 @@ typedef struct Dict {
  * must be assignable as well as readable.
  */
 
-#define DICT(dictObj)   (*((Dict **)&(dictObj)->internalRep.twoPtrValue.ptr1))
+#define DICT(dictObj)   ((dictObj)->internalRep.twoPtrValue.ptr1)
 
 /*
  * The structure below defines the dictionary object type by means of
diff --git a/generic/tclDisassemble.c b/generic/tclDisassemble.c
index e9aaec4..a0d1258 100644
--- a/generic/tclDisassemble.c
+++ b/generic/tclDisassemble.c
@@ -894,7 +894,7 @@ PrintSourceToObj(
 		Tcl_AppendPrintfToObj(appendObj, "\\U%08x", ch);
 		i += 10;
 	    } else
-#elif TCL_UTF_MAX > 3
+#else
 	    /* If len == 0, this means we have a char > 0xffff, resulting in
 	     * TclUtfToUniChar producing a surrogate pair. We want to output
 	     * this pair as a single Unicode character.
diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c
index 94c0b76..84ed9e3 100644
--- a/generic/tclEnsemble.c
+++ b/generic/tclEnsemble.c
@@ -21,8 +21,6 @@ static inline Tcl_Obj *	NewNsObj(Tcl_Namespace *namespacePtr);
 static inline int	EnsembleUnknownCallback(Tcl_Interp *interp,
 			    EnsembleConfig *ensemblePtr, int objc,
 			    Tcl_Obj *const objv[], Tcl_Obj **prefixObjPtr);
-static int		NsEnsembleImplementationCmd(ClientData clientData,
-			    Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
 static int		NsEnsembleImplementationCmdNR(ClientData clientData,
 			    Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
 static void		BuildEnsembleConfig(EnsembleConfig *ensemblePtr);
@@ -664,7 +662,7 @@ TclCreateEnsembleInNs(
 
     ensemblePtr = ckalloc(sizeof(EnsembleConfig));
     token = TclNRCreateCommandInNs(interp, name,
-	    (Tcl_Namespace *) nameNsPtr, NsEnsembleImplementationCmd,
+	    (Tcl_Namespace *) nameNsPtr, TclEnsembleImplementationCmd,
 	    NsEnsembleImplementationCmdNR, ensemblePtr, DeleteEnsembleConfig);
     if (token == NULL) {
 	ckfree(ensemblePtr);
@@ -768,7 +766,7 @@ Tcl_SetEnsembleSubcommandList(
     EnsembleConfig *ensemblePtr;
     Tcl_Obj *oldList;
 
-    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
+    if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
 	Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		"command is not an ensemble", -1));
 	Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
@@ -844,7 +842,7 @@ Tcl_SetEnsembleParameterList(
     Tcl_Obj *oldList;
     int length;
 
-    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
+    if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
 	Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		"command is not an ensemble", -1));
 	Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
@@ -920,7 +918,7 @@ Tcl_SetEnsembleMappingDict(
     EnsembleConfig *ensemblePtr;
     Tcl_Obj *oldDict;
 
-    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
+    if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
 	Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		"command is not an ensemble", -1));
 	Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
@@ -1019,7 +1017,7 @@ Tcl_SetEnsembleUnknownHandler(
     EnsembleConfig *ensemblePtr;
     Tcl_Obj *oldList;
 
-    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
+    if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
 	Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		"command is not an ensemble", -1));
 	Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
@@ -1085,7 +1083,7 @@ Tcl_SetEnsembleFlags(
     EnsembleConfig *ensemblePtr;
     int wasCompiled;
 
-    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
+    if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
 	Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		"command is not an ensemble", -1));
 	Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "NOT_ENSEMBLE", NULL);
@@ -1161,7 +1159,7 @@ Tcl_GetEnsembleSubcommandList(
     Command *cmdPtr = (Command *) token;
     EnsembleConfig *ensemblePtr;
 
-    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
+    if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
 	if (interp != NULL) {
 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		    "command is not an ensemble", -1));
@@ -1203,7 +1201,7 @@ Tcl_GetEnsembleParameterList(
     Command *cmdPtr = (Command *) token;
     EnsembleConfig *ensemblePtr;
 
-    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
+    if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
 	if (interp != NULL) {
 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		    "command is not an ensemble", -1));
@@ -1245,7 +1243,7 @@ Tcl_GetEnsembleMappingDict(
     Command *cmdPtr = (Command *) token;
     EnsembleConfig *ensemblePtr;
 
-    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
+    if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
 	if (interp != NULL) {
 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		    "command is not an ensemble", -1));
@@ -1286,7 +1284,7 @@ Tcl_GetEnsembleUnknownHandler(
     Command *cmdPtr = (Command *) token;
     EnsembleConfig *ensemblePtr;
 
-    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
+    if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
 	if (interp != NULL) {
 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		    "command is not an ensemble", -1));
@@ -1327,7 +1325,7 @@ Tcl_GetEnsembleFlags(
     Command *cmdPtr = (Command *) token;
     EnsembleConfig *ensemblePtr;
 
-    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
+    if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
 	if (interp != NULL) {
 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		    "command is not an ensemble", -1));
@@ -1368,7 +1366,7 @@ Tcl_GetEnsembleNamespace(
     Command *cmdPtr = (Command *) token;
     EnsembleConfig *ensemblePtr;
 
-    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
+    if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
 	if (interp != NULL) {
 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		    "command is not an ensemble", -1));
@@ -1418,7 +1416,7 @@ Tcl_FindEnsemble(
 	return NULL;
     }
 
-    if (cmdPtr->objProc != NsEnsembleImplementationCmd) {
+    if (cmdPtr->objProc != TclEnsembleImplementationCmd) {
 	/*
 	 * Reuse existing infrastructure for following import link chains
 	 * rather than duplicating it.
@@ -1426,7 +1424,8 @@ Tcl_FindEnsemble(
 
 	cmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr);
 
-	if (cmdPtr == NULL || cmdPtr->objProc != NsEnsembleImplementationCmd){
+	if (cmdPtr == NULL
+		|| cmdPtr->objProc != TclEnsembleImplementationCmd) {
 	    if (flags & TCL_LEAVE_ERR_MSG) {
 		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
 			"\"%s\" is not an ensemble command",
@@ -1464,11 +1463,11 @@ Tcl_IsEnsemble(
 {
     Command *cmdPtr = (Command *) token;
 
-    if (cmdPtr->objProc == NsEnsembleImplementationCmd) {
+    if (cmdPtr->objProc == TclEnsembleImplementationCmd) {
 	return 1;
     }
     cmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr);
-    if (cmdPtr == NULL || cmdPtr->objProc != NsEnsembleImplementationCmd) {
+    if (cmdPtr == NULL || cmdPtr->objProc != TclEnsembleImplementationCmd) {
 	return 0;
     }
     return 1;
@@ -1639,7 +1638,7 @@ TclMakeEnsemble(
 /*
  *----------------------------------------------------------------------
  *
- * NsEnsembleImplementationCmd --
+ * TclEnsembleImplementationCmd --
  *
  *	Implements an ensemble of commands (being those exported by a
  *	namespace other than the global namespace) as a command with the same
@@ -1658,8 +1657,8 @@ TclMakeEnsemble(
  *----------------------------------------------------------------------
  */
 
-static int
-NsEnsembleImplementationCmd(
+int
+TclEnsembleImplementationCmd(
     ClientData clientData,
     Tcl_Interp *interp,
     int objc,
diff --git a/generic/tclEnv.c b/generic/tclEnv.c
index 8cc4b74..40ced17 100644
--- a/generic/tclEnv.c
+++ b/generic/tclEnv.c
@@ -723,14 +723,25 @@ TclFinalizeEnvironment(void)
      * strings. This may leak more memory that strictly necessary, since some
      * of the strings may no longer be in the environment. However,
      * determining which ones are ok to delete is n-squared, and is pretty
-     * unlikely, so we don't bother.
+     * unlikely, so we don't bother.  However, in the case of DPURIFY, just
+     * free all strings in the cache.
      */
 
     if (env.cache) {
+#ifdef PURIFY
+	int i;
+	for (i = 0; i < env.cacheSize; i++) {
+	    ckfree(env.cache[i]);
+	}
+#endif
 	ckfree(env.cache);
 	env.cache = NULL;
 	env.cacheSize = 0;
 #ifndef USE_PUTENV
+	if ((env.ourEnviron != NULL)) {
+	    ckfree(env.ourEnviron);
+	    env.ourEnviron = NULL;
+	}
 	env.ourEnvironSize = 0;
 #endif
     }
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index fda50b2..c553dea 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -4070,10 +4070,7 @@ TEBCresume(
 		TRACE_ERROR(interp);
 		goto gotError;
 	    }
-	    TclSetVarArray(varPtr);
-	    varPtr->value.tablePtr = ckalloc(sizeof(TclVarHashTable));
-	    TclInitVarHashTable(varPtr->value.tablePtr,
-		    TclGetVarNsPtr(varPtr));
+	    TclInitArrayVar(varPtr);
 #ifdef TCL_COMPILE_DEBUG
 	    TRACE_APPEND(("done\n"));
 	} else {
@@ -4964,7 +4961,7 @@ TEBCresume(
 
 	/* Decode index value operands. */
 
-	/* 
+	/*
 	assert ( toIdx != TCL_INDEX_AFTER);
 	 *
 	 * Extra safety for legacy bytecodes:
@@ -5223,9 +5220,15 @@ TEBCresume(
 	     * but creating the object as a string seems to be faster in
 	     * practical use.
 	     */
-
-	    length = (ch != -1) ? Tcl_UniCharToUtf(ch, buf) : 0;
-	    objResultPtr = Tcl_NewStringObj(buf, length);
+	    if (ch == -1) {
+		objResultPtr = Tcl_NewObj();
+	    } else {
+		length = Tcl_UniCharToUtf(ch, buf);
+		if (!length) {
+		    length = Tcl_UniCharToUtf(-1, buf);
+		}
+		objResultPtr = Tcl_NewStringObj(buf, length);
+	    }
 	}
 
 	TRACE_APPEND(("\"%s\"\n", O2S(objResultPtr)));
@@ -5629,17 +5632,17 @@ TEBCresume(
 	if (GetNumberFromObj(NULL, OBJ_AT_TOS, &ptr1, &type1) != TCL_OK) {
 	    type1 = 0;
 	} else if (type1 == TCL_NUMBER_WIDE) {
-	    /* value is between LLONG_MIN and LLONG_MAX */
+	    /* value is between WIDE_MIN and WIDE_MAX */
 	    /* [string is integer] is -UINT_MAX to UINT_MAX range */
-	    /* [string is wideinteger] is -ULLONG_MAX to ULLONG_MAX range */
+	    /* [string is wideinteger] is -UWIDE_MAX to UWIDE_MAX range */
 	    int i;
 
 	    if (Tcl_GetIntFromObj(NULL, OBJ_AT_TOS, &i) == TCL_OK) {
 		type1 = TCL_NUMBER_LONG;
 	    }
 	} else if (type1 == TCL_NUMBER_BIG) {
-	    /* value is an integer outside the LLONG_MIN to LLONG_MAX range */
-	    /* [string is wideinteger] is -ULLONG_MAX to ULLONG_MAX range */
+	    /* value is an integer outside the WIDE_MIN to WIDE_MAX range */
+	    /* [string is wideinteger] is -UWIDE_MAX to UWIDE_MAX range */
 	    Tcl_WideInt w;
 
 	    if (Tcl_GetWideIntFromObj(NULL, OBJ_AT_TOS, &w) == TCL_OK) {
@@ -6055,9 +6058,9 @@ TEBCresume(
 		    TRACE(("%s %s => DIVIDE BY ZERO\n",
 			    O2S(valuePtr), O2S(value2Ptr)));
 		    goto divideByZero;
-		} else if ((w1 == LLONG_MIN) && (w2 == -1)) {
+		} else if ((w1 == WIDE_MIN) && (w2 == -1)) {
 		    /*
-		     * Can't represent (-LLONG_MIN) as a Tcl_WideInt.
+		     * Can't represent (-WIDE_MIN) as a Tcl_WideInt.
 		     */
 
 		    goto overflow;
@@ -6190,7 +6193,7 @@ TEBCresume(
 	    NEXT_INST_F(1, 0, 0);
 	case TCL_NUMBER_WIDE:
 	    w1 = *((const Tcl_WideInt *) ptr1);
-	    if (w1 != LLONG_MIN) {
+	    if (w1 != WIDE_MIN) {
 		if (Tcl_IsShared(valuePtr)) {
 		    TclNewIntObj(objResultPtr, -w1);
 		    TRACE_APPEND(("%s\n", O2S(objResultPtr)));
@@ -8664,10 +8667,10 @@ ExecuteExtendedBinaryMathOp(
 		}
 
 		/*
-		 * Need a bignum to represent (LLONG_MIN / -1)
+		 * Need a bignum to represent (WIDE_MIN / -1)
 		 */
 
-		if ((w1 == LLONG_MIN) && (w2 == -1)) {
+		if ((w1 == WIDE_MIN) && (w2 == -1)) {
 		    goto overflowBasic;
 		}
 		wResult = w1 / w2;
@@ -8770,7 +8773,7 @@ ExecuteExtendedUnaryMathOp(
 	    DOUBLE_RESULT(-(*((const double *) ptr)));
 	case TCL_NUMBER_WIDE:
 	    w = *((const Tcl_WideInt *) ptr);
-	    if (w != LLONG_MIN) {
+	    if (w != WIDE_MIN) {
 		WIDE_RESULT(-w);
 	    }
 	    TclInitBignumFromWideInt(&big, w);
@@ -8856,10 +8859,10 @@ TclCompareTwoNumbers(
 	     * integer comparison can tell the difference.
 	     */
 
-	    if (d2 < (double)LLONG_MIN) {
+	    if (d2 < (double)WIDE_MIN) {
 		return MP_GT;
 	    }
-	    if (d2 > (double)LLONG_MAX) {
+	    if (d2 > (double)WIDE_MAX) {
 		return MP_LT;
 	    }
 	    w2 = (Tcl_WideInt) d2;
@@ -8889,10 +8892,10 @@ TclCompareTwoNumbers(
 		    || w2 == (Tcl_WideInt) d2 || modf(d1, &tmp) != 0.0) {
 		goto doubleCompare;
 	    }
-	    if (d1 < (double)LLONG_MIN) {
+	    if (d1 < (double)WIDE_MIN) {
 		return MP_LT;
 	    }
-	    if (d1 > (double)LLONG_MAX) {
+	    if (d1 > (double)WIDE_MAX) {
 		return MP_GT;
 	    }
 	    w1 = (Tcl_WideInt) d1;
@@ -8902,7 +8905,7 @@ TclCompareTwoNumbers(
 		return (d1 > 0.0) ? MP_GT : MP_LT;
 	    }
 	    Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2);
-	    if ((d1 < (double)LLONG_MAX) && (d1 > (double)LLONG_MIN)) {
+	    if ((d1 < (double)WIDE_MAX) && (d1 > (double)WIDE_MIN)) {
 		if (mp_isneg(&big2)) {
 		    compare = MP_GT;
 		} else {
@@ -8935,7 +8938,7 @@ TclCompareTwoNumbers(
 		mp_clear(&big1);
 		return compare;
 	    }
-	    if ((d2 < (double)LLONG_MAX) && (d2 > (double)LLONG_MIN)) {
+	    if ((d2 < (double)WIDE_MAX) && (d2 > (double)WIDE_MIN)) {
 		compare = mp_cmp_d(&big1, 0);
 		mp_clear(&big1);
 		return compare;
diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c
index ddfe3bf..ea2a1c5 100644
--- a/generic/tclFCmd.c
+++ b/generic/tclFCmd.c
@@ -240,9 +240,13 @@ TclFileMakeDirsCmd(
 	    break;
 	}
 	for (j = 0; j < pobjc; j++) {
+	    int errCount = 2;
+
 	    target = Tcl_FSJoinPath(split, j + 1);
 	    Tcl_IncrRefCount(target);
 
+	createDir:
+
 	    /*
 	     * Call Tcl_FSStat() so that if target is a symlink that points to
 	     * a directory we will create subdirectories in that directory.
@@ -269,23 +273,25 @@ TclFileMakeDirsCmd(
 		 * subdirectory.
 		 */
 
-		if (errno != EEXIST) {
-		    errfile = target;
-		    goto done;
-		} else if ((Tcl_FSStat(target, &statBuf) == 0)
-			&& S_ISDIR(statBuf.st_mode)) {
-		    /*
-		     * It is a directory that wasn't there before, so keep
-		     * going without error.
-		     */
-
-		    Tcl_ResetResult(interp);
-		} else {
-		    errfile = target;
-		    goto done;
+		if (errno == EEXIST) {
+		    /* Be aware other workers could delete it immediately after
+		     * creation, so give this worker still one chance (repeat once),
+		     * see [270f78ca95] for description of the race-condition.
+		     * Don't repeat the create always (to avoid endless loop). */
+		    if (--errCount > 0) {
+			goto createDir;
+		    }
+		    /* Already tried, with delete in-between directly after
+		     * creation, so just continue (assume created successful). */
+		    goto nextPart;
 		}
+
+		/* return with error */
+		errfile = target;
+		goto done;
 	    }
 
+	nextPart:
 	    /*
 	     * Forget about this sub-path.
 	     */
diff --git a/generic/tclFileName.c b/generic/tclFileName.c
index 15fcde7..015cfc3 100644
--- a/generic/tclFileName.c
+++ b/generic/tclFileName.c
@@ -1881,7 +1881,7 @@ TclGlob(
 	separators = "/\\";
 
     } else if (tclPlatform == TCL_PLATFORM_UNIX) {
-	if (pathPrefix == NULL && tail[0] == '/') {
+	if (pathPrefix == NULL && tail[0] == '/' && tail[1] != '/') {
 	    pathPrefix = Tcl_NewStringObj(tail, 1);
 	    tail++;
 	    Tcl_IncrRefCount(pathPrefix);
diff --git a/generic/tclIO.c b/generic/tclIO.c
index ad6c7ee..10362d4 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -482,13 +482,13 @@ ChanSeek(
 		offset, mode, errnoPtr);
     }
 
-    if (offset<Tcl_LongAsWide(LONG_MIN) || offset>Tcl_LongAsWide(LONG_MAX)) {
+    if (offset<LONG_MIN || offset>LONG_MAX) {
 	*errnoPtr = EOVERFLOW;
-	return Tcl_LongAsWide(-1);
+	return -1;
     }
 
-    return Tcl_LongAsWide(chanPtr->typePtr->seekProc(chanPtr->instanceData,
-	    Tcl_WideAsLong(offset), mode, errnoPtr));
+    return chanPtr->typePtr->seekProc(chanPtr->instanceData,
+	    offset, mode, errnoPtr);
 }
 
 static inline void
@@ -6953,7 +6953,7 @@ Tcl_Seek(
 				 * non-blocking mode after the seek. */
 
     if (CheckChannelErrors(statePtr, TCL_WRITABLE | TCL_READABLE) != 0) {
-	return Tcl_LongAsWide(-1);
+	return -1;
     }
 
     /*
@@ -6964,7 +6964,7 @@ Tcl_Seek(
      */
 
     if (CheckForDeadChannel(NULL, statePtr)) {
-	return Tcl_LongAsWide(-1);
+	return -1;
     }
 
     /*
@@ -6980,7 +6980,7 @@ Tcl_Seek(
 
     if (chanPtr->typePtr->seekProc == NULL) {
 	Tcl_SetErrno(EINVAL);
-	return Tcl_LongAsWide(-1);
+	return -1;
     }
 
     /*
@@ -6993,7 +6993,7 @@ Tcl_Seek(
 
     if ((inputBuffered != 0) && (outputBuffered != 0)) {
 	Tcl_SetErrno(EFAULT);
-	return Tcl_LongAsWide(-1);
+	return -1;
     }
 
     /*
@@ -7036,7 +7036,7 @@ Tcl_Seek(
 	wasAsync = 1;
 	result = StackSetBlockMode(chanPtr, TCL_MODE_BLOCKING);
 	if (result != 0) {
-	    return Tcl_LongAsWide(-1);
+	    return -1;
 	}
 	ResetFlag(statePtr, CHANNEL_NONBLOCKING);
 	if (GotFlag(statePtr, BG_FLUSH_SCHEDULED)) {
@@ -7061,7 +7061,7 @@ Tcl_Seek(
 	 */
 
 	curPos = ChanSeek(chanPtr, offset, mode, &result);
-	if (curPos == Tcl_LongAsWide(-1)) {
+	if (curPos == -1) {
 	    Tcl_SetErrno(result);
 	}
     }
@@ -7077,7 +7077,7 @@ Tcl_Seek(
 	SetFlag(statePtr, CHANNEL_NONBLOCKING);
 	result = StackSetBlockMode(chanPtr, TCL_MODE_NONBLOCKING);
 	if (result != 0) {
-	    return Tcl_LongAsWide(-1);
+	    return -1;
 	}
     }
 
@@ -7117,7 +7117,7 @@ Tcl_Tell(
     Tcl_WideInt curPos;		/* Position on device. */
 
     if (CheckChannelErrors(statePtr, TCL_WRITABLE | TCL_READABLE) != 0) {
-	return Tcl_LongAsWide(-1);
+	return -1;
     }
 
     /*
@@ -7128,7 +7128,7 @@ Tcl_Tell(
      */
 
     if (CheckForDeadChannel(NULL, statePtr)) {
-	return Tcl_LongAsWide(-1);
+	return -1;
     }
 
     /*
@@ -7144,7 +7144,7 @@ Tcl_Tell(
 
     if (chanPtr->typePtr->seekProc == NULL) {
 	Tcl_SetErrno(EINVAL);
-	return Tcl_LongAsWide(-1);
+	return -1;
     }
 
     /*
@@ -7161,10 +7161,10 @@ Tcl_Tell(
      * wideSeekProc if that is available and non-NULL...
      */
 
-    curPos = ChanSeek(chanPtr, Tcl_LongAsWide(0), SEEK_CUR, &result);
-    if (curPos == Tcl_LongAsWide(-1)) {
+    curPos = ChanSeek(chanPtr, 0, SEEK_CUR, &result);
+    if (curPos == -1) {
 	Tcl_SetErrno(result);
-	return Tcl_LongAsWide(-1);
+	return -1;
     }
 
     if (inputBuffered != 0) {
diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c
index 87bf415..d38240a 100644
--- a/generic/tclIOCmd.c
+++ b/generic/tclIOCmd.c
@@ -559,7 +559,7 @@ Tcl_SeekObjCmd(
 
     TclChannelPreserve(chan);
     result = Tcl_Seek(chan, offset, mode);
-    if (result == Tcl_LongAsWide(-1)) {
+    if (result == -1) {
 	/*
 	 * TIP #219.
 	 * Capture error messages put by the driver into the bypass area and
@@ -1913,7 +1913,7 @@ ChanTruncateObjCmd(
 	 */
 
 	length = Tcl_Tell(chan);
-	if (length == Tcl_WideAsLong(-1)) {
+	if (length == -1) {
 	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
 		    "could not determine current location in \"%s\": %s",
 		    TclGetString(objv[1]), Tcl_PosixError(interp)));
diff --git a/generic/tclIOGT.c b/generic/tclIOGT.c
index c1e8c44..9949a0e 100644
--- a/generic/tclIOGT.c
+++ b/generic/tclIOGT.c
@@ -910,7 +910,7 @@ TransformWideSeekProc(
 	    Tcl_ChannelWideSeekProc(parentType);
     ClientData parentData = Tcl_GetChannelInstanceData(parent);
 
-    if ((offset == Tcl_LongAsWide(0)) && (mode == SEEK_CUR)) {
+    if ((offset == 0) && (mode == SEEK_CUR)) {
 	/*
 	 * This is no seek but a request to tell the caller the current
 	 * location. Simply pass the request down.
@@ -920,8 +920,7 @@ TransformWideSeekProc(
 	    return parentWideSeekProc(parentData, offset, mode, errorCodePtr);
 	}
 
-	return Tcl_LongAsWide(parentSeekProc(parentData, 0, mode,
-		errorCodePtr));
+	return parentSeekProc(parentData, 0, mode, errorCodePtr);
     }
 
     /*
@@ -961,13 +960,13 @@ TransformWideSeekProc(
      * to go out of the representable range.
      */
 
-    if (offset<Tcl_LongAsWide(LONG_MIN) || offset>Tcl_LongAsWide(LONG_MAX)) {
+    if (offset<LONG_MIN || offset>LONG_MAX) {
 	*errorCodePtr = EOVERFLOW;
-	return Tcl_LongAsWide(-1);
+	return -1;
     }
 
-    return Tcl_LongAsWide(parentSeekProc(parentData, Tcl_WideAsLong(offset),
-	    mode, errorCodePtr));
+    return parentSeekProc(parentData, offset,
+	    mode, errorCodePtr);
 }
 
 /*
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index 354f1fb..611ee3f 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -1544,7 +1544,7 @@ ReflectSeekWide(
         goto invalid;
     }
 
-    if (newLoc < Tcl_LongAsWide(0)) {
+    if (newLoc < 0) {
 	SetChannelErrorStr(rcPtr->chan, msg_seek_beforestart);
         goto invalid;
     }
@@ -1576,7 +1576,7 @@ ReflectSeek(
      * routine.
      */
 
-    return (int) ReflectSeekWide(clientData, Tcl_LongAsWide(offset), seekMode,
+    return ReflectSeekWide(clientData, offset, seekMode,
 	    errorCodePtr);
 }
 
@@ -3079,7 +3079,7 @@ ForwardProc(
 	    Tcl_WideInt newLoc;
 
 	    if (Tcl_GetWideIntFromObj(interp, resObj, &newLoc) == TCL_OK) {
-		if (newLoc < Tcl_LongAsWide(0)) {
+		if (newLoc < 0) {
 		    ForwardSetStaticError(paramPtr, msg_seek_beforestart);
 		    paramPtr->seek.offset = -1;
 		} else {
diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c
index 1a7b940..4841e39 100644
--- a/generic/tclIORTrans.c
+++ b/generic/tclIORTrans.c
@@ -1340,7 +1340,7 @@ ReflectSeekWide(
 
     if (seekProc == NULL) {
 	Tcl_SetErrno(EINVAL);
-	return Tcl_LongAsWide(-1);
+	return -1;
     }
 
     /*
@@ -1390,16 +1390,15 @@ ReflectSeekWide(
 	parent->typePtr->wideSeekProc != NULL) {
 	curPos = parent->typePtr->wideSeekProc(parent->instanceData, offset,
 		seekMode, errorCodePtr);
-    } else if (offset < Tcl_LongAsWide(LONG_MIN) ||
-	    offset > Tcl_LongAsWide(LONG_MAX)) {
+    } else if (offset < LONG_MIN || offset > LONG_MAX) {
 	*errorCodePtr = EOVERFLOW;
-	curPos = Tcl_LongAsWide(-1);
+	curPos = -1;
     } else {
-	curPos = Tcl_LongAsWide(parent->typePtr->seekProc(
-		parent->instanceData, Tcl_WideAsLong(offset), seekMode,
-		errorCodePtr));
+	curPos = parent->typePtr->seekProc(
+		parent->instanceData, offset, seekMode,
+		errorCodePtr);
     }
-    if (curPos == Tcl_LongAsWide(-1)) {
+    if (curPos == -1) {
 	Tcl_SetErrno(*errorCodePtr);
     }
 
@@ -1422,7 +1421,7 @@ ReflectSeek(
      * routine.
      */
 
-    return (int) ReflectSeekWide(clientData, Tcl_LongAsWide(offset), seekMode,
+    return ReflectSeekWide(clientData, offset, seekMode,
 	    errorCodePtr);
 }
 
diff --git a/generic/tclIOSock.c b/generic/tclIOSock.c
index 6abfa60..12e2900 100644
--- a/generic/tclIOSock.c
+++ b/generic/tclIOSock.c
@@ -11,7 +11,7 @@
 
 #include "tclInt.h"
 
-#if defined(_WIN32) && defined(UNICODE)
+#if defined(_WIN32)
 /*
  * On Windows, we need to do proper Unicode->UTF-8 conversion.
  */
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 3382825..11cc22d 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -139,7 +139,6 @@ Tcl_FSRenameFileProc		TclpObjRenameFile;
 Tcl_FSCreateDirectoryProc	TclpObjCreateDirectory;
 Tcl_FSCopyDirectoryProc		TclpObjCopyDirectory;
 Tcl_FSRemoveDirectoryProc	TclpObjRemoveDirectory;
-Tcl_FSUnloadFileProc		TclpUnloadFile;
 Tcl_FSLinkProc			TclpObjLink;
 Tcl_FSListVolumesProc		TclpObjListVolumes;
 
@@ -276,8 +275,8 @@ Tcl_Stat(
 	Tcl_WideInt tmp1, tmp2, tmp3 = 0;
 
 # define OUT_OF_RANGE(x) \
-	(((Tcl_WideInt)(x)) < Tcl_LongAsWide(LONG_MIN) || \
-	 ((Tcl_WideInt)(x)) > Tcl_LongAsWide(LONG_MAX))
+	(((Tcl_WideInt)(x)) < LONG_MIN || \
+	 ((Tcl_WideInt)(x)) > LONG_MAX)
 # define OUT_OF_URANGE(x) \
 	(((Tcl_WideUInt)(x)) > ((Tcl_WideUInt)ULONG_MAX))
 
@@ -1391,31 +1390,62 @@ TclFSNormalizeToUniquePath(
 {
     FilesystemRecord *fsRecPtr, *firstFsRecPtr;
 
+    int i;
+    int isVfsPath = 0;
+    char *path;
+
     /*
-     * Call each of the "normalise path" functions in succession. This is a
-     * special case, in which if we have a native filesystem handler, we call
-     * it first. This is because the root of Tcl's filesystem is always a
-     * native filesystem (i.e., '/' on unix is native).
+     * Paths starting with a UNC prefix whose final character is a colon
+     * are reserved for VFS use.  These names can not conflict with real
+     * UNC paths per https://msdn.microsoft.com/en-us/library/gg465305.aspx
+     * and rfc3986's definition of reg-name.
+     *
+     * We check these first to avoid useless calls to the native filesystem's
+     * normalizePathProc.
      */
+    path = Tcl_GetStringFromObj(pathPtr, &i);
+
+    if ( (i >= 3) && ( (path[0] == '/' && path[1] == '/')
+		    || (path[0] == '\\' && path[1] == '\\') ) ) {
+	for ( i = 2; ; i++) {
+	    if (path[i] == '\0') break;
+	    if (path[i] == path[0]) break;
+	}
+	--i;
+	if (path[i] == ':') isVfsPath = 1;
+    }
 
+    /*
+     * Call each of the "normalise path" functions in succession.
+     */
     firstFsRecPtr = FsGetFirstFilesystem();
 
     Claim();
-    for (fsRecPtr=firstFsRecPtr; fsRecPtr!=NULL; fsRecPtr=fsRecPtr->nextPtr) {
-	if (fsRecPtr->fsPtr != &tclNativeFilesystem) {
-	    continue;
-	}
+
+    if (!isVfsPath) {
 
 	/*
-	 * TODO: Assume that we always find the native file system; it should
-	 * always be there...
+	 * If we have a native filesystem handler, we call it first.  This is
+	 * because the root of Tcl's filesystem is always a native filesystem
+	 * (i.e., '/' on unix is native).
 	 */
 
-	if (fsRecPtr->fsPtr->normalizePathProc != NULL) {
-	    startAt = fsRecPtr->fsPtr->normalizePathProc(interp, pathPtr,
-		    startAt);
+	for (fsRecPtr=firstFsRecPtr; fsRecPtr!=NULL; fsRecPtr=fsRecPtr->nextPtr) {
+	    if (fsRecPtr->fsPtr != &tclNativeFilesystem) {
+		continue;
+	    }
+
+	    /*
+	     * TODO: Assume that we always find the native file system; it should
+	     * always be there...
+	     */
+
+	    if (fsRecPtr->fsPtr->normalizePathProc != NULL) {
+		startAt = fsRecPtr->fsPtr->normalizePathProc(interp, pathPtr,
+			startAt);
+	    }
+	    break;
 	}
-	break;
     }
 
     for (fsRecPtr=firstFsRecPtr; fsRecPtr!=NULL; fsRecPtr=fsRecPtr->nextPtr) {
@@ -3154,8 +3184,8 @@ Tcl_FSLoadFile(
  * present and set to true (any integer > 0) then the unlink is skipped.
  */
 
-int
-TclSkipUnlink(
+static int
+skipUnlink(
     Tcl_Obj *shlibFile)
 {
     /*
@@ -3413,7 +3443,7 @@ Tcl_LoadFile(
      * avoids any worries about leaving the copy laying around on exit.
      */
 
-    if (!TclSkipUnlink(copyToPtr) &&
+    if (!skipUnlink(copyToPtr) &&
 	    (Tcl_FSDeleteFile(copyToPtr) == TCL_OK)) {
 	Tcl_DecrRefCount(copyToPtr);
 
@@ -3682,30 +3712,10 @@ Tcl_FSUnloadFile(
 	}
 	return TCL_ERROR;
     }
-    TclpUnloadFile(handle);
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TclpUnloadFile --
- *
- *	Unloads a library given its handle
- *
- * This function was once filesystem-specific, but has been made portable by
- * having TclpDlopen return a structure that includes procedure pointers.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclpUnloadFile(
-    Tcl_LoadHandle handle)
-{
     if (handle->unloadFileProcPtr != NULL) {
 	handle->unloadFileProcPtr(handle);
     }
+    return TCL_OK;
 }
 
 /*
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 64e7c67..4a1b459 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -38,6 +38,23 @@
 
 #define AVOID_HACKS_FOR_ITCL 1
 
+
+/*
+ * Used to tag functions that are only to be visible within the module being
+ * built and not outside it (where this is supported by the linker).
+ * Also used in the platform-specific *Port.h files.
+ */
+
+#ifndef MODULE_SCOPE
+#   ifdef __cplusplus
+#	define MODULE_SCOPE extern "C"
+#   else
+#	define MODULE_SCOPE extern
+#   endif
+#endif
+
+
+
 /*
  * Common include files needed by most of the Tcl source files are included
  * here, so that system-dependent personalizations for the include files only
@@ -95,19 +112,6 @@ typedef int ptrdiff_t;
 #endif
 
 /*
- * Used to tag functions that are only to be visible within the module being
- * built and not outside it (where this is supported by the linker).
- */
-
-#ifndef MODULE_SCOPE
-#   ifdef __cplusplus
-#	define MODULE_SCOPE extern "C"
-#   else
-#	define MODULE_SCOPE extern
-#   endif
-#endif
-
-/*
  * Macros used to cast between pointers and integers (e.g. when storing an int
  * in ClientData), on 64-bit architectures they avoid gcc warning about "cast
  * to/from pointer from/to integer of different size".
@@ -3037,6 +3041,8 @@ MODULE_SCOPE char *	TclGetStringStorage(Tcl_Obj *objPtr,
 MODULE_SCOPE int	TclGetLoadedPackagesEx(Tcl_Interp *interp,
 				const char *targetName,
 				const char *packageName);
+MODULE_SCOPE int	TclGetWideBitsFromObj(Tcl_Interp *, Tcl_Obj *,
+				Tcl_WideInt *);
 MODULE_SCOPE int	TclGlob(Tcl_Interp *interp, char *pattern,
 			    Tcl_Obj *unquotedPrefix, int globFlags,
 			    Tcl_GlobTypeData *types);
@@ -3232,6 +3238,10 @@ MODULE_SCOPE int	TclTrimLeft(const char *bytes, int numBytes,
 			    const char *trim, int numTrim);
 MODULE_SCOPE int	TclTrimRight(const char *bytes, int numBytes,
 			    const char *trim, int numTrim);
+MODULE_SCOPE const char*TclGetCommandTypeName(Tcl_Command command);
+MODULE_SCOPE void	TclRegisterCommandTypeName(
+			    Tcl_ObjCmdProc *implementationProc,
+			    const char *nameStr);
 MODULE_SCOPE int	TclUtfCmp(const char *cs, const char *ct);
 MODULE_SCOPE int	TclUtfCasecmp(const char *cs, const char *ct);
 MODULE_SCOPE int	TclUtfCount(int ch);
@@ -3255,12 +3265,20 @@ MODULE_SCOPE Tcl_WideInt TclpGetWideClicks(void);
 MODULE_SCOPE double	TclpWideClicksToNanoseconds(Tcl_WideInt clicks);
 #endif
 MODULE_SCOPE int	TclZlibInit(Tcl_Interp *interp);
+MODULE_SCOPE int	TclZipfsInit(Tcl_Interp *interp);
+MODULE_SCOPE int        TclZipfsMount(Tcl_Interp *interp, const char *zipname,
+			 const char *mntpt, const char *passwd);
+MODULE_SCOPE int 	TclZipfsUnmount(Tcl_Interp *interp, const char *zipname);
 MODULE_SCOPE void *	TclpThreadCreateKey(void);
 MODULE_SCOPE void	TclpThreadDeleteKey(void *keyPtr);
 MODULE_SCOPE void	TclpThreadSetMasterTSD(void *tsdKeyPtr, void *ptr);
 MODULE_SCOPE void *	TclpThreadGetMasterTSD(void *tsdKeyPtr);
 MODULE_SCOPE void	TclErrorStackResetIf(Tcl_Interp *interp,
 			    const char *msg, int length);
+/* Tip 430 */
+MODULE_SCOPE int    TclZipfs_Init(Tcl_Interp *interp);
+MODULE_SCOPE int    TclZipfs_SafeInit(Tcl_Interp *interp);
+
 
 /*
  *----------------------------------------------------------------
@@ -4100,6 +4118,19 @@ MODULE_SCOPE TCL_HASH_TYPE TclHashObjKey(Tcl_HashTable *tablePtr, void *keyPtr);
 MODULE_SCOPE int	TclFullFinalizationRequested(void);
 
 /*
+ * Just for the purposes of command-type registration.
+ */
+
+MODULE_SCOPE Tcl_ObjCmdProc TclEnsembleImplementationCmd;
+MODULE_SCOPE Tcl_ObjCmdProc TclAliasObjCmd;
+MODULE_SCOPE Tcl_ObjCmdProc TclLocalAliasObjCmd;
+MODULE_SCOPE Tcl_ObjCmdProc TclSlaveObjCmd;
+MODULE_SCOPE Tcl_ObjCmdProc TclInvokeImportedCmd;
+MODULE_SCOPE Tcl_ObjCmdProc TclOOPublicObjectCmd;
+MODULE_SCOPE Tcl_ObjCmdProc TclOOPrivateObjectCmd;
+MODULE_SCOPE Tcl_ObjCmdProc TclOOMyClassObjCmd;
+
+/*
  * TIP #462.
  */
 
@@ -4124,6 +4155,13 @@ MODULE_SCOPE TclProcessWaitStatus TclProcessWait(Tcl_Pid pid, int options,
 			    Tcl_Obj **errorObjPtr);
 
 /*
+ * TIP #508: [array default]
+ */
+
+MODULE_SCOPE void	TclInitArrayVar(Var *arrayPtr);
+MODULE_SCOPE Tcl_Obj *	TclGetArrayDefault(Var *arrayPtr);
+
+/*
  * Utility routines for encoding index values as integers. Used by both
  * some of the command compilers and by [lsort] and [lsearch].
  */
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index d4bf465..550e2fe 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -222,9 +222,6 @@ static int		AliasDelete(Tcl_Interp *interp,
 static int		AliasDescribe(Tcl_Interp *interp,
 			    Tcl_Interp *slaveInterp, Tcl_Obj *objPtr);
 static int		AliasList(Tcl_Interp *interp, Tcl_Interp *slaveInterp);
-static int		AliasObjCmd(ClientData dummy,
-			    Tcl_Interp *currentInterp, int objc,
-			    Tcl_Obj *const objv[]);
 static int		AliasNRCmd(ClientData dummy,
 			    Tcl_Interp *currentInterp, int objc,
 			    Tcl_Obj *const objv[]);
@@ -257,8 +254,6 @@ static int		SlaveInvokeHidden(Tcl_Interp *interp,
 			    int objc, Tcl_Obj *const objv[]);
 static int		SlaveMarkTrusted(Tcl_Interp *interp,
 			    Tcl_Interp *slaveInterp);
-static int		SlaveObjCmd(ClientData dummy, Tcl_Interp *interp,
-			    int objc, Tcl_Obj *const objv[]);
 static void		SlaveObjCmdDeleteProc(ClientData clientData);
 static int		SlaveRecursionLimit(Tcl_Interp *interp,
 			    Tcl_Interp *slaveInterp, int objc,
@@ -402,6 +397,7 @@ Tcl_Init(
 "	set scripts {{set tcl_library}}\n"
 "    } else {\n"
 "	set scripts {}\n"
+"   lappend scripts {zipfs tcl_library}\n"
 "	if {[info exists env(TCL_LIBRARY)] && ($env(TCL_LIBRARY) ne {})} {\n"
 "	    lappend scripts {set env(TCL_LIBRARY)}\n"
 "	    lappend scripts {\n"
@@ -1418,7 +1414,8 @@ TclPreventAliasLoop(
      * create or rename the command.
      */
 
-    if (cmdPtr->objProc != AliasObjCmd) {
+    if (cmdPtr->objProc != TclAliasObjCmd
+	    && cmdPtr->objProc != TclLocalAliasObjCmd) {
 	return TCL_OK;
     }
 
@@ -1473,7 +1470,8 @@ TclPreventAliasLoop(
 	 * Otherwise we do not have a loop.
 	 */
 
-	if (aliasCmdPtr->objProc != AliasObjCmd) {
+	if (aliasCmdPtr->objProc != TclAliasObjCmd
+		&& aliasCmdPtr->objProc != TclLocalAliasObjCmd) {
 	    return TCL_OK;
 	}
 	nextAliasPtr = aliasCmdPtr->objClientData;
@@ -1539,12 +1537,12 @@ AliasCreate(
 
     if (slaveInterp == masterInterp) {
 	aliasPtr->slaveCmd = Tcl_NRCreateCommand(slaveInterp,
-		TclGetString(namePtr), AliasObjCmd, AliasNRCmd, aliasPtr,
-		AliasObjCmdDeleteProc);
+		TclGetString(namePtr), TclLocalAliasObjCmd, AliasNRCmd,
+		aliasPtr, AliasObjCmdDeleteProc);
     } else {
-    aliasPtr->slaveCmd = Tcl_CreateObjCommand(slaveInterp,
-	    TclGetString(namePtr), AliasObjCmd, aliasPtr,
-	    AliasObjCmdDeleteProc);
+	aliasPtr->slaveCmd = Tcl_CreateObjCommand(slaveInterp,
+		TclGetString(namePtr), TclAliasObjCmd, aliasPtr,
+		AliasObjCmdDeleteProc);
     }
 
     if (TclPreventAliasLoop(interp, slaveInterp,
@@ -1780,7 +1778,7 @@ AliasList(
 /*
  *----------------------------------------------------------------------
  *
- * AliasObjCmd --
+ * TclAliasObjCmd, TclLocalAliasObjCmd --
  *
  *	This is the function that services invocations of aliases in a slave
  *	interpreter. One such command exists for each alias. When invoked,
@@ -1788,6 +1786,11 @@ AliasList(
  *	master interpreter as designated by the Alias record associated with
  *	this command.
  *
+ *	TclLocalAliasObjCmd is a stripped down version used when the source
+ *	and target interpreters of the alias are the same. That lets a number
+ *	of safety precautions be avoided: the state is much more precisely
+ *	known.
+ *
  * Results:
  *	A standard Tcl result.
  *
@@ -1847,8 +1850,8 @@ AliasNRCmd(
     return Tcl_NREvalObj(interp, listPtr, flags);
 }
 
-static int
-AliasObjCmd(
+int
+TclAliasObjCmd(
     ClientData clientData,	/* Alias record. */
     Tcl_Interp *interp,		/* Current interpreter. */
     int objc,			/* Number of arguments. */
@@ -1937,6 +1940,73 @@ AliasObjCmd(
     return result;
 #undef ALIAS_CMDV_PREALLOC
 }
+
+int
+TclLocalAliasObjCmd(
+    ClientData clientData,	/* Alias record. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument vector. */
+{
+#define ALIAS_CMDV_PREALLOC 10
+    Alias *aliasPtr = clientData;
+    int result, prefc, cmdc, i;
+    Tcl_Obj **prefv, **cmdv;
+    Tcl_Obj *cmdArr[ALIAS_CMDV_PREALLOC];
+    Interp *iPtr = (Interp *) interp;
+    int isRootEnsemble;
+
+    /*
+     * Append the arguments to the command prefix and invoke the command in
+     * the global namespace.
+     */
+
+    prefc = aliasPtr->objc;
+    prefv = &aliasPtr->objPtr;
+    cmdc = prefc + objc - 1;
+    if (cmdc <= ALIAS_CMDV_PREALLOC) {
+	cmdv = cmdArr;
+    } else {
+	cmdv = TclStackAlloc(interp, cmdc * sizeof(Tcl_Obj *));
+    }
+
+    memcpy(cmdv, prefv, (size_t) (prefc * sizeof(Tcl_Obj *)));
+    memcpy(cmdv+prefc, objv+1, (size_t) ((objc-1) * sizeof(Tcl_Obj *)));
+
+    for (i=0; i<cmdc; i++) {
+	Tcl_IncrRefCount(cmdv[i]);
+    }
+
+    /*
+     * Use the ensemble rewriting machinery to ensure correct error messages:
+     * only the source command should show, not the full target prefix.
+     */
+
+    isRootEnsemble = TclInitRewriteEnsemble((Tcl_Interp *)iPtr, 1, prefc, objv);
+
+    /*
+     * Execute the target command in the target interpreter.
+     */
+
+    result = Tcl_EvalObjv(interp, cmdc, cmdv, TCL_EVAL_INVOKE);
+
+    /*
+     * Clean up the ensemble rewrite info if we set it in the first place.
+     */
+
+    if (isRootEnsemble) {
+	TclResetRewriteEnsemble((Tcl_Interp *)iPtr, 1);
+    }
+
+    for (i=0; i<cmdc; i++) {
+	Tcl_DecrRefCount(cmdv[i]);
+    }
+    if (cmdv != cmdArr) {
+	TclStackFree(interp, cmdv);
+    }
+    return result;
+#undef ALIAS_CMDV_PREALLOC
+}
 
 /*
  *----------------------------------------------------------------------
@@ -2376,7 +2446,7 @@ SlaveCreate(
     slavePtr->slaveEntryPtr = hPtr;
     slavePtr->slaveInterp = slaveInterp;
     slavePtr->interpCmd = Tcl_NRCreateCommand(masterInterp, path,
-	    SlaveObjCmd, NRSlaveCmd, slaveInterp, SlaveObjCmdDeleteProc);
+	    TclSlaveObjCmd, NRSlaveCmd, slaveInterp, SlaveObjCmdDeleteProc);
     Tcl_InitHashTable(&slavePtr->aliasTable, TCL_STRING_KEYS);
     Tcl_SetHashValue(hPtr, slavePtr);
     Tcl_SetVar2(slaveInterp, "tcl_interactive", NULL, "0", TCL_GLOBAL_ONLY);
@@ -2444,7 +2514,7 @@ SlaveCreate(
 /*
  *----------------------------------------------------------------------
  *
- * SlaveObjCmd --
+ * TclSlaveObjCmd --
  *
  *	Command to manipulate an interpreter, e.g. to send commands to it to
  *	be evaluated. One such command exists for each slave interpreter.
@@ -2458,8 +2528,8 @@ SlaveCreate(
  *----------------------------------------------------------------------
  */
 
-static int
-SlaveObjCmd(
+int
+TclSlaveObjCmd(
     ClientData clientData,	/* Slave interpreter. */
     Tcl_Interp *interp,		/* Current interpreter. */
     int objc,			/* Number of arguments. */
@@ -2491,7 +2561,7 @@ NRSlaveCmd(
     };
 
     if (slaveInterp == NULL) {
-	Tcl_Panic("SlaveObjCmd: interpreter has been deleted");
+	Tcl_Panic("TclSlaveObjCmd: interpreter has been deleted");
     }
 
     if (objc < 2) {
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index f82d23d..2b8dd51 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -89,8 +89,6 @@ static char *		EstablishErrorInfoTraces(ClientData clientData,
 static void		FreeNsNameInternalRep(Tcl_Obj *objPtr);
 static int		GetNamespaceFromObj(Tcl_Interp *interp,
 			    Tcl_Obj *objPtr, Tcl_Namespace **nsPtrPtr);
-static int		InvokeImportedCmd(ClientData clientData,
-			    Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
 static int		InvokeImportedNRCmd(ClientData clientData,
 			    Tcl_Interp *interp,int objc,Tcl_Obj *const objv[]);
 static int		NamespaceChildrenCmd(ClientData dummy,
@@ -1766,7 +1764,7 @@ DoImport(
 
 	dataPtr = ckalloc(sizeof(ImportedCmdData));
 	importedCmd = Tcl_NRCreateCommand(interp, Tcl_DStringValue(&ds),
-		InvokeImportedCmd, InvokeImportedNRCmd, dataPtr,
+		TclInvokeImportedCmd, InvokeImportedNRCmd, dataPtr,
 		DeleteImportedCmd);
 	dataPtr->realCmdPtr = cmdPtr;
 	dataPtr->selfPtr = (Command *) importedCmd;
@@ -1987,7 +1985,7 @@ TclGetOriginalCommand(
 /*
  *----------------------------------------------------------------------
  *
- * InvokeImportedCmd --
+ * TclInvokeImportedCmd --
  *
  *	Invoked by Tcl whenever the user calls an imported command that was
  *	created by Tcl_Import. Finds the "real" command (in another
@@ -2018,8 +2016,8 @@ InvokeImportedNRCmd(
     return TclNREvalObjv(interp, objc, objv, TCL_EVAL_NOERR, realCmdPtr);
 }
 
-static int
-InvokeImportedCmd(
+int
+TclInvokeImportedCmd(
     ClientData clientData,	/* Points to the imported command's
 				 * ImportedCmdData structure. */
     Tcl_Interp *interp,		/* Current interpreter. */
diff --git a/generic/tclOO.c b/generic/tclOO.c
index 6aa03fa..c8471d5 100644
--- a/generic/tclOO.c
+++ b/generic/tclOO.c
@@ -90,18 +90,16 @@ static inline void	RemoveClass(Class **list, int num, int idx);
 static inline void	RemoveObject(Object **list, int num, int idx);
 static inline void	SquelchCachedName(Object *oPtr);
 
-static int		PublicObjectCmd(ClientData clientData,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const *objv);
 static int		PublicNRObjectCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const *objv);
-static int		PrivateObjectCmd(ClientData clientData,
+static int		PrivateNRObjectCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const *objv);
-static int		PrivateNRObjectCmd(ClientData clientData,
+static int		MyClassNRObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const *objv);
+static void		MyClassDeleted(ClientData clientData);
 
 /*
  * Methods in the oo::object and oo::class classes. First, we define a helper
@@ -152,65 +150,10 @@ static const char *initScript =
 /* " tcloo.tcl OO_LIBRARY oo::library;"; */
 
 /*
- * The scripted part of the definitions of slots.
- */
-
-static const char *slotScript =
-"::oo::define ::oo::Slot {\n"
-"    method Get {} {error unimplemented}\n"
-"    method Set list {error unimplemented}\n"
-"    method -set args {\n"
-"        uplevel 1 [list [namespace which my] Set $args]\n"
-"    }\n"
-"    method -append args {\n"
-"        uplevel 1 [list [namespace which my] Set [list"
-"                {*}[uplevel 1 [list [namespace which my] Get]] {*}$args]]\n"
-"    }\n"
-"    method -clear {} {uplevel 1 [list [namespace which my] Set {}]}\n"
-"    forward --default-operation my -append\n"
-"    method unknown {args} {\n"
-"        set def --default-operation\n"
-"        if {[llength $args] == 0} {\n"
-"            return [uplevel 1 [list [namespace which my] $def]]\n"
-"        } elseif {![string match -* [lindex $args 0]]} {\n"
-"            return [uplevel 1 [list [namespace which my] $def {*}$args]]\n"
-"        }\n"
-"        next {*}$args\n"
-"    }\n"
-"    export -set -append -clear\n"
-"    unexport unknown destroy\n"
-"}\n"
-"::oo::objdefine ::oo::define::superclass forward --default-operation my -set\n"
-"::oo::objdefine ::oo::define::mixin forward --default-operation my -set\n"
-"::oo::objdefine ::oo::objdefine::mixin forward --default-operation my -set\n";
-
-/*
- * The body of the <cloned> method of oo::object.
+ * The scripted part of the definitions of TclOO.
  */
 
-static const char *clonedBody =
-"foreach p [info procs [info object namespace $originObject]::*] {"
-"    set args [info args $p];"
-"    set idx -1;"
-"    foreach a $args {"
-"        lset args [incr idx] "
-"            [if {[info default $p $a d]} {list $a $d} {list $a}]"
-"    };"
-"    set b [info body $p];"
-"    set p [namespace tail $p];"
-"    proc $p $args $b;"
-"};"
-"foreach v [info vars [info object namespace $originObject]::*] {"
-"    upvar 0 $v vOrigin;"
-"    namespace upvar [namespace current] [namespace tail $v] vNew;"
-"    if {[info exists vOrigin]} {"
-"        if {[array exists vOrigin]} {"
-"            array set vNew [array get vOrigin];"
-"        } else {"
-"            set vNew $vOrigin;"
-"        }"
-"    }"
-"}";
+#include "tclOOScript.h"
 
 /*
  * The actual definition of the variable holding the TclOO stub table.
@@ -360,7 +303,7 @@ InitFoundation(
     ThreadLocalData *tsdPtr =
 	    Tcl_GetThreadData(&tsdKey, sizeof(ThreadLocalData));
     Foundation *fPtr = ckalloc(sizeof(Foundation));
-    Tcl_Obj *namePtr, *argsPtr, *bodyPtr;
+    Tcl_Obj *namePtr;
     Tcl_DString buffer;
     Command *cmdPtr;
     int i;
@@ -440,18 +383,6 @@ InitFoundation(
     }
 
     /*
-     * Create the default <cloned> method implementation, used when 'oo::copy'
-     * is called to finish the copying of one object to another.
-     */
-
-    TclNewLiteralStringObj(argsPtr, "originObject");
-    Tcl_IncrRefCount(argsPtr);
-    bodyPtr = Tcl_NewStringObj(clonedBody, -1);
-    TclOONewProcMethod(interp, fPtr->objectCls, 0, fPtr->clonedName, argsPtr,
-	    bodyPtr, NULL);
-    TclDecrRefCount(argsPtr);
-
-    /*
      * Finish setting up the class of classes by marking the 'new' method as
      * private; classes, unlike general objects, must have explicit names. We
      * also need to create the constructor for classes.
@@ -491,7 +422,12 @@ InitFoundation(
     if (TclOODefineSlots(fPtr) != TCL_OK) {
 	return TCL_ERROR;
     }
-    return Tcl_EvalEx(interp, slotScript, -1, 0);
+
+    /*
+     * Evaluate the remaining definitions, which are a compiled-in Tcl script.
+     */
+
+    return Tcl_EvalEx(interp, tclOOSetupScript, -1, 0);
 }
 
 /*
@@ -776,10 +712,9 @@ AllocObject(
 	if (nsPtr->parentPtr != NULL) {
 	    nsPtr = nsPtr->parentPtr;
 	}
-
     }
     oPtr->command = TclCreateObjCommandInNs(interp, nameStr,
-	(Tcl_Namespace *)nsPtr, PublicObjectCmd, oPtr, NULL);
+	(Tcl_Namespace *)nsPtr, TclOOPublicObjectCmd, oPtr, NULL);
 
     /*
      * Add the NRE command and trace directly. While this breaks a number of
@@ -796,7 +731,10 @@ AllocObject(
     tracePtr->refCount = 1;
 
     oPtr->myCommand = TclNRCreateCommandInNs(interp, "my", oPtr->namespacePtr,
-	    PrivateObjectCmd, PrivateNRObjectCmd, oPtr, MyDeleted);
+	    TclOOPrivateObjectCmd, PrivateNRObjectCmd, oPtr, MyDeleted);
+    oPtr->myclassCommand = TclNRCreateCommandInNs(interp, "myclass",
+	    oPtr->namespacePtr, TclOOMyClassObjCmd, MyClassNRObjCmd, oPtr,
+            MyClassDeleted);
     return oPtr;
 }
 
@@ -824,12 +762,12 @@ SquelchCachedName(
 /*
  * ----------------------------------------------------------------------
  *
- * MyDeleted --
+ * MyDeleted, MyClassDeleted --
  *
- *	This callback is triggered when the object's [my] command is deleted
- *	by any mechanism. It just marks the object as not having a [my]
- *	command, and so prevents cleanup of that when the object itself is
- *	deleted.
+ *	These callbacks are triggered when the object's [my] or [myclass]
+ *	commands are deleted by any mechanism. They just mark the object as
+ *	not having a [my] command or [myclass] command, and so prevent cleanup
+ *	of those commands when the object itself is deleted.
  *
  * ----------------------------------------------------------------------
  */
@@ -843,6 +781,14 @@ MyDeleted(
 
     oPtr->myCommand = NULL;
 }
+
+static void
+MyClassDeleted(
+    ClientData clientData)
+{
+    Object *oPtr = clientData;
+    oPtr->myclassCommand = NULL;
+}
 
 /*
  * ----------------------------------------------------------------------
@@ -1215,6 +1161,9 @@ ObjectNamespaceDeleted(
 	Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->command);
     }
 
+    if (oPtr->myclassCommand) {
+	Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->myclassCommand);
+    }
     if (oPtr->myCommand) {
 	Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->myCommand);
     }
@@ -2453,7 +2402,7 @@ Tcl_ObjectSetMetadata(
 /*
  * ----------------------------------------------------------------------
  *
- * PublicObjectCmd, PrivateObjectCmd, TclOOInvokeObject --
+ * TclOOPublicObjectCmd, TclOOPrivateObjectCmd, TclOOInvokeObject --
  *
  *	Main entry point for object invocations. The Public* and Private*
  *	wrapper functions (implementations of both object instance commands
@@ -2463,8 +2412,8 @@ Tcl_ObjectSetMetadata(
  * ----------------------------------------------------------------------
  */
 
-static int
-PublicObjectCmd(
+int
+TclOOPublicObjectCmd(
     ClientData clientData,
     Tcl_Interp *interp,
     int objc,
@@ -2484,8 +2433,8 @@ PublicNRObjectCmd(
 	    NULL);
 }
 
-static int
-PrivateObjectCmd(
+int
+TclOOPrivateObjectCmd(
     ClientData clientData,
     Tcl_Interp *interp,
     int objc,
@@ -2538,6 +2487,43 @@ TclOOInvokeObject(
 /*
  * ----------------------------------------------------------------------
  *
+ * TclOOMyClassObjCmd, MyClassNRObjCmd --
+ *
+ *	Special trap door to allow an object to delegate simply to its class.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOOMyClassObjCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    return Tcl_NRCallObjProc(interp, MyClassNRObjCmd, clientData, objc, objv);
+}
+
+static int
+MyClassNRObjCmd(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    Object *oPtr = clientData;
+
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "methodName ?arg ...?");
+	return TCL_ERROR;
+    }
+    return TclOOObjectCmdCore(oPtr->selfCls->thisPtr, interp, objc, objv, 0,
+	    NULL);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
  * TclOOObjectCmdCore, FinalizeObjectCall --
  *
  *	Main function for object invocations. Does call chain creation,
@@ -2892,9 +2878,9 @@ Tcl_GetObjectFromObj(
     if (cmdPtr == NULL) {
 	goto notAnObject;
     }
-    if (cmdPtr->objProc != PublicObjectCmd) {
+    if (cmdPtr->objProc != TclOOPublicObjectCmd) {
 	cmdPtr = (Command *) TclGetOriginalCommand((Tcl_Command) cmdPtr);
-	if (cmdPtr == NULL || cmdPtr->objProc != PublicObjectCmd) {
+	if (cmdPtr == NULL || cmdPtr->objProc != TclOOPublicObjectCmd) {
 	    goto notAnObject;
 	}
     }
diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c
index 763f0ad..13c98f4 100644
--- a/generic/tclOOBasic.c
+++ b/generic/tclOOBasic.c
@@ -83,7 +83,7 @@ TclOO_Class_Constructor(
     Tcl_Obj *const *objv)
 {
     Object *oPtr = (Object *) Tcl_ObjectContextObject(context);
-    Tcl_Obj **invoke;
+    Tcl_Obj **invoke, *nameObj;
 
     if (objc-1 > Tcl_ObjectContextSkippedArgs(context)) {
 	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
@@ -94,6 +94,17 @@ TclOO_Class_Constructor(
     }
 
     /*
+     * Make the class definition delegate. This is special; it doesn't reenter
+     * here (and the class definition delegate doesn't run any constructors).
+     */
+
+    nameObj = Tcl_NewStringObj(oPtr->namespacePtr->fullName, -1);
+    Tcl_AppendToObj(nameObj, ":: oo ::delegate", -1);
+    Tcl_NewObjectInstance(interp, (Tcl_Class) oPtr->fPtr->classCls,
+	    TclGetString(nameObj), NULL, -1, NULL, -1);
+    Tcl_DecrRefCount(nameObj);
+
+    /*
      * Delegate to [oo::define] to do the work.
      */
 
@@ -111,7 +122,7 @@ TclOO_Class_Constructor(
     Tcl_IncrRefCount(invoke[1]);
     Tcl_IncrRefCount(invoke[2]);
     TclNRAddCallback(interp, DecrRefsPostClassConstructor,
-	    invoke, NULL, NULL, NULL);
+	    invoke, oPtr, NULL, NULL);
 
     /*
      * Tricky point: do not want the extra reported level in the Tcl stack
@@ -128,12 +139,27 @@ DecrRefsPostClassConstructor(
     int result)
 {
     Tcl_Obj **invoke = data[0];
+    Object *oPtr = data[1];
+    Tcl_InterpState saved;
+    int code;
 
     TclDecrRefCount(invoke[0]);
     TclDecrRefCount(invoke[1]);
     TclDecrRefCount(invoke[2]);
+    invoke[0] = Tcl_NewStringObj("::oo::MixinClassDelegates", -1);
+    invoke[1] = TclOOObjectName(interp, oPtr);
+    Tcl_IncrRefCount(invoke[0]);
+    Tcl_IncrRefCount(invoke[1]);
+    saved = Tcl_SaveInterpState(interp, result);
+    code = Tcl_EvalObjv(interp, 2, invoke, 0);
+    TclDecrRefCount(invoke[0]);
+    TclDecrRefCount(invoke[1]);
     ckfree(invoke);
-    return result;
+    if (code != TCL_OK) {
+	Tcl_DiscardInterpState(saved);
+	return code;
+    }
+    return Tcl_RestoreInterpState(interp, saved);
 }
 
 /*
diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c
index 19cd42b..17680a0 100644
--- a/generic/tclOODefineCmds.c
+++ b/generic/tclOODefineCmds.c
@@ -37,14 +37,17 @@ struct DeclaredSlot {
     const char *name;
     const Tcl_MethodType getterType;
     const Tcl_MethodType setterType;
+    const Tcl_MethodType resolverType;
 };
 
-#define SLOT(name,getter,setter)					\
+#define SLOT(name,getter,setter,resolver)				\
     {"::oo::" name,							\
 	    {TCL_OO_METHOD_VERSION_CURRENT, "core method: " name " Getter", \
 		    getter, NULL, NULL},				\
 	    {TCL_OO_METHOD_VERSION_CURRENT, "core method: " name " Setter", \
-		    setter, NULL, NULL}}
+		    setter, NULL, NULL},				\
+	    {TCL_OO_METHOD_VERSION_CURRENT, "core method: " name " Resolver", \
+		    resolver, NULL, NULL}}
 
 /*
  * Forward declarations.
@@ -109,20 +112,23 @@ static int		ObjVarsGet(ClientData clientData,
 static int		ObjVarsSet(ClientData clientData,
 			    Tcl_Interp *interp, Tcl_ObjectContext context,
 			    int objc, Tcl_Obj *const *objv);
+static int		ResolveClass(ClientData clientData,
+			    Tcl_Interp *interp, Tcl_ObjectContext context,
+			    int objc, Tcl_Obj *const *objv);
 
 /*
  * Now define the slots used in declarations.
  */
 
 static const struct DeclaredSlot slots[] = {
-    SLOT("define::filter",      ClassFilterGet, ClassFilterSet),
-    SLOT("define::mixin",       ClassMixinGet,  ClassMixinSet),
-    SLOT("define::superclass",  ClassSuperGet,  ClassSuperSet),
-    SLOT("define::variable",    ClassVarsGet,   ClassVarsSet),
-    SLOT("objdefine::filter",   ObjFilterGet,   ObjFilterSet),
-    SLOT("objdefine::mixin",    ObjMixinGet,    ObjMixinSet),
-    SLOT("objdefine::variable", ObjVarsGet,     ObjVarsSet),
-    {NULL, {0, 0, 0, 0, 0}, {0, 0, 0, 0, 0}}
+    SLOT("define::filter",      ClassFilterGet, ClassFilterSet, NULL),
+    SLOT("define::mixin",       ClassMixinGet,  ClassMixinSet, ResolveClass),
+    SLOT("define::superclass",  ClassSuperGet,  ClassSuperSet, ResolveClass),
+    SLOT("define::variable",    ClassVarsGet,   ClassVarsSet, NULL),
+    SLOT("objdefine::filter",   ObjFilterGet,   ObjFilterSet, NULL),
+    SLOT("objdefine::mixin",    ObjMixinGet,    ObjMixinSet, ResolveClass),
+    SLOT("objdefine::variable", ObjVarsGet,     ObjVarsSet, NULL),
+    {NULL, {0, 0, 0, 0, 0}, {0, 0, 0, 0, 0}, {0, 0, 0, 0, 0}}
 };
 
 /*
@@ -1841,70 +1847,6 @@ TclOODefineMethodObjCmd(
 /*
  * ----------------------------------------------------------------------
  *
- * TclOODefineMixinObjCmd --
- *
- *	Implementation of the "mixin" subcommand of the "oo::define" and
- *	"oo::objdefine" commands.
- *
- * ----------------------------------------------------------------------
- */
-
-int
-TclOODefineMixinObjCmd(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    const int objc,
-    Tcl_Obj *const *objv)
-{
-    int isInstanceMixin = (clientData != NULL);
-    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
-    Class **mixins;
-    int i;
-
-    if (oPtr == NULL) {
-	return TCL_ERROR;
-    }
-    if (!isInstanceMixin && !oPtr->classPtr) {
-	Tcl_SetObjResult(interp, Tcl_NewStringObj(
-		"attempt to misuse API", -1));
-	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
-	return TCL_ERROR;
-    }
-    mixins = TclStackAlloc(interp, sizeof(Class *) * (objc-1));
-
-    for (i=1 ; i<objc ; i++) {
-	Class *clsPtr = GetClassInOuterContext(interp, objv[i],
-		"may only mix in classes");
-
-	if (clsPtr == NULL) {
-	    goto freeAndError;
-	}
-	if (!isInstanceMixin && TclOOIsReachable(oPtr->classPtr, clsPtr)) {
-	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
-		    "may not mix a class into itself", -1));
-	    Tcl_SetErrorCode(interp, "TCL", "OO", "SELF_MIXIN", NULL);
-	    goto freeAndError;
-	}
-	mixins[i-1] = clsPtr;
-    }
-
-    if (isInstanceMixin) {
-	TclOOObjectSetMixins(oPtr, objc-1, mixins);
-    } else {
-	TclOOClassSetMixins(interp, oPtr->classPtr, objc-1, mixins);
-    }
-
-    TclStackFree(interp, mixins);
-    return TCL_OK;
-
-  freeAndError:
-    TclStackFree(interp, mixins);
-    return TCL_ERROR;
-}
-
-/*
- * ----------------------------------------------------------------------
- *
  * TclOODefineRenameMethodObjCmd --
  *
  *	Implementation of the "renamemethod" subcommand of the "oo::define"
@@ -2127,6 +2069,7 @@ TclOODefineSlots(
     const struct DeclaredSlot *slotInfoPtr;
     Tcl_Obj *getName = Tcl_NewStringObj("Get", -1);
     Tcl_Obj *setName = Tcl_NewStringObj("Set", -1);
+    Tcl_Obj *resolveName = Tcl_NewStringObj("Resolve", -1);
     Class *slotCls;
 
     slotCls = ((Object *) Tcl_NewObjectInstance(fPtr->interp, (Tcl_Class)
@@ -2136,9 +2079,10 @@ TclOODefineSlots(
     }
     Tcl_IncrRefCount(getName);
     Tcl_IncrRefCount(setName);
+    Tcl_IncrRefCount(resolveName);
     for (slotInfoPtr = slots ; slotInfoPtr->name ; slotInfoPtr++) {
 	Tcl_Object slotObject = Tcl_NewObjectInstance(fPtr->interp,
-		(Tcl_Class) slotCls, slotInfoPtr->name, NULL,-1,NULL,0);
+		(Tcl_Class) slotCls, slotInfoPtr->name, NULL, -1, NULL, 0);
 
 	if (slotObject == NULL) {
 	    continue;
@@ -2147,9 +2091,14 @@ TclOODefineSlots(
 		&slotInfoPtr->getterType, NULL);
 	Tcl_NewInstanceMethod(fPtr->interp, slotObject, setName, 0,
 		&slotInfoPtr->setterType, NULL);
+	if (slotInfoPtr->resolverType.callProc) {
+	    Tcl_NewInstanceMethod(fPtr->interp, slotObject, resolveName, 0,
+		    &slotInfoPtr->resolverType, NULL);
+	}
     }
     Tcl_DecrRefCount(getName);
     Tcl_DecrRefCount(setName);
+    Tcl_DecrRefCount(resolveName);
     return TCL_OK;
 }
 
@@ -2879,6 +2828,59 @@ ObjVarsSet(
 }
 
 /*
+ * ----------------------------------------------------------------------
+ *
+ * ResolveClass --
+ *
+ *	Implementation of the "Resolve" support method for some slots (those
+ *	that are slots around a list of classes). This resolves possible class
+ *	names to their fully-qualified names if possible.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static int
+ResolveClass(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    Tcl_ObjectContext context,
+    int objc,
+    Tcl_Obj *const *objv)
+{
+    int idx = Tcl_ObjectContextSkippedArgs(context);
+    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
+    Class *clsPtr;
+
+    /*
+     * Check if were called wrongly. The definition context isn't used...
+     * except that GetClassInOuterContext() assumes that it is there.
+     */
+
+    if (oPtr == NULL) {
+	return TCL_ERROR;
+    } else if (objc != idx + 1) {
+	Tcl_WrongNumArgs(interp, idx, objv, "slotElement");
+	return TCL_ERROR;
+    }
+
+    /*
+     * Resolve the class if possible. If not, remove any resolution error and
+     * return what we've got anyway as the failure might not be fatal overall.
+     */
+
+    clsPtr = GetClassInOuterContext(interp, objv[idx],
+	    "USER SHOULD NOT SEE THIS MESSAGE");
+    if (clsPtr == NULL) {
+	Tcl_ResetResult(interp);
+	Tcl_SetObjResult(interp, objv[idx]);
+    } else {
+	Tcl_SetObjResult(interp, TclOOObjectName(interp, clsPtr->thisPtr));
+    }
+
+    return TCL_OK;
+}
+
+/*
  * Local Variables:
  * mode: c
  * c-basic-offset: 4
diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h
index a43ab76..1f30fed 100644
--- a/generic/tclOOInt.h
+++ b/generic/tclOOInt.h
@@ -209,6 +209,8 @@ typedef struct Object {
     PrivateVariableList privateVariables;
 				/* Configurations for the variable resolver
 				 * used inside methods. */
+    Tcl_Command myclassCommand;	/* Reference to this object's class dispatcher
+				 * command. */
 } Object;
 
 #define OBJECT_DELETED	1	/* Flag to say that an object has been
@@ -597,7 +599,7 @@ MODULE_SCOPE void	TclOOSetupVariableResolver(Tcl_Namespace *nsPtr);
 #define FOREACH(var,ary) \
     for(i=0 ; i<(ary).num; i++) if ((ary).list[i] == NULL) { \
 	continue; \
-    } else if (var = (ary).list[i], 1) 
+    } else if (var = (ary).list[i], 1)
 
 /*
  * A variation where the array is an array of structs. There's no issue with
diff --git a/generic/tclOOScript.h b/generic/tclOOScript.h
new file mode 100644
index 0000000..2213ce3
--- /dev/null
+++ b/generic/tclOOScript.h
@@ -0,0 +1,263 @@
+/*
+ * tclOOScript.h --
+ *
+ *	This file contains support scripts for TclOO. They are defined here so
+ *	that the code can be definitely run even in safe interpreters; TclOO's
+ *	core setup is safe.
+ *
+ * Copyright (c) 2012-2018 Donal K. Fellows
+ * Copyright (c) 2013 Andreas Kupries
+ * Copyright (c) 2017 Gerald Lester
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#ifndef TCL_OO_SCRIPT_H
+#define TCL_OO_SCRIPT_H
+
+/*
+ * The scripted part of the definitions of TclOO.
+ *
+ * Compiled from generic/tclOOScript.tcl by tools/makeHeader.tcl, which
+ * contains the commented version of everything; *this* file is automatically
+ * generated.
+ */
+
+static const char *tclOOSetupScript =
+/* !BEGIN!: Do not edit below this line. */
+"::namespace eval ::oo {\n"
+"\t::namespace path {}\n"
+"\tnamespace eval Helpers {\n"
+"\t\t::namespace path {}\n"
+"\t\tproc callback {method args} {\n"
+"\t\t\tlist [uplevel 1 {::namespace which my}] $method {*}$args\n"
+"\t\t}\n"
+"\t\tnamespace export callback\n"
+"\t\tnamespace eval tmp {namespace import ::oo::Helpers::callback}\n"
+"\t\tnamespace export -clear\n"
+"\t\trename tmp::callback mymethod\n"
+"\t\tnamespace delete tmp\n"
+"\t\tproc classvariable {name args} {\n"
+"\t\t\tset ns [info object namespace [uplevel 1 {self class}]]\n"
+"\t\t\tforeach v [list $name {*}$args] {\n"
+"\t\t\t\tif {[string match *(*) $v]} {\n"
+"\t\t\t\t\tset reason \"can\'t create a scalar variable that looks like an array element\"\n"
+"\t\t\t\t\treturn -code error -errorcode {TCL UPVAR LOCAL_ELEMENT} \\\n"
+"\t\t\t\t\t\t[format {bad variable name \"%s\": %s} $v $reason]\n"
+"\t\t\t\t}\n"
+"\t\t\t\tif {[string match *::* $v]} {\n"
+"\t\t\t\t\tset reason \"can\'t create a local variable with a namespace separator in it\"\n"
+"\t\t\t\t\treturn -code error -errorcode {TCL UPVAR INVERTED} \\\n"
+"\t\t\t\t\t\t[format {bad variable name \"%s\": %s} $v $reason]\n"
+"\t\t\t\t}\n"
+"\t\t\t\tlappend vs $v $v\n"
+"\t\t\t}\n"
+"\t\t\ttailcall namespace upvar $ns {*}$vs\n"
+"\t\t}\n"
+"\t\tproc link {args} {\n"
+"\t\t\tset ns [uplevel 1 {::namespace current}]\n"
+"\t\t\tforeach link $args {\n"
+"\t\t\t\tif {[llength $link] == 2} {\n"
+"\t\t\t\t\tlassign $link src dst\n"
+"\t\t\t\t} elseif {[llength $link] == 1} {\n"
+"\t\t\t\t\tlassign $link src\n"
+"\t\t\t\t\tset dst $src\n"
+"\t\t\t\t} else {\n"
+"\t\t\t\t\treturn -code error -errorcode {TCLOO CMDLINK FORMAT} \\\n"
+"\t\t\t\t\t\t\"bad link description; must only have one or two elements\"\n"
+"\t\t\t\t}\n"
+"\t\t\t\tif {![string match ::* $src]} {\n"
+"\t\t\t\t\tset src [string cat $ns :: $src]\n"
+"\t\t\t\t}\n"
+"\t\t\t\tinterp alias {} $src {} ${ns}::my $dst\n"
+"\t\t\t\ttrace add command ${ns}::my delete [list \\\n"
+"\t\t\t\t\t::oo::UnlinkLinkedCommand $src]\n"
+"\t\t\t}\n"
+"\t\t\treturn\n"
+"\t\t}\n"
+"\t}\n"
+"\tproc UnlinkLinkedCommand {cmd args} {\n"
+"\t\tif {[namespace which $cmd] ne {}} {\n"
+"\t\t\trename $cmd {}\n"
+"\t\t}\n"
+"\t}\n"
+"\tproc DelegateName {class} {\n"
+"\t\tstring cat [info object namespace $class] {:: oo ::delegate}\n"
+"\t}\n"
+"\tproc MixinClassDelegates {class} {\n"
+"\t\tif {![info object isa class $class]} {\n"
+"\t\t\treturn\n"
+"\t\t}\n"
+"\t\tset delegate [DelegateName $class]\n"
+"\t\tif {![info object isa class $delegate]} {\n"
+"\t\t\treturn\n"
+"\t\t}\n"
+"\t\tforeach c [info class superclass $class] {\n"
+"\t\t\tset d [DelegateName $c]\n"
+"\t\t\tif {![info object isa class $d]} {\n"
+"\t\t\t\tcontinue\n"
+"\t\t\t}\n"
+"\t\t\tdefine $delegate superclass -append $d\n"
+"\t\t}\n"
+"\t\tobjdefine $class mixin -append $delegate\n"
+"\t}\n"
+"\tproc UpdateClassDelegatesAfterClone {originObject targetObject} {\n"
+"\t\tset originDelegate [DelegateName $originObject]\n"
+"\t\tset targetDelegate [DelegateName $targetObject]\n"
+"\t\tif {\n"
+"\t\t\t[info object isa class $originDelegate]\n"
+"\t\t\t&& ![info object isa class $targetDelegate]\n"
+"\t\t} then {\n"
+"\t\t\tcopy $originDelegate $targetDelegate\n"
+"\t\t\tobjdefine $targetObject mixin -set \\\n"
+"\t\t\t\t{*}[lmap c [info object mixin $targetObject] {\n"
+"\t\t\t\t\tif {$c eq $originDelegate} {set targetDelegate} {set c}\n"
+"\t\t\t\t}]\n"
+"\t\t}\n"
+"\t}\n"
+"\tproc define::classmethod {name {args {}} {body {}}} {\n"
+"\t\t::set argc [::llength [::info level 0]]\n"
+"\t\t::if {$argc == 3} {\n"
+"\t\t\t::return -code error -errorcode {TCL WRONGARGS} [::format \\\n"
+"\t\t\t\t{wrong # args: should be \"%s name \?args body\?\"} \\\n"
+"\t\t\t\t[::lindex [::info level 0] 0]]\n"
+"\t\t}\n"
+"\t\t::set cls [::uplevel 1 self]\n"
+"\t\t::if {$argc == 4} {\n"
+"\t\t\t::oo::define [::oo::DelegateName $cls] method $name $args $body\n"
+"\t\t}\n"
+"\t\t::tailcall forward $name myclass $name\n"
+"\t}\n"
+"\tproc define::initialise {body} {\n"
+"\t\t::set clsns [::info object namespace [::uplevel 1 self]]\n"
+"\t\t::tailcall apply [::list {} $body $clsns]\n"
+"\t}\n"
+"\tnamespace eval define {\n"
+"\t\t::namespace export initialise\n"
+"\t\t::namespace eval tmp {::namespace import ::oo::define::initialise}\n"
+"\t\t::namespace export -clear\n"
+"\t\t::rename tmp::initialise initialize\n"
+"\t\t::namespace delete tmp\n"
+"\t}\n"
+"\tdefine Slot {\n"
+"\t\tmethod Get {} {\n"
+"\t\t\treturn -code error -errorcode {TCLOO ABSTRACT_SLOT} \"unimplemented\"\n"
+"\t\t}\n"
+"\t\tmethod Set list {\n"
+"\t\t\treturn -code error -errorcode {TCLOO ABSTRACT_SLOT} \"unimplemented\"\n"
+"\t\t}\n"
+"\t\tmethod Resolve list {\n"
+"\t\t\treturn $list\n"
+"\t\t}\n"
+"\t\tmethod -set args {\n"
+"\t\t\tset my [namespace which my]\n"
+"\t\t\tset args [lmap a $args {uplevel 1 [list $my Resolve $a]}]\n"
+"\t\t\ttailcall my Set $args\n"
+"\t\t}\n"
+"\t\tmethod -append args {\n"
+"\t\t\tset my [namespace which my]\n"
+"\t\t\tset args [lmap a $args {uplevel 1 [list $my Resolve $a]}]\n"
+"\t\t\tset current [uplevel 1 [list $my Get]]\n"
+"\t\t\ttailcall my Set [list {*}$current {*}$args]\n"
+"\t\t}\n"
+"\t\tmethod -clear {} {tailcall my Set {}}\n"
+"\t\tmethod -prepend args {\n"
+"\t\t\tset my [namespace which my]\n"
+"\t\t\tset args [lmap a $args {uplevel 1 [list $my Resolve $a]}]\n"
+"\t\t\tset current [uplevel 1 [list $my Get]]\n"
+"\t\t\ttailcall my Set [list {*}$args {*}$current]\n"
+"\t\t}\n"
+"\t\tmethod -remove args {\n"
+"\t\t\tset my [namespace which my]\n"
+"\t\t\tset args [lmap a $args {uplevel 1 [list $my Resolve $a]}]\n"
+"\t\t\tset current [uplevel 1 [list $my Get]]\n"
+"\t\t\ttailcall my Set [lmap val $current {\n"
+"\t\t\t\tif {$val in $args} continue else {set val}\n"
+"\t\t\t}]\n"
+"\t\t}\n"
+"\t\tforward --default-operation my -append\n"
+"\t\tmethod unknown {args} {\n"
+"\t\t\tset def --default-operation\n"
+"\t\t\tif {[llength $args] == 0} {\n"
+"\t\t\t\ttailcall my $def\n"
+"\t\t\t} elseif {![string match -* [lindex $args 0]]} {\n"
+"\t\t\t\ttailcall my $def {*}$args\n"
+"\t\t\t}\n"
+"\t\t\tnext {*}$args\n"
+"\t\t}\n"
+"\t\texport -set -append -clear -prepend -remove\n"
+"\t\tunexport unknown destroy\n"
+"\t}\n"
+"\tobjdefine define::superclass forward --default-operation my -set\n"
+"\tobjdefine define::mixin forward --default-operation my -set\n"
+"\tobjdefine objdefine::mixin forward --default-operation my -set\n"
+"\tdefine object method <cloned> {originObject} {\n"
+"\t\tforeach p [info procs [info object namespace $originObject]::*] {\n"
+"\t\t\tset args [info args $p]\n"
+"\t\t\tset idx -1\n"
+"\t\t\tforeach a $args {\n"
+"\t\t\t\tif {[info default $p $a d]} {\n"
+"\t\t\t\t\tlset args [incr idx] [list $a $d]\n"
+"\t\t\t\t} else {\n"
+"\t\t\t\t\tlset args [incr idx] [list $a]\n"
+"\t\t\t\t}\n"
+"\t\t\t}\n"
+"\t\t\tset b [info body $p]\n"
+"\t\t\tset p [namespace tail $p]\n"
+"\t\t\tproc $p $args $b\n"
+"\t\t}\n"
+"\t\tforeach v [info vars [info object namespace $originObject]::*] {\n"
+"\t\t\tupvar 0 $v vOrigin\n"
+"\t\t\tnamespace upvar [namespace current] [namespace tail $v] vNew\n"
+"\t\t\tif {[info exists vOrigin]} {\n"
+"\t\t\t\tif {[array exists vOrigin]} {\n"
+"\t\t\t\t\tarray set vNew [array get vOrigin]\n"
+"\t\t\t\t} else {\n"
+"\t\t\t\t\tset vNew $vOrigin\n"
+"\t\t\t\t}\n"
+"\t\t\t}\n"
+"\t\t}\n"
+"\t}\n"
+"\tdefine class method <cloned> {originObject} {\n"
+"\t\tnext $originObject\n"
+"\t\t::oo::UpdateClassDelegatesAfterClone $originObject [self]\n"
+"\t}\n"
+"\tclass create singleton {\n"
+"\t\tsuperclass class\n"
+"\t\tvariable object\n"
+"\t\tunexport create createWithNamespace\n"
+"\t\tmethod new args {\n"
+"\t\t\tif {![info exists object] || ![info object isa object $object]} {\n"
+"\t\t\t\tset object [next {*}$args]\n"
+"\t\t\t\t::oo::objdefine $object {\n"
+"\t\t\t\t\tmethod destroy {} {\n"
+"\t\t\t\t\t\t::return -code error -errorcode {TCLOO SINGLETON} \\\n"
+"\t\t\t\t\t\t\t\"may not destroy a singleton object\"\n"
+"\t\t\t\t\t}\n"
+"\t\t\t\t\tmethod <cloned> {originObject} {\n"
+"\t\t\t\t\t\t::return -code error -errorcode {TCLOO SINGLETON} \\\n"
+"\t\t\t\t\t\t\t\"may not clone a singleton object\"\n"
+"\t\t\t\t\t}\n"
+"\t\t\t\t}\n"
+"\t\t\t}\n"
+"\t\t\treturn $object\n"
+"\t\t}\n"
+"\t}\n"
+"\tclass create abstract {\n"
+"\t\tsuperclass class\n"
+"\t\tunexport create createWithNamespace new\n"
+"\t}\n"
+"}\n"
+/* !END!: Do not edit above this line. */
+;
+
+#endif /* TCL_OO_SCRIPT_H */
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclOOScript.tcl b/generic/tclOOScript.tcl
new file mode 100644
index 0000000..a48eab5
--- /dev/null
+++ b/generic/tclOOScript.tcl
@@ -0,0 +1,456 @@
+# tclOOScript.h --
+#
+# 	This file contains support scripts for TclOO. They are defined here so
+# 	that the code can be definitely run even in safe interpreters; TclOO's
+# 	core setup is safe.
+#
+# Copyright (c) 2012-2018 Donal K. Fellows
+# Copyright (c) 2013 Andreas Kupries
+# Copyright (c) 2017 Gerald Lester
+#
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+::namespace eval ::oo {
+    ::namespace path {}
+
+    #
+    # Commands that are made available to objects by default.
+    #
+    namespace eval Helpers {
+	::namespace path {}
+
+	# ------------------------------------------------------------------
+	#
+	# callback, mymethod --
+	#
+	#	Create a script prefix that calls a method on the current
+	#	object. Same operation, two names.
+	#
+	# ------------------------------------------------------------------
+
+	proc callback {method args} {
+	    list [uplevel 1 {::namespace which my}] $method {*}$args
+	}
+
+	# Make the [callback] command appear as [mymethod] too.
+	namespace export callback
+	namespace eval tmp {namespace import ::oo::Helpers::callback}
+	namespace export -clear
+	rename tmp::callback mymethod
+	namespace delete tmp
+
+	# ------------------------------------------------------------------
+	#
+	# classvariable --
+	#
+	#	Link to a variable in the class of the current object.
+	#
+	# ------------------------------------------------------------------
+
+	proc classvariable {name args} {
+	    # Get a reference to the class's namespace
+	    set ns [info object namespace [uplevel 1 {self class}]]
+	    # Double up the list of variable names
+	    foreach v [list $name {*}$args] {
+		if {[string match *(*) $v]} {
+		    set reason "can't create a scalar variable that looks like an array element"
+		    return -code error -errorcode {TCL UPVAR LOCAL_ELEMENT} \
+			[format {bad variable name "%s": %s} $v $reason]
+		}
+		if {[string match *::* $v]} {
+		    set reason "can't create a local variable with a namespace separator in it"
+		    return -code error -errorcode {TCL UPVAR INVERTED} \
+			[format {bad variable name "%s": %s} $v $reason]
+		}
+		lappend vs $v $v
+	    }
+	    # Lastly, link the caller's local variables to the class's variables
+	    tailcall namespace upvar $ns {*}$vs
+	}
+
+	# ------------------------------------------------------------------
+	#
+	# link --
+	#
+	#	Make a command that invokes a method on the current object.
+	#	The name of the command and the name of the method match by
+	#	default.
+	#
+	# ------------------------------------------------------------------
+
+	proc link {args} {
+	    set ns [uplevel 1 {::namespace current}]
+	    foreach link $args {
+		if {[llength $link] == 2} {
+		    lassign $link src dst
+		} elseif {[llength $link] == 1} {
+		    lassign $link src
+		    set dst $src
+		} else {
+		    return -code error -errorcode {TCLOO CMDLINK FORMAT} \
+			"bad link description; must only have one or two elements"
+		}
+		if {![string match ::* $src]} {
+		    set src [string cat $ns :: $src]
+		}
+		interp alias {} $src {} ${ns}::my $dst
+		trace add command ${ns}::my delete [list \
+		    ::oo::UnlinkLinkedCommand $src]
+	    }
+	    return
+	}
+    }
+
+    # ----------------------------------------------------------------------
+    #
+    # UnlinkLinkedCommand --
+    #
+    #	Callback used to remove linked command when the underlying mechanism
+    #	that supports it is deleted.
+    #
+    # ----------------------------------------------------------------------
+
+    proc UnlinkLinkedCommand {cmd args} {
+	if {[namespace which $cmd] ne {}} {
+	    rename $cmd {}
+	}
+    }
+
+    # ----------------------------------------------------------------------
+    #
+    # DelegateName --
+    #
+    #	Utility that gets the name of the class delegate for a class. It's
+    #	trivial, but makes working with them much easier as delegate names are
+    #	intentionally hard to create by accident.
+    #
+    # ----------------------------------------------------------------------
+
+    proc DelegateName {class} {
+	string cat [info object namespace $class] {:: oo ::delegate}
+    }
+
+    # ----------------------------------------------------------------------
+    #
+    # MixinClassDelegates --
+    #
+    #	Support code called *after* [oo::define] inside the constructor of a
+    #	class that patches in the appropriate class delegates.
+    #
+    # ----------------------------------------------------------------------
+
+    proc MixinClassDelegates {class} {
+	if {![info object isa class $class]} {
+	    return
+	}
+	set delegate [DelegateName $class]
+	if {![info object isa class $delegate]} {
+	    return
+	}
+	foreach c [info class superclass $class] {
+	    set d [DelegateName $c]
+	    if {![info object isa class $d]} {
+		continue
+	    }
+	    define $delegate superclass -append $d
+	}
+	objdefine $class mixin -append $delegate
+    }
+
+    # ----------------------------------------------------------------------
+    #
+    # UpdateClassDelegatesAfterClone --
+    #
+    #	Support code that is like [MixinClassDelegates] except for when a
+    #	class is cloned.
+    #
+    # ----------------------------------------------------------------------
+
+    proc UpdateClassDelegatesAfterClone {originObject targetObject} {
+	# Rebuild the class inheritance delegation class
+	set originDelegate [DelegateName $originObject]
+	set targetDelegate [DelegateName $targetObject]
+	if {
+	    [info object isa class $originDelegate]
+	    && ![info object isa class $targetDelegate]
+	} then {
+	    copy $originDelegate $targetDelegate
+	    objdefine $targetObject mixin -set \
+		{*}[lmap c [info object mixin $targetObject] {
+		    if {$c eq $originDelegate} {set targetDelegate} {set c}
+		}]
+	}
+    }
+
+    # ----------------------------------------------------------------------
+    #
+    # oo::define::classmethod --
+    #
+    #	Defines a class method. See define(n) for details.
+    #
+    # Note that the ::oo::define namespace is semi-public and a bit weird
+    # anyway, so we don't regard the namespace path as being under control:
+    # fully qualified names are used for everything.
+    #
+    # ----------------------------------------------------------------------
+
+    proc define::classmethod {name {args {}} {body {}}} {
+        # Create the method on the class if the caller gave arguments and body
+        ::set argc [::llength [::info level 0]]
+        ::if {$argc == 3} {
+            ::return -code error -errorcode {TCL WRONGARGS} [::format \
+		{wrong # args: should be "%s name ?args body?"} \
+                [::lindex [::info level 0] 0]]
+        }
+        ::set cls [::uplevel 1 self]
+        ::if {$argc == 4} {
+            ::oo::define [::oo::DelegateName $cls] method $name $args $body
+        }
+        # Make the connection by forwarding
+        ::tailcall forward $name myclass $name
+    }
+
+    # ----------------------------------------------------------------------
+    #
+    # oo::define::initialise, oo::define::initialize --
+    #
+    #	Do specific initialisation for a class. See define(n) for details.
+    #
+    # Note that the ::oo::define namespace is semi-public and a bit weird
+    # anyway, so we don't regard the namespace path as being under control:
+    # fully qualified names are used for everything.
+    #
+    # ----------------------------------------------------------------------
+
+    proc define::initialise {body} {
+        ::set clsns [::info object namespace [::uplevel 1 self]]
+        ::tailcall apply [::list {} $body $clsns]
+    }
+
+    # Make the [initialise] definition appear as [initialize] too
+    namespace eval define {
+	::namespace export initialise
+	::namespace eval tmp {::namespace import ::oo::define::initialise}
+	::namespace export -clear
+	::rename tmp::initialise initialize
+	::namespace delete tmp
+    }
+
+    # ----------------------------------------------------------------------
+    #
+    # Slot --
+    #
+    #	The class of slot operations, which are basically lists at the low
+    #	level of TclOO; this provides a more consistent interface to them.
+    #
+    # ----------------------------------------------------------------------
+
+    define Slot {
+	# ------------------------------------------------------------------
+	#
+	# Slot Get --
+	#
+	#	Basic slot getter. Retrieves the contents of the slot.
+	#	Particular slots must provide concrete non-erroring
+	#	implementation.
+	#
+	# ------------------------------------------------------------------
+
+	method Get {} {
+	    return -code error -errorcode {TCLOO ABSTRACT_SLOT} "unimplemented"
+	}
+
+	# ------------------------------------------------------------------
+	#
+	# Slot Set --
+	#
+	#	Basic slot setter. Sets the contents of the slot.  Particular
+	#	slots must provide concrete non-erroring implementation.
+	#
+	# ------------------------------------------------------------------
+
+	method Set list {
+	    return -code error -errorcode {TCLOO ABSTRACT_SLOT} "unimplemented"
+	}
+
+	# ------------------------------------------------------------------
+	#
+	# Slot Resolve --
+	#
+	#	Helper that lets a slot convert a list of arguments of a
+	#	particular type to their canonical forms. Defaults to doing
+	#	nothing (suitable for simple strings).
+	#
+	# ------------------------------------------------------------------
+
+	method Resolve list {
+	    return $list
+	}
+
+	# ------------------------------------------------------------------
+	#
+	# Slot -set, -append, -clear, --default-operation --
+	#
+	#	Standard public slot operations. If a slot can't figure out
+	#	what method to call directly, it uses --default-operation.
+	#
+	# ------------------------------------------------------------------
+
+	method -set args {
+	    set my [namespace which my]
+	    set args [lmap a $args {uplevel 1 [list $my Resolve $a]}]
+	    tailcall my Set $args
+	}
+	method -append args {
+	    set my [namespace which my]
+	    set args [lmap a $args {uplevel 1 [list $my Resolve $a]}]
+	    set current [uplevel 1 [list $my Get]]
+	    tailcall my Set [list {*}$current {*}$args]
+	}
+	method -clear {} {tailcall my Set {}}
+	method -prepend args {
+	    set my [namespace which my]
+	    set args [lmap a $args {uplevel 1 [list $my Resolve $a]}]
+	    set current [uplevel 1 [list $my Get]]
+	    tailcall my Set [list {*}$args {*}$current]
+	}
+	method -remove args {
+	    set my [namespace which my]
+	    set args [lmap a $args {uplevel 1 [list $my Resolve $a]}]
+	    set current [uplevel 1 [list $my Get]]
+	    tailcall my Set [lmap val $current {
+		if {$val in $args} continue else {set val}
+	    }]
+	}
+
+	# Default handling
+	forward --default-operation my -append
+	method unknown {args} {
+	    set def --default-operation
+	    if {[llength $args] == 0} {
+		tailcall my $def
+	    } elseif {![string match -* [lindex $args 0]]} {
+		tailcall my $def {*}$args
+	    }
+	    next {*}$args
+	}
+
+	# Set up what is exported and what isn't
+	export -set -append -clear -prepend -remove
+	unexport unknown destroy
+    }
+
+    # Set the default operation differently for these slots
+    objdefine define::superclass forward --default-operation my -set
+    objdefine define::mixin forward --default-operation my -set
+    objdefine objdefine::mixin forward --default-operation my -set
+
+    # ----------------------------------------------------------------------
+    #
+    # oo::object <cloned> --
+    #
+    #	Handler for cloning objects that clones basic bits (only!) of the
+    #	object's namespace. Non-procedures, traces, sub-namespaces, etc. need
+    #	more complex (and class-specific) handling.
+    #
+    # ----------------------------------------------------------------------
+
+    define object method <cloned> {originObject} {
+	# Copy over the procedures from the original namespace
+	foreach p [info procs [info object namespace $originObject]::*] {
+	    set args [info args $p]
+	    set idx -1
+	    foreach a $args {
+		if {[info default $p $a d]} {
+		    lset args [incr idx] [list $a $d]
+		} else {
+		    lset args [incr idx] [list $a]
+		}
+	    }
+	    set b [info body $p]
+	    set p [namespace tail $p]
+	    proc $p $args $b
+	}
+	# Copy over the variables from the original namespace
+	foreach v [info vars [info object namespace $originObject]::*] {
+	    upvar 0 $v vOrigin
+	    namespace upvar [namespace current] [namespace tail $v] vNew
+	    if {[info exists vOrigin]} {
+		if {[array exists vOrigin]} {
+		    array set vNew [array get vOrigin]
+		} else {
+		    set vNew $vOrigin
+		}
+	    }
+	}
+	# General commands, sub-namespaces and advancd variable config (traces,
+	# etc) are *not* copied over. Classes that want that should do it
+	# themselves.
+    }
+
+    # ----------------------------------------------------------------------
+    #
+    # oo::class <cloned> --
+    #
+    #	Handler for cloning classes, which fixes up the delegates.
+    #
+    # ----------------------------------------------------------------------
+
+    define class method <cloned> {originObject} {
+	next $originObject
+	# Rebuild the class inheritance delegation class
+	::oo::UpdateClassDelegatesAfterClone $originObject [self]
+    }
+
+    # ----------------------------------------------------------------------
+    #
+    # oo::singleton --
+    #
+    #	A metaclass that is used to make classes that only permit one instance
+    #	of them to exist. See singleton(n).
+    #
+    # ----------------------------------------------------------------------
+
+    class create singleton {
+	superclass class
+	variable object
+	unexport create createWithNamespace
+	method new args {
+	    if {![info exists object] || ![info object isa object $object]} {
+		set object [next {*}$args]
+		::oo::objdefine $object {
+		    method destroy {} {
+			::return -code error -errorcode {TCLOO SINGLETON} \
+			    "may not destroy a singleton object"
+		    }
+		    method <cloned> {originObject} {
+			::return -code error -errorcode {TCLOO SINGLETON} \
+			    "may not clone a singleton object"
+		    }
+		}
+	    }
+	    return $object
+	}
+    }
+
+    # ----------------------------------------------------------------------
+    #
+    # oo::abstract --
+    #
+    #	A metaclass that is used to make classes that can't be directly
+    #	instantiated. See abstract(n).
+    #
+    # ----------------------------------------------------------------------
+
+    class create abstract {
+	superclass class
+	unexport create createWithNamespace new
+    }
+}
+
+# Local Variables:
+# mode: tcl
+# c-basic-offset: 4
+# fill-column: 78
+# End:
diff --git a/generic/tclObj.c b/generic/tclObj.c
index f93f583..d1af60d 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -1632,32 +1632,30 @@ Tcl_GetString(
     register Tcl_Obj *objPtr)	/* Object whose string rep byte pointer should
 				 * be returned. */
 {
-    if (objPtr->bytes != NULL) {
-	return objPtr->bytes;
-    }
-
-    /*
-     * Note we do not check for objPtr->typePtr == NULL.  An invariant of
-     * a properly maintained Tcl_Obj is that at least  one of objPtr->bytes
-     * and objPtr->typePtr must not be NULL.  If broken extensions fail to
-     * maintain that invariant, we can crash here.
-     */
-
-    if (objPtr->typePtr->updateStringProc == NULL) {
+    if (objPtr->bytes == NULL) {
 	/*
-	 * Those Tcl_ObjTypes which choose not to define an updateStringProc
-	 * must be written in such a way that (objPtr->bytes) never becomes
-	 * NULL.  This panic was added in Tcl 8.1.
+	 * Note we do not check for objPtr->typePtr == NULL.  An invariant
+	 * of a properly maintained Tcl_Obj is that at least  one of
+	 * objPtr->bytes and objPtr->typePtr must not be NULL.  If broken
+	 * extensions fail to maintain that invariant, we can crash here.
 	 */
 
-	Tcl_Panic("UpdateStringProc should not be invoked for type %s",
-		objPtr->typePtr->name);
-    }
-    objPtr->typePtr->updateStringProc(objPtr);
-    if (objPtr->bytes == NULL || objPtr->length < 0
-	    || objPtr->bytes[objPtr->length] != '\0') {
-	Tcl_Panic("UpdateStringProc for type '%s' "
-		"failed to create a valid string rep", objPtr->typePtr->name);
+	if (objPtr->typePtr->updateStringProc == NULL) {
+	    /*
+	     * Those Tcl_ObjTypes which choose not to define an
+	     * updateStringProc must be written in such a way that
+	     * (objPtr->bytes) never becomes NULL.
+	     */
+	    Tcl_Panic("UpdateStringProc should not be invoked for type %s",
+		    objPtr->typePtr->name);
+	}
+	objPtr->typePtr->updateStringProc(objPtr);
+	if (objPtr->bytes == NULL || objPtr->length < 0
+		|| objPtr->bytes[objPtr->length] != '\0') {
+	    Tcl_Panic("UpdateStringProc for type '%s' "
+		    "failed to create a valid string rep",
+		    objPtr->typePtr->name);
+	}
     }
     return objPtr->bytes;
 }
@@ -1693,8 +1691,31 @@ Tcl_GetStringFromObj(
 				 * rep's byte array length should * be stored.
 				 * If NULL, no length is stored. */
 {
-    (void) TclGetString(objPtr);
+    if (objPtr->bytes == NULL) {
+	/*
+	 * Note we do not check for objPtr->typePtr == NULL.  An invariant
+	 * of a properly maintained Tcl_Obj is that at least  one of
+	 * objPtr->bytes and objPtr->typePtr must not be NULL.  If broken
+	 * extensions fail to maintain that invariant, we can crash here.
+	 */
 
+	if (objPtr->typePtr->updateStringProc == NULL) {
+	    /*
+	     * Those Tcl_ObjTypes which choose not to define an
+	     * updateStringProc must be written in such a way that
+	     * (objPtr->bytes) never becomes NULL.
+	     */
+	    Tcl_Panic("UpdateStringProc should not be invoked for type %s",
+		    objPtr->typePtr->name);
+	}
+	objPtr->typePtr->updateStringProc(objPtr);
+	if (objPtr->bytes == NULL || objPtr->length < 0
+		|| objPtr->bytes[objPtr->length] != '\0') {
+	    Tcl_Panic("UpdateStringProc for type '%s' "
+		    "failed to create a valid string rep",
+		    objPtr->typePtr->name);
+	}
+    }
     if (lengthPtr != NULL) {
 	*lengthPtr = objPtr->length;
     }
@@ -2786,7 +2807,7 @@ Tcl_GetLongFromObj(
 
 	    if (w >= -(Tcl_WideInt)(ULONG_MAX)
 		    && w <= (Tcl_WideInt)(ULONG_MAX)) {
-		*longPtr = Tcl_WideAsLong(w);
+		*longPtr = (long) w;
 		return TCL_OK;
 	    }
 	    goto tooLarge;
@@ -2812,10 +2833,9 @@ Tcl_GetLongFromObj(
 	    mp_int big;
 
 	    UNPACK_BIGNUM(objPtr, big);
-	    if ((size_t) big.used <= (CHAR_BIT * sizeof(long) + DIGIT_BIT - 1)
+	    if ((size_t) big.used <= (CHAR_BIT * sizeof(unsigned long) + DIGIT_BIT - 1)
 		    / DIGIT_BIT) {
-		unsigned long value = 0, numBytes = sizeof(long);
-		long scratch;
+		unsigned long scratch, value = 0, numBytes = sizeof(unsigned long);
 		unsigned char *bytes = (unsigned char *) &scratch;
 
 		if (mp_to_unsigned_bin_n(&big, bytes, &numBytes) == MP_OKAY) {
@@ -3086,6 +3106,73 @@ Tcl_GetWideIntFromObj(
 /*
  *----------------------------------------------------------------------
  *
+ * TclGetWideBitsFromObj --
+ *
+ *	Attempt to return a wide integer from the Tcl object "objPtr". If the
+ *	object is not already a int, double or bignum, an attempt will be made
+ *	to convert it to one of these. Out-of-range values don't result in an
+ *	error, but only the least significant 64 bits will be returned.
+ *
+ * Results:
+ *	The return value is a standard Tcl object result. If an error occurs
+ *	during conversion, an error message is left in the interpreter's
+ *	result unless "interp" is NULL.
+ *
+ * Side effects:
+ *	If the object is not already an int, double or bignum object, the
+ *	conversion will free any old internal representation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclGetWideBitsFromObj(
+    Tcl_Interp *interp,         /* Used for error reporting if not NULL. */
+    Tcl_Obj *objPtr,            /* Object from which to get a wide int. */
+    Tcl_WideInt *wideIntPtr)    /* Place to store resulting wide integer. */
+{
+    do {
+	if (objPtr->typePtr == &tclIntType) {
+	    *wideIntPtr = objPtr->internalRep.wideValue;
+	    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;
+	}
+	if (objPtr->typePtr == &tclBignumType) {
+	    mp_int big;
+
+	    Tcl_WideUInt value = 0, scratch;
+	    unsigned long numBytes = sizeof(Tcl_WideInt);
+	    unsigned char *bytes = (unsigned char *) &scratch;
+
+	    Tcl_GetBignumFromObj(NULL, objPtr, &big);
+	    mp_mod_2d(&big, (int) (CHAR_BIT * sizeof(Tcl_WideInt)), &big);
+	    mp_to_unsigned_bin_n(&big, bytes, &numBytes);
+	    while (numBytes-- > 0) {
+		value = (value << CHAR_BIT) | *bytes++;
+	    }
+	    if (big.sign) {
+		value = -value;
+	    }
+	    *wideIntPtr = (Tcl_WideInt) value;
+	    mp_clear(&big);
+	    return TCL_OK;
+	}
+    } while (TclParseNumber(interp, objPtr, "integer", NULL, -1, NULL,
+	    TCL_PARSE_INTEGER_ONLY)==TCL_OK);
+    return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * FreeBignum --
  *
  *	This function frees the internal rep of a bignum.
@@ -3449,7 +3536,7 @@ Tcl_SetBignumObj(
 	while (numBytes-- > 0) {
 	    value = (value << CHAR_BIT) | *bytes++;
 	}
-	if (value > (((~(Tcl_WideUInt)0) >> 1) + bignumValue->sign)) {
+	if (value > ((Tcl_WideUInt)WIDE_MAX + bignumValue->sign)) {
 	    goto tooLargeForWide;
 	}
 	if (bignumValue->sign) {
diff --git a/generic/tclParse.c b/generic/tclParse.c
index a2227f7..00b83a1 100644
--- a/generic/tclParse.c
+++ b/generic/tclParse.c
@@ -979,7 +979,12 @@ TclParseBackslash(
     if (readPtr != NULL) {
 	*readPtr = count;
     }
-    return Tcl_UniCharToUtf(result, dst);
+    count = Tcl_UniCharToUtf(result, dst);
+    if (!count) {
+	/* Special case for handling upper surrogates. */
+	count = Tcl_UniCharToUtf(-1, dst);
+    }
+    return count;
 }
 
 /*
diff --git a/generic/tclPkg.c b/generic/tclPkg.c
index 223ef93..2c16458 100644
--- a/generic/tclPkg.c
+++ b/generic/tclPkg.c
@@ -577,7 +577,7 @@ SelectPackage(ClientData data[], Tcl_Interp *interp, int result) {
     PkgAvail *availPtr, *bestPtr, *bestStablePtr;
     char *availVersion, *bestVersion, *bestStableVersion;
 				/* Internal rep. of versions */
-    int availStable, satisfies; 
+    int availStable, satisfies;
     Require *reqPtr = data[0];
     int reqc = PTR2INT(data[1]);
     Tcl_Obj **const reqv = data[2];
diff --git a/generic/tclPkgConfig.c b/generic/tclPkgConfig.c
index 9e194c8..96b6962 100644
--- a/generic/tclPkgConfig.c
+++ b/generic/tclPkgConfig.c
@@ -105,6 +105,8 @@ static Tcl_Config const cfg[] = {
     {"scriptdir,runtime",	CFG_RUNTIME_SCRDIR},
     {"includedir,runtime",	CFG_RUNTIME_INCDIR},
     {"docdir,runtime",		CFG_RUNTIME_DOCDIR},
+    {"dllfile,runtime",		CFG_RUNTIME_DLLFILE},
+    {"zipfile,runtime",		CFG_RUNTIME_ZIPFILE},
 
     /* Installation paths to various stuff */
 
diff --git a/generic/tclPort.h b/generic/tclPort.h
index 12a60db..d3f6233 100644
--- a/generic/tclPort.h
+++ b/generic/tclPort.h
@@ -24,20 +24,8 @@
 #endif
 #include "tcl.h"
 
-#if !defined(LLONG_MIN)
-#   ifdef TCL_WIDE_INT_IS_LONG
-#      define LLONG_MIN LONG_MIN
-#   else
-#      ifdef LLONG_BIT
-#         define LLONG_MIN ((Tcl_WideInt)(Tcl_LongAsWide(1)<<(LLONG_BIT-1)))
-#      else
-/* Assume we're on a system with a 64-bit 'long long' type */
-#         define LLONG_MIN ((Tcl_WideInt)(Tcl_LongAsWide(1)<<63))
-#      endif
-#   endif
-/* Assume that if LLONG_MIN is undefined, then so is LLONG_MAX */
-#   define LLONG_MAX (~LLONG_MIN)
-#endif
-
+#define UWIDE_MAX ((Tcl_WideUInt)-1)
+#define WIDE_MAX ((Tcl_WideInt)(UWIDE_MAX >> 1))
+#define WIDE_MIN ((Tcl_WideInt)((Tcl_WideUInt)WIDE_MAX+1))
 
 #endif /* _TCLPORT */
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 212b680..32c3b2e 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -505,10 +505,11 @@ TclCreateProc(
 	    goto procError;
 	}
 
-	nameLength = Tcl_NumUtfChars(Tcl_GetString(fieldValues[0]), fieldValues[0]->length);
+	argname = Tcl_GetStringFromObj(fieldValues[0], &plen);
+	nameLength = Tcl_NumUtfChars(argname, plen);
 	if (fieldCount == 2) {
-	    valueLength = Tcl_NumUtfChars(Tcl_GetString(fieldValues[1]),
-		fieldValues[1]->length);
+	    const char * value = TclGetString(fieldValues[1]);
+	    valueLength = Tcl_NumUtfChars(value, fieldValues[1]->length);
 	} else {
 	    valueLength = 0;
 	}
@@ -517,7 +518,6 @@ TclCreateProc(
 	 * Check that the formal parameter name is a scalar.
 	 */
 
-	argname = Tcl_GetStringFromObj(fieldValues[0], &plen);
 	argnamei = argname;
 	argnamelast = argname[plen-1];
 	while (plen--) {
@@ -611,7 +611,7 @@ TclCreateProc(
 		procPtr->lastLocalPtr = localPtr;
 	    }
 	    localPtr->nextPtr = NULL;
-	    localPtr->nameLength = Tcl_NumUtfChars(argname, fieldValues[0]->length);
+	    localPtr->nameLength = nameLength;
 	    localPtr->frameIndex = i;
 	    localPtr->flags = VAR_ARGUMENT;
 	    localPtr->resolveInfo = NULL;
@@ -688,51 +688,15 @@ TclGetFrame(
     CallFrame **framePtrPtr)	/* Store pointer to frame here (or NULL if
 				 * global frame indicated). */
 {
-    register Interp *iPtr = (Interp *) interp;
-    int curLevel, level, result;
-    CallFrame *framePtr;
-
-    /*
-     * Parse string to figure out which level number to go to.
-     */
-
-    result = 1;
-    curLevel = iPtr->varFramePtr->level;
-    if (*name== '#') {
-	if (Tcl_GetInt(interp, name+1, &level) != TCL_OK || level < 0) {
-	    goto levelError;
-	}
-    } else if (isdigit(UCHAR(*name))) { /* INTL: digit */
-	if (Tcl_GetInt(interp, name, &level) != TCL_OK) {
-	    goto levelError;
-	}
-	level = curLevel - level;
-    } else {
-	level = curLevel - 1;
-	result = 0;
-    }
-
-    /*
-     * Figure out which frame to use, and return it to the caller.
-     */
-
-    for (framePtr = iPtr->varFramePtr; framePtr != NULL;
-	    framePtr = framePtr->callerVarPtr) {
-	if (framePtr->level == level) {
-	    break;
-	}
-    }
-    if (framePtr == NULL) {
-	goto levelError;
-    }
-
-    *framePtrPtr = framePtr;
-    return result;
-
-  levelError:
-    Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad level \"%s\"", name));
-    Tcl_SetErrorCode(interp, "TCL", "VALUE", "STACKLEVEL", NULL);
-    return -1;
+	int result;
+	Tcl_Obj obj;
+
+	obj.bytes = (char *) name;
+	obj.length = strlen(name);
+	obj.typePtr = NULL;
+	result = TclObjGetFrame(interp, &obj, framePtrPtr);
+	TclFreeIntRep(&obj);
+	return result;
 }
 
 /*
@@ -770,6 +734,7 @@ TclObjGetFrame(
     register Interp *iPtr = (Interp *) interp;
     int curLevel, level, result;
     const char *name = NULL;
+    Tcl_WideInt w;
 
     /*
      * Parse object to figure out which level number to go to.
@@ -785,25 +750,33 @@ TclObjGetFrame(
 
     if (objPtr == NULL) {
 	/* Do nothing */
-    } else if (TCL_OK == Tcl_GetIntFromObj(NULL, objPtr, &level)
-	    && (level >= 0)) {
-	level = curLevel - level;
-	result = 1;
+    } else if (TCL_OK == Tcl_GetIntFromObj(NULL, objPtr, &level)) {
+	Tcl_GetWideIntFromObj(NULL, objPtr, &w);
+	if (w < 0 || w > INT_MAX || curLevel > w + INT_MAX) {
+	    result = -1;
+	} else {
+	    level = curLevel - level;
+	    result = 1;
+	}
     } else if (objPtr->typePtr == &levelReferenceType) {
 	level = (int) objPtr->internalRep.wideValue;
 	result = 1;
     } else {
 	name = TclGetString(objPtr);
 	if (name[0] == '#') {
-	    if (TCL_OK == Tcl_GetInt(NULL, name+1, &level) && level >= 0) {
-		TclFreeIntRep(objPtr);
-		objPtr->typePtr = &levelReferenceType;
-		objPtr->internalRep.wideValue = level;
-		result = 1;
+	    if (TCL_OK == Tcl_GetInt(NULL, name+1, &level)) {
+		if (level < 0 || (level > 0 && name[1] == '-')) {
+		    result = -1;
+		} else {
+		    TclFreeIntRep(objPtr);
+		    objPtr->typePtr = &levelReferenceType;
+		    objPtr->internalRep.wideValue = level;
+		    result = 1;
+		}
 	    } else {
 		result = -1;
 	    }
-	} else if (isdigit(UCHAR(name[0]))) { /* INTL: digit */
+	} else if (TclGetWideBitsFromObj(interp, objPtr, &w) == TCL_OK) {
 	    /*
 	     * If this were an integer, we'd have succeeded already.
 	     * Docs say we have to treat this as a 'bad level'  error.
@@ -814,7 +787,6 @@ TclObjGetFrame(
 
     if (result == 0) {
 	level = curLevel - 1;
-	name = "1";
     }
     if (result != -1) {
 	if (level >= 0) {
@@ -827,11 +799,11 @@ TclObjGetFrame(
 		}
 	    }
 	}
-	if (name == NULL) {
-	    name = TclGetString(objPtr);
-	}
     }
 
+    if (name == NULL) {
+	name = TclGetString(objPtr);
+    }
     Tcl_SetObjResult(interp, Tcl_ObjPrintf("bad level \"%s\"", name));
     Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "LEVEL", name, NULL);
     return -1;
@@ -1035,7 +1007,6 @@ ProcWrongNumArgs(
 {
     CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
     register Proc *procPtr = framePtr->procPtr;
-    register Var *defPtr;
     int localCt = procPtr->numCompiledLocals, numArgs, i;
     Tcl_Obj **desiredObjs;
     const char *final = NULL;
@@ -1059,23 +1030,26 @@ ProcWrongNumArgs(
     }
     Tcl_IncrRefCount(desiredObjs[0]);
 
-    defPtr = (Var *) (&framePtr->localCachePtr->varName0 + localCt);
-    for (i=1 ; i<=numArgs ; i++, defPtr++) {
-	Tcl_Obj *argObj;
-	Tcl_Obj *namePtr = localName(framePtr, i-1);
-
-	if (defPtr->value.objPtr != NULL) {
-	    TclNewObj(argObj);
-	    Tcl_AppendStringsToObj(argObj, "?", TclGetString(namePtr), "?", NULL);
-	} else if (defPtr->flags & VAR_IS_ARGS) {
-	    numArgs--;
-	    final = "?arg ...?";
-	    break;
-	} else {
-	    argObj = namePtr;
-	    Tcl_IncrRefCount(namePtr);
+    if (localCt > 0) {
+	register Var *defPtr = (Var *) (&framePtr->localCachePtr->varName0 + localCt);
+
+	for (i=1 ; i<=numArgs ; i++, defPtr++) {
+	    Tcl_Obj *argObj;
+	    Tcl_Obj *namePtr = localName(framePtr, i-1);
+
+	    if (defPtr->value.objPtr != NULL) {
+		TclNewObj(argObj);
+		Tcl_AppendStringsToObj(argObj, "?", TclGetString(namePtr), "?", NULL);
+	    } else if (defPtr->flags & VAR_IS_ARGS) {
+		numArgs--;
+		final = "?arg ...?";
+		break;
+	    } else {
+		argObj = namePtr;
+		Tcl_IncrRefCount(namePtr);
+	    }
+	    desiredObjs[i] = argObj;
 	}
-	desiredObjs[i] = argObj;
     }
 
     Tcl_ResetResult(interp);
diff --git a/generic/tclProcess.c b/generic/tclProcess.c
index 604b7ce..a781386 100644
--- a/generic/tclProcess.c
+++ b/generic/tclProcess.c
@@ -1,7 +1,7 @@
 /*
  * tclProcess.c --
  *
- *	This file implements the "tcl::process" ensemble for subprocess 
+ *	This file implements the "tcl::process" ensemble for subprocess
  *	management as defined by TIP #462.
  *
  * Copyright (c) 2017 Frederic Bonnet.
@@ -13,14 +13,14 @@
 #include "tclInt.h"
 
 /*
- * Autopurge flag. Process-global because of the way Tcl manages child 
+ * Autopurge flag. Process-global because of the way Tcl manages child
  * processes (see tclPipe.c).
  */
 
 static int autopurge = 1;	/* Autopurge flag. */
 
 /*
- * Hash tables that keeps track of all child process statuses. Keys are the 
+ * Hash tables that keeps track of all child process statuses. Keys are the
  * child process ids and resolved pids, values are (ProcessInfo *).
  */
 
@@ -29,7 +29,7 @@ typedef struct ProcessInfo {
     int resolvedPid;		/* Resolved process id. */
     int purge;			/* Purge eventualy. */
     TclProcessWaitStatus status;/* Process status. */
-    int code;			/* Error code, exit status or signal 
+    int code;			/* Error code, exit status or signal
 				   number. */
     Tcl_Obj *msg;		/* Error message. */
     Tcl_Obj *error;		/* Error code. */
@@ -47,7 +47,7 @@ static void		InitProcessInfo(ProcessInfo *info, Tcl_Pid pid,
 			    int resolvedPid);
 static void		FreeProcessInfo(ProcessInfo *info);
 static int		RefreshProcessInfo(ProcessInfo *info, int options);
-static TclProcessWaitStatus WaitProcessStatus(Tcl_Pid pid, int resolvedPid, 
+static TclProcessWaitStatus WaitProcessStatus(Tcl_Pid pid, int resolvedPid,
 			    int options, int *codePtr, Tcl_Obj **msgPtr,
 			    Tcl_Obj **errorObjPtr);
 static Tcl_Obj *	BuildProcessStatusObj(ProcessInfo *info);
@@ -160,7 +160,7 @@ RefreshProcessInfo(
 	 * Refresh & store status.
 	 */
 
-	info->status = WaitProcessStatus(info->pid, info->resolvedPid, 
+	info->status = WaitProcessStatus(info->pid, info->resolvedPid,
 		options, &info->code, &info->msg, &info->error);
 	if (info->msg) Tcl_IncrRefCount(info->msg);
 	if (info->error) Tcl_IncrRefCount(info->error);
@@ -214,7 +214,7 @@ WaitProcessStatus(
 	/*
 	 * No change.
 	 */
-	
+
 	return TCL_PROCESS_UNCHANGED;
     }
 
@@ -370,7 +370,7 @@ BuildProcessStatusObj(
 	/*
 	 * Normal exit, return TCL_OK.
 	 */
-	
+
 	return Tcl_NewIntObj(TCL_OK);
     }
 
@@ -388,7 +388,7 @@ BuildProcessStatusObj(
  *
  * ProcessListObjCmd --
  *
- *	This function implements the 'tcl::process list' Tcl command. 
+ *	This function implements the 'tcl::process list' Tcl command.
  *	Refer to the user documentation for details on what it does.
  *
  * Results:
@@ -423,10 +423,10 @@ ProcessListObjCmd(
 
     list = Tcl_NewListObj(0, NULL);
     Tcl_MutexLock(&infoTablesMutex);
-    for (entry = Tcl_FirstHashEntry(&infoTablePerResolvedPid, &search); 
+    for (entry = Tcl_FirstHashEntry(&infoTablePerResolvedPid, &search);
 	    entry != NULL; entry = Tcl_NextHashEntry(&search)) {
 	info = (ProcessInfo *) Tcl_GetHashValue(entry);
-	Tcl_ListObjAppendElement(interp, list, 
+	Tcl_ListObjAppendElement(interp, list,
 		Tcl_NewIntObj(info->resolvedPid));
     }
     Tcl_MutexUnlock(&infoTablesMutex);
@@ -438,7 +438,7 @@ ProcessListObjCmd(
  *
  * ProcessStatusObjCmd --
  *
- *	This function implements the 'tcl::process status' Tcl command. 
+ *	This function implements the 'tcl::process status' Tcl command.
  *	Refer to the user documentation for details on what it does.
  *
  * Results:
@@ -504,7 +504,7 @@ ProcessStatusObjCmd(
 
 	dict = Tcl_NewDictObj();
 	Tcl_MutexLock(&infoTablesMutex);
-	for (entry = Tcl_FirstHashEntry(&infoTablePerResolvedPid, &search); 
+	for (entry = Tcl_FirstHashEntry(&infoTablePerResolvedPid, &search);
 		entry != NULL; entry = Tcl_NextHashEntry(&search)) {
 	    info = (ProcessInfo *) Tcl_GetHashValue(entry);
 	    RefreshProcessInfo(info, options);
@@ -513,7 +513,7 @@ ProcessStatusObjCmd(
 		/*
 		 * Purge entry.
 		 */
-		
+
 		Tcl_DeleteHashEntry(entry);
 		entry = Tcl_FindHashEntry(&infoTablePerPid, info->pid);
 		Tcl_DeleteHashEntry(entry);
@@ -523,7 +523,7 @@ ProcessStatusObjCmd(
 		 * Add to result.
 		 */
 
-		Tcl_DictObjPut(interp, dict, Tcl_NewIntObj(info->resolvedPid), 
+		Tcl_DictObjPut(interp, dict, Tcl_NewIntObj(info->resolvedPid),
 			BuildProcessStatusObj(info));
 	    }
 	}
@@ -532,7 +532,7 @@ ProcessStatusObjCmd(
 	/*
 	 * Only return statuses of provided processes.
 	 */
-	
+
 	result = Tcl_ListObjGetElements(interp, objv[1], &numPids, &pidObjs);
 	if (result != TCL_OK) {
 	    return result;
@@ -552,10 +552,10 @@ ProcessStatusObjCmd(
 		/*
 		 * Skip unknown process.
 		 */
-		
+
 		continue;
 	    }
-	    
+
 	    info = (ProcessInfo *) Tcl_GetHashValue(entry);
 	    RefreshProcessInfo(info, options);
 
@@ -563,7 +563,7 @@ ProcessStatusObjCmd(
 		/*
 		 * Purge entry.
 		 */
-		
+
 		Tcl_DeleteHashEntry(entry);
 		entry = Tcl_FindHashEntry(&infoTablePerPid, info->pid);
 		Tcl_DeleteHashEntry(entry);
@@ -573,7 +573,7 @@ ProcessStatusObjCmd(
 		 * Add to result.
 		 */
 
-		Tcl_DictObjPut(interp, dict, Tcl_NewIntObj(info->resolvedPid), 
+		Tcl_DictObjPut(interp, dict, Tcl_NewIntObj(info->resolvedPid),
 			BuildProcessStatusObj(info));
 	    }
 	}
@@ -587,7 +587,7 @@ ProcessStatusObjCmd(
  *
  * ProcessPurgeObjCmd --
  *
- *	This function implements the 'tcl::process purge' Tcl command. 
+ *	This function implements the 'tcl::process purge' Tcl command.
  *	Refer to the user documentation for details on what it does.
  *
  * Results:
@@ -632,7 +632,7 @@ ProcessPurgeObjCmd(
 	 */
 
 	Tcl_MutexLock(&infoTablesMutex);
-	for (entry = Tcl_FirstHashEntry(&infoTablePerResolvedPid, &search); 
+	for (entry = Tcl_FirstHashEntry(&infoTablePerResolvedPid, &search);
 		entry != NULL; entry = Tcl_NextHashEntry(&search)) {
 	    info = (ProcessInfo *) Tcl_GetHashValue(entry);
 	    if (info->purge) {
@@ -647,7 +647,7 @@ ProcessPurgeObjCmd(
 	/*
 	 * Purge only provided processes.
 	 */
-	
+
 	result = Tcl_ListObjGetElements(interp, objv[1], &numPids, &pidObjs);
 	if (result != TCL_OK) {
 	    return result;
@@ -665,7 +665,7 @@ ProcessPurgeObjCmd(
 		/*
 		 * Skip unknown process.
 		 */
-		
+
 		continue;
 	    }
 
@@ -687,7 +687,7 @@ ProcessPurgeObjCmd(
  *
  * ProcessAutopurgeObjCmd --
  *
- *	This function implements the 'tcl::process autopurge' Tcl command. 
+ *	This function implements the 'tcl::process autopurge' Tcl command.
  *	Refer to the user documentation for details on what it does.
  *
  * Results:
@@ -715,7 +715,7 @@ ProcessAutopurgeObjCmd(
 	/*
 	 * Set given value.
 	 */
-	
+
 	int flag;
 	int result = Tcl_GetBooleanFromObj(interp, objv[1], &flag);
 	if (result != TCL_OK) {
@@ -725,8 +725,8 @@ ProcessAutopurgeObjCmd(
 	autopurge = !!flag;
     }
 
-    /* 
-     * Return current value. 
+    /*
+     * Return current value.
      */
 
     Tcl_SetObjResult(interp, Tcl_NewBooleanObj(autopurge));
@@ -821,9 +821,9 @@ TclProcessCreated(
 	/*
 	 * Pid was reused, free old info and reuse structure.
 	 */
-	
+
 	info = (ProcessInfo *) Tcl_GetHashValue(entry);
-	entry2 = Tcl_FindHashEntry(&infoTablePerResolvedPid, 
+	entry2 = Tcl_FindHashEntry(&infoTablePerResolvedPid,
 		INT2PTR(resolvedPid));
 	if (entry2) Tcl_DeleteHashEntry(entry2);
 	FreeProcessInfo(info);
@@ -893,8 +893,8 @@ TclProcessWait(
 	/*
 	 * Unknown process, just call WaitProcessStatus and return.
 	 */
-	
-	result = WaitProcessStatus(pid, TclpGetPid(pid), options, codePtr, 
+
+	result = WaitProcessStatus(pid, TclpGetPid(pid), options, codePtr,
 		msgObjPtr, errorObjPtr);
 	if (msgObjPtr && *msgObjPtr) Tcl_IncrRefCount(*msgObjPtr);
 	if (errorObjPtr && *errorObjPtr) Tcl_IncrRefCount(*errorObjPtr);
@@ -909,7 +909,7 @@ TclProcessWait(
 	 * so report no change.
 	 */
     Tcl_MutexUnlock(&infoTablesMutex);
-	
+
 	return TCL_PROCESS_UNCHANGED;
     }
 
@@ -919,7 +919,7 @@ TclProcessWait(
 	 * No change, stop there.
 	 */
     Tcl_MutexUnlock(&infoTablesMutex);
-	
+
 	return TCL_PROCESS_UNCHANGED;
     }
 
@@ -940,7 +940,7 @@ TclProcessWait(
 	 */
 
 	Tcl_DeleteHashEntry(entry);
-	entry = Tcl_FindHashEntry(&infoTablePerResolvedPid, 
+	entry = Tcl_FindHashEntry(&infoTablePerResolvedPid,
 		INT2PTR(info->resolvedPid));
 	Tcl_DeleteHashEntry(entry);
 	FreeProcessInfo(info);
diff --git a/generic/tclScan.c b/generic/tclScan.c
index 0e3da17..733409e 100644
--- a/generic/tclScan.c
+++ b/generic/tclScan.c
@@ -926,9 +926,9 @@ Tcl_ScanObjCmd(
 	    }
 	    if (flags & SCAN_LONGER) {
 		if (Tcl_GetWideIntFromObj(NULL, objPtr, &wideValue) != TCL_OK) {
-		    wideValue = LLONG_MAX;
+		    wideValue = WIDE_MAX;
 		    if (TclGetString(objPtr)[0] == '-') {
-			wideValue = LLONG_MIN;
+			wideValue = WIDE_MIN;
 		    }
 		}
 		if ((flags & SCAN_UNSIGNED) && (wideValue < 0)) {
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index f9ac8d7..fa55bb0 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -490,7 +490,7 @@ TclCheckEmptyString(
 	Tcl_DictObjSize(NULL, objPtr, &length);
 	return length == 0;
     }
-    
+
     if (objPtr->bytes == NULL) {
 	return TCL_EMPTYSTRING_UNKNOWN;
     }
@@ -606,6 +606,8 @@ Tcl_GetUniChar(
  *----------------------------------------------------------------------
  */
 
+#ifndef TCL_NO_DEPRECATED
+#undef Tcl_GetUnicode
 Tcl_UniChar *
 Tcl_GetUnicode(
     Tcl_Obj *objPtr)		/* The object to find the unicode string
@@ -613,6 +615,7 @@ Tcl_GetUnicode(
 {
     return Tcl_GetUnicodeFromObj(objPtr, NULL);
 }
+#endif /* TCL_NO_DEPRECATED */
 
 /*
  *----------------------------------------------------------------------
@@ -1901,6 +1904,11 @@ Tcl_AppendFormatToObj(
 	width = 0;
 	if (isdigit(UCHAR(ch))) {
 	    width = strtoul(format, &end, 10);
+	    if (width < 0) {
+		msg = overflow;
+		errCode = "OVERFLOW";
+		goto errorMsg;
+	    }
 	    format = end;
 	    step = TclUtfToUniChar(format, &ch);
 	} else if (ch == '*') {
@@ -2040,6 +2048,10 @@ Tcl_AppendFormatToObj(
 		goto error;
 	    }
 	    length = Tcl_UniCharToUtf(code, buf);
+	    if (!length) {
+		/* Special case for handling upper surrogates. */
+		length = Tcl_UniCharToUtf(-1, buf);
+	    }
 	    segment = Tcl_NewStringObj(buf, length);
 	    Tcl_IncrRefCount(segment);
 	    allocSegment = 1;
@@ -2085,35 +2097,17 @@ Tcl_AppendFormatToObj(
 		}
 #ifndef TCL_WIDE_INT_IS_LONG
 	    } else if (useWide) {
-		if (TclGetWideIntFromObj(NULL, segment, &w) != TCL_OK) {
-		    Tcl_Obj *objPtr;
-
-		    if (Tcl_GetBignumFromObj(interp,segment,&big) != TCL_OK) {
-			goto error;
-		    }
-		    mp_mod_2d(&big, (int) CHAR_BIT*sizeof(Tcl_WideInt), &big);
-		    objPtr = Tcl_NewBignumObj(&big);
-		    Tcl_IncrRefCount(objPtr);
-		    TclGetWideIntFromObj(NULL, objPtr, &w);
-		    Tcl_DecrRefCount(objPtr);
+		if (TclGetWideBitsFromObj(interp, segment, &w) != TCL_OK) {
+		    goto error;
 		}
 		isNegative = (w < (Tcl_WideInt) 0);
 		if (w == (Tcl_WideInt) 0) gotHash = 0;
 #endif
 	    } else if (TclGetLongFromObj(NULL, segment, &l) != TCL_OK) {
-		if (TclGetWideIntFromObj(NULL, segment, &w) != TCL_OK) {
-		    Tcl_Obj *objPtr;
-
-		    if (Tcl_GetBignumFromObj(interp,segment,&big) != TCL_OK) {
-			goto error;
-		    }
-		    mp_mod_2d(&big, (int) CHAR_BIT * sizeof(long), &big);
-		    objPtr = Tcl_NewBignumObj(&big);
-		    Tcl_IncrRefCount(objPtr);
-		    TclGetLongFromObj(NULL, objPtr, &l);
-		    Tcl_DecrRefCount(objPtr);
+		if (TclGetWideBitsFromObj(interp, segment, &w) != TCL_OK) {
+		    goto error;
 		} else {
-		    l = Tcl_WideAsLong(w);
+		    l = (long) w;
 		}
 		if (useShort) {
 		    s = (short) l;
@@ -3058,15 +3052,21 @@ TclStringCat(
 	 * Result will be pure byte array. Pre-size it
 	 */
 
+	int numBytes;
 	ov = objv;
 	oc = objc;
 	do {
 	    Tcl_Obj *objPtr = *ov++;
 
-	    if (objPtr->bytes == NULL) {
-		int numBytes;
+	    /*
+	     * Every argument is either a bytearray with a ("pure")
+	     * value we know we can safely use, or it is an empty string.
+	     * We don't need to count bytes for the empty strings.
+	     */
 
+	    if (TclIsPureByteArray(objPtr)) {
 		Tcl_GetByteArrayFromObj(objPtr, &numBytes); /* PANIC? */
+
 		if (numBytes) {
 		    last = objc - oc;
 		    if (length == 0) {
@@ -3218,7 +3218,13 @@ TclStringCat(
 	while (objc--) {
 	    Tcl_Obj *objPtr = *objv++;
 
-	    if (objPtr->bytes == NULL) {
+	    /*
+	     * Every argument is either a bytearray with a ("pure")
+	     * value we know we can safely use, or it is an empty string.
+	     * We don't need to copy bytes from the empty strings.
+	     */
+
+	    if (TclIsPureByteArray(objPtr)) {
 		int more;
 		unsigned char *src = Tcl_GetByteArrayFromObj(objPtr, &more);
 		memcpy(dst, src, (size_t) more);
@@ -3549,7 +3555,7 @@ TclStringFirst(
 	start = 0;
     }
     if (ln == 0) {
-	/* We don't find empty substrings.  Bizarre! 
+	/* We don't find empty substrings.  Bizarre!
 	 * Whenever this routine is turned into a proper substring
 	 * finder, change to `return start` after limits imposed. */
 	return -1;
@@ -3946,7 +3952,7 @@ TclStringReplace(
 	    result = Tcl_NewByteArrayObj(NULL, numBytes - count + newBytes);
 								/* PANIC? */
 	    Tcl_SetByteArrayLength(result, 0);
-	    TclAppendBytesToByteArray(result, bytes, first);	
+	    TclAppendBytesToByteArray(result, bytes, first);
 	    TclAppendBytesToByteArray(result, iBytes, newBytes);
 	    TclAppendBytesToByteArray(result, bytes + first + count,
 		    numBytes - count - first);
@@ -3968,7 +3974,7 @@ TclStringReplace(
 	Tcl_UniChar *ustring = Tcl_GetUnicodeFromObj(objPtr, &numChars);
 
 	/* TODO: Is there an in-place option worth pursuing here? */
-	
+
 	result = Tcl_NewUnicodeObj(ustring, first);
 	if (insertPtr) {
 	    Tcl_AppendObjToObj(result, insertPtr);
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 7ce0758..9fa5adb 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -34,6 +34,7 @@
 #undef Tcl_DbNewLongObj
 #undef Tcl_NewObj
 #undef Tcl_NewStringObj
+#undef Tcl_GetUnicode
 #undef Tcl_DumpActiveMemory
 #undef Tcl_ValidateAllMemory
 #undef Tcl_FindHashEntry
@@ -224,17 +225,31 @@ Tcl_WinUtfToTChar(
     int len,
     Tcl_DString *dsPtr)
 {
-    WCHAR *wp;
+    WCHAR *wp, *p;
     int size = MultiByteToWideChar(CP_UTF8, 0, string, len, 0, 0);
 
     Tcl_DStringInit(dsPtr);
     Tcl_DStringSetLength(dsPtr, 2*size+2);
-    wp = (WCHAR *)Tcl_DStringValue(dsPtr);
+    p = wp = (WCHAR *)Tcl_DStringValue(dsPtr);
     MultiByteToWideChar(CP_UTF8, 0, string, len, wp, size+1);
     if (len == -1) --size; /* account for 0-byte at string end */
+
+    /* It turns out that MultiByteToWideChar() cannot handle the 'modified'
+     * UTF-8 as used by Tcl. Every sequence of 0xC0 followed by 0x80 will
+     * be translated to two 0xfffd characters. This results in a test-failure
+     * of the registry-6.20 test-case. The simplest solution is to search for
+     * those two 0xfffd characters and replace them by a \u0000 character. */
+    while (p < wp + size - 1) {
+	if (p[0] == 0xfffd && p[1] == 0xfffd) {
+	    memmove(p+1, p+2, sizeof(WCHAR) * (p - wp + size - 2));
+	    p[0] = '\0';
+	    ++p; --size;
+	}
+	++p;
+    }
     Tcl_DStringSetLength(dsPtr, 2*size);
     wp[size] = 0;
-    return (char *)wp;
+    return (char *) wp;
 }
 
 char *
@@ -244,17 +259,27 @@ Tcl_WinTCharToUtf(
     Tcl_DString *dsPtr)
 {
     char *p;
-    int size;
+    int size, i = 0;
 
     if (len > 0) {
 	len /= 2;
     }
     size = WideCharToMultiByte(CP_UTF8, 0, string, len, 0, 0, NULL, NULL);
     Tcl_DStringInit(dsPtr);
-    Tcl_DStringSetLength(dsPtr, size+1);
+    Tcl_DStringSetLength(dsPtr, size+8); /* Add some spare, in case of NULL-bytes */
     p = (char *)Tcl_DStringValue(dsPtr);
     WideCharToMultiByte(CP_UTF8, 0, string, len, p, size, NULL, NULL);
     if (len == -1) --size; /* account for 0-byte at string end */
+    while (i < size) {
+	if (!p[i]) {
+	    /* Output contains '\0'-byte, but Tcl expect two-bytes: C0 80 */
+	    memmove(p+i+2, p+i+1, size-i-1);
+	    memcpy(p + i++, "\xC0\x80", 2);
+	    Tcl_DStringSetLength(dsPtr, ++size + 1);
+	    p = (char *)Tcl_DStringValue(dsPtr);
+	}
+	++i;
+    }
     Tcl_DStringSetLength(dsPtr, size);
     p[size] = 0;
     return p;
@@ -402,6 +427,7 @@ static int uniCharNcasecmp(const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsig
 #   define TclpGmtime 0
 #   define TclpLocaltime_unix 0
 #   define TclpGmtime_unix 0
+#   define Tcl_GetUnicode 0
 #else /* TCL_NO_DEPRECATED */
 #   define Tcl_SeekOld seekOld
 #   define Tcl_TellOld tellOld
@@ -429,20 +455,14 @@ seekOld(
     int offset,			/* Offset to seek to. */
     int mode)			/* Relative to which location to seek? */
 {
-    Tcl_WideInt wOffset, wResult;
-
-    wOffset = Tcl_LongAsWide((long) offset);
-    wResult = Tcl_Seek(chan, wOffset, mode);
-    return (int) Tcl_WideAsLong(wResult);
+    return Tcl_Seek(chan, offset, mode);
 }
 
 static int
 tellOld(
     Tcl_Channel chan)		/* The channel to return pos for. */
 {
-    Tcl_WideInt wResult = Tcl_Tell(chan);
-
-    return (int) Tcl_WideAsLong(wResult);
+    return Tcl_Tell(chan);
 }
 #endif /* !TCL_NO_DEPRECATED */
 
@@ -920,6 +940,7 @@ const TclTomMathStubs tclTomMathStubs = {
     TclBN_mp_get_long_long, /* 69 */
     TclBN_mp_set_long, /* 70 */
     TclBN_mp_get_long, /* 71 */
+    TclBN_mp_get_int, /* 72 */
 };
 
 static const TclStubHooks tclStubHooks = {
@@ -1587,6 +1608,10 @@ const TclStubs tclStubs = {
     Tcl_FSUnloadFile, /* 629 */
     Tcl_ZlibStreamSetCompressionDictionary, /* 630 */
     Tcl_OpenTcpServerEx, /* 631 */
+    TclZipfs_Mount, /* 632 */
+    TclZipfs_Unmount, /* 633 */
+    TclZipfs_TclLibrary, /* 634 */
+    TclZipfs_Mount_Buffer, /* 635 */
 };
 
 /* !END!: Do not edit above this line. */
diff --git a/generic/tclTest.c b/generic/tclTest.c
index ac01ecf..18bfc1b 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -293,6 +293,8 @@ static int		TestgetassocdataCmd(ClientData dummy,
 			    Tcl_Interp *interp, int argc, const char **argv);
 static int		TestgetintCmd(ClientData dummy,
 			    Tcl_Interp *interp, int argc, const char **argv);
+static int		TestlongsizeCmd(ClientData dummy,
+			    Tcl_Interp *interp, int argc, const char **argv);
 static int		TestgetplatformCmd(ClientData dummy,
 			    Tcl_Interp *interp, int argc, const char **argv);
 static int		TestgetvarfullnameCmd(
@@ -645,6 +647,8 @@ Tcltest_Init(
 	    NULL, NULL);
     Tcl_CreateCommand(interp, "testgetint", TestgetintCmd,
 	    NULL, NULL);
+    Tcl_CreateCommand(interp, "testlongsize", TestlongsizeCmd,
+	    NULL, NULL);
     Tcl_CreateCommand(interp, "testgetplatform", TestgetplatformCmd,
 	    NULL, NULL);
     Tcl_CreateObjCommand(interp, "testgetvarfullname",
@@ -2828,7 +2832,7 @@ TestlinkCmd(
     static int intVar = 43;
     static int boolVar = 4;
     static double realVar = 1.23;
-    static Tcl_WideInt wideVar = Tcl_LongAsWide(79);
+    static Tcl_WideInt wideVar = 79;
     static char *stringVar = NULL;
     static char charVar = '@';
     static unsigned char ucharVar = 130;
@@ -2838,7 +2842,7 @@ TestlinkCmd(
     static long longVar = 123456789L;
     static unsigned long ulongVar = 3456789012UL;
     static float floatVar = 4.5;
-    static Tcl_WideUInt uwideVar = (Tcl_WideUInt) Tcl_LongAsWide(123);
+    static Tcl_WideUInt uwideVar = 123;
     static int created = 0;
     char buffer[2*TCL_DOUBLE_SPACE];
     int writable, flag;
@@ -6936,6 +6940,24 @@ TestgetintCmd(
     }
 }
 
+/*
+ * Used for determining sizeof(long) at script level.
+ */
+static int
+TestlongsizeCmd(
+    ClientData dummy,
+    Tcl_Interp *interp,
+    int argc,
+    const char **argv)
+{
+    if (argc != 1) {
+	Tcl_AppendResult(interp, "wrong # args", NULL);
+	return TCL_ERROR;
+    }
+    Tcl_SetObjResult(interp, Tcl_NewIntObj((int)sizeof(long)));
+    return TCL_OK;
+}
+
 static int
 NREUnwind_callback(
     ClientData data[],
diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c
index 3a6fc43..1742eb7 100644
--- a/generic/tclThreadTest.c
+++ b/generic/tclThreadTest.c
@@ -174,7 +174,6 @@ TclThread_Init(
     Tcl_CreateObjCommand(interp, "testthread", ThreadObjCmd, NULL, NULL);
     return TCL_OK;
 }
-
 
 /*
  *----------------------------------------------------------------------
@@ -1158,6 +1157,14 @@ ThreadExitProc(
 
     Tcl_MutexLock(&threadMutex);
 
+    if (self == errorThreadId) {
+	if (errorProcString) {	/* Extra safety */
+	    ckfree(errorProcString);
+	    errorProcString = NULL;
+	}
+	errorThreadId = 0;
+    }
+
     if (threadEvalScript) {
 	ckfree(threadEvalScript);
 	threadEvalScript = NULL;
diff --git a/generic/tclTomMath.decls b/generic/tclTomMath.decls
index 10df919..56ab55f 100644
--- a/generic/tclTomMath.decls
+++ b/generic/tclTomMath.decls
@@ -250,6 +250,9 @@ declare 70 {
 declare 71 {
     unsigned long TclBN_mp_get_long(const mp_int *a)
 }
+declare 72 {
+    unsigned long TclBN_mp_get_int(const mp_int *a)
+}
 
 # Local Variables:
 # mode: tcl
diff --git a/generic/tclTomMathDecls.h b/generic/tclTomMathDecls.h
index f3145d7..9fc034f 100644
--- a/generic/tclTomMathDecls.h
+++ b/generic/tclTomMathDecls.h
@@ -98,7 +98,6 @@
 #define mp_radix_size TclBN_mp_radix_size
 #define mp_read_radix TclBN_mp_read_radix
 #define mp_rshd TclBN_mp_rshd
-#define mp_s_rmap TclBNMpSRmap
 #define mp_set TclBN_mp_set
 #define mp_set_int TclBN_mp_set_int
 #define mp_set_long TclBN_mp_set_long
@@ -324,6 +323,8 @@ EXTERN Tcl_WideUInt	TclBN_mp_get_long_long(const mp_int *a);
 EXTERN int		TclBN_mp_set_long(mp_int *a, unsigned long i);
 /* 71 */
 EXTERN unsigned long	TclBN_mp_get_long(const mp_int *a);
+/* 72 */
+EXTERN unsigned long	TclBN_mp_get_int(const mp_int *a);
 
 typedef struct TclTomMathStubs {
     int magic;
@@ -401,6 +402,7 @@ typedef struct TclTomMathStubs {
     Tcl_WideUInt (*tclBN_mp_get_long_long) (const mp_int *a); /* 69 */
     int (*tclBN_mp_set_long) (mp_int *a, unsigned long i); /* 70 */
     unsigned long (*tclBN_mp_get_long) (const mp_int *a); /* 71 */
+    unsigned long (*tclBN_mp_get_int) (const mp_int *a); /* 72 */
 } TclTomMathStubs;
 
 extern const TclTomMathStubs *tclTomMathStubsPtr;
@@ -559,6 +561,8 @@ extern const TclTomMathStubs *tclTomMathStubsPtr;
 	(tclTomMathStubsPtr->tclBN_mp_set_long) /* 70 */
 #define TclBN_mp_get_long \
 	(tclTomMathStubsPtr->tclBN_mp_get_long) /* 71 */
+#define TclBN_mp_get_int \
+	(tclTomMathStubsPtr->tclBN_mp_get_int) /* 72 */
 
 #endif /* defined(USE_TCL_STUBS) */
 
diff --git a/generic/tclUtf.c b/generic/tclUtf.c
index 693e210..c8292a2 100644
--- a/generic/tclUtf.c
+++ b/generic/tclUtf.c
@@ -173,6 +173,13 @@ Tcl_UniCharToUtf(
 	    buf[0] = (char) ((ch >> 18) | 0xF0);
 	    return 4;
 	}
+    } else if (ch == -1) {
+	if (((buf[0] & 0xF8) == 0xF0) && ((buf[1] & 0xC0) == 0x80)
+		&& ((buf[2] & 0xCF) == 0)) {
+	    ch = 0xD7C0 + ((buf[0] & 0x07) << 8) + ((buf[1] & 0x3F) << 2)
+		    + ((buf[2] & 0x30) >> 4);
+	    goto three;
+	}
     }
 
     ch = 0xFFFD;
@@ -211,7 +218,7 @@ Tcl_UniCharToUtfDString(
 {
     const Tcl_UniChar *w, *wEnd;
     char *p, *string;
-    int oldLength;
+    int oldLength, len = 1;
 
     /*
      * UTF-8 string length in bytes will be <= Unicode string length * 4.
@@ -224,9 +231,18 @@ Tcl_UniCharToUtfDString(
     p = string;
     wEnd = uniStr + uniLength;
     for (w = uniStr; w < wEnd; ) {
-	p += Tcl_UniCharToUtf(*w, p);
+	if (!len && ((*w & 0xFC00) != 0xDC00)) {
+	    /* Special case for handling upper surrogates. */
+	    p += Tcl_UniCharToUtf(-1, p);
+	}
+	len = Tcl_UniCharToUtf(*w, p);
+	p += len;
 	w++;
     }
+    if (!len) {
+	/* Special case for handling upper surrogates. */
+	p += Tcl_UniCharToUtf(-1, p);
+    }
     Tcl_DStringSetLength(dsPtr, oldLength + (p - string));
 
     return string;
@@ -892,7 +908,7 @@ Tcl_UtfToUpper(
 	 * char to dst if its size is <= the original char.
 	 */
 
-	if (bytes < TclUtfCount(upChar)) {
+	if ((bytes < TclUtfCount(upChar)) || ((upChar & 0xF800) == 0xD800)) {
 	    memcpy(dst, src, (size_t) bytes);
 	    dst += bytes;
 	} else {
@@ -955,7 +971,7 @@ Tcl_UtfToLower(
 	 * char to dst if its size is <= the original char.
 	 */
 
-	if (bytes < TclUtfCount(lowChar)) {
+	if ((bytes < TclUtfCount(lowChar)) || ((lowChar & 0xF800) == 0xD800)) {
 	    memcpy(dst, src, (size_t) bytes);
 	    dst += bytes;
 	} else {
@@ -1015,7 +1031,7 @@ Tcl_UtfToTitle(
 #endif
 	titleChar = Tcl_UniCharToTitle(titleChar);
 
-	if (bytes < TclUtfCount(titleChar)) {
+	if ((bytes < TclUtfCount(titleChar)) || ((titleChar & 0xF800) == 0xD800)) {
 	    memcpy(dst, src, (size_t) bytes);
 	    dst += bytes;
 	} else {
@@ -1039,7 +1055,7 @@ Tcl_UtfToTitle(
 	    lowChar = Tcl_UniCharToLower(lowChar);
 	}
 
-	if (bytes < TclUtfCount(lowChar)) {
+	if ((bytes < TclUtfCount(lowChar)) || ((lowChar & 0xF800) == 0xD800)) {
 	    memcpy(dst, src, (size_t) bytes);
 	    dst += bytes;
 	} else {
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 0ba6c8e..48602c4 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -120,7 +120,7 @@ static int		FindElement(Tcl_Interp *interp, const char *string,
 /*
  * The following is the Tcl object type definition for an object that
  * represents a list index in the form, "end-offset". It is used as a
- * performance optimization in TclGetIntForIndex. The internal rep is 
+ * performance optimization in TclGetIntForIndex. The internal rep is
  * stored directly in the wideValue, so no memory management is required
  * for it. This is a caching intrep, keeping the result of a parse
  * around. This type is only created from a pre-existing string, so an
@@ -1673,7 +1673,7 @@ UtfWellFormedEnd(
     if (Tcl_UtfCharComplete(p, l - p)) {
 	return bytes;
     }
-    /* 
+    /*
      * Malformed utf-8 end, be sure we've NTS to safe compare of end-character,
      * avoid segfault by access violation out of range.
      */
@@ -3793,7 +3793,7 @@ GetEndOffsetFromObj(
     return TCL_OK;
 }
 
-    
+
 /*
  *----------------------------------------------------------------------
  *
@@ -3976,12 +3976,12 @@ TclIndexEncode(
         /* usual case, the absolute index value encodes itself */
     } else if (TCL_OK == GetEndOffsetFromObj(objPtr, 0, &idx)) {
         /*
-         * We parsed an end+offset index value. 
+         * We parsed an end+offset index value.
          * idx holds the offset value in the range INT_MIN...INT_MAX.
          */
         if (idx > 0) {
             /*
-             * All end+postive or end-negative expressions 
+             * All end+postive or end-negative expressions
              * always indicate "after the end".
              */
             idx = after;
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 7a4d4e9..cafa6a3 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -165,6 +165,18 @@ typedef struct ArraySearch {
 } ArraySearch;
 
 /*
+ * TIP #508: [array default]
+ *
+ * The following structure extends the regular TclVarHashTable used by array
+ * variables to store their optional default value.
+ */
+
+typedef struct ArrayVarHashTable {
+    TclVarHashTable table;
+    Tcl_Obj *defaultObj;
+} ArrayVarHashTable;
+
+/*
  * Forward references to functions defined later in this file:
  */
 
@@ -198,6 +210,16 @@ static void		UnsetVarStruct(Var *varPtr, Var *arrayPtr,
 			    Tcl_Obj *part2Ptr, int flags, int index);
 
 /*
+ * TIP #508: [array default]
+ */
+
+static int		ArrayDefaultCmd(ClientData clientData,
+			    Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[]);
+static void		DeleteArrayVar(Var *arrayPtr);
+static void		SetArrayDefault(Var *arrayPtr, Tcl_Obj *defaultObj);
+
+/*
  * Functions defined in this file that may be exported in the future for use
  * by the bytecode compiler and engine or to the public interface.
  */
@@ -236,7 +258,6 @@ static const Tcl_ObjType tclParsedVarNameType = {
     "parsedVarName",
     FreeParsedVarName, DupParsedVarName, NULL, NULL
 };
-
 
 Var *
 TclVarHashCreateVar(
@@ -916,20 +937,24 @@ TclLookupSimpleVar(
 	    }
 	}
     } else {			/* Local var: look in frame varFramePtr. */
-	int localLen, localCt = varFramePtr->numCompiledLocals;
-	Tcl_Obj **objPtrPtr = &varFramePtr->localCachePtr->varName0;
-	const char *localNameStr;
+	int localCt = varFramePtr->numCompiledLocals;
+
+	if (localCt > 0) {
+	    Tcl_Obj **objPtrPtr = &varFramePtr->localCachePtr->varName0;
+	    const char *localNameStr;
+	    int localLen;
 
-	for (i=0 ; i<localCt ; i++, objPtrPtr++) {
-	    register Tcl_Obj *objPtr = *objPtrPtr;
+	    for (i=0 ; i<localCt ; i++, objPtrPtr++) {
+		register Tcl_Obj *objPtr = *objPtrPtr;
 
-	    if (objPtr) {
-		localNameStr = TclGetStringFromObj(objPtr, &localLen);
+		if (objPtr) {
+		    localNameStr = TclGetStringFromObj(objPtr, &localLen);
 
-		if ((varLen == localLen) && (varName[0] == localNameStr[0])
+		    if ((varLen == localLen) && (varName[0] == localNameStr[0])
 			&& !memcmp(varName, localNameStr, varLen)) {
-		    *indexPtr = i;
-		    return (Var *) &varFramePtr->compiledLocals[i];
+			*indexPtr = i;
+			return (Var *) &varFramePtr->compiledLocals[i];
+		    }
 		}
 	    }
 	}
@@ -1015,8 +1040,6 @@ TclLookupArrayElement(
 {
     int isNew;
     Var *varPtr;
-    TclVarHashTable *tablePtr;
-    Namespace *nsPtr;
 
     /*
      * We're dealing with an array element. Make sure the variable is an array
@@ -1049,16 +1072,7 @@ TclLookupArrayElement(
 	    return NULL;
 	}
 
-	TclSetVarArray(arrayPtr);
-	tablePtr = ckalloc(sizeof(TclVarHashTable));
-	arrayPtr->value.tablePtr = tablePtr;
-
-	if (TclIsVarInHash(arrayPtr) && TclGetVarNsPtr(arrayPtr)) {
-	    nsPtr = TclGetVarNsPtr(arrayPtr);
-	} else {
-	    nsPtr = NULL;
-	}
-	TclInitVarHashTable(arrayPtr->value.tablePtr, nsPtr);
+	TclInitArrayVar(arrayPtr);
     } else if (!TclIsVarArray(arrayPtr)) {
 	if (flags & TCL_LEAVE_ERR_MSG) {
 	    TclObjVarErrMsg(interp, arrayNamePtr, elNamePtr, msg, needArray,
@@ -1408,6 +1422,28 @@ TclPtrGetVarIdx(
 	return varPtr->value.objPtr;
     }
 
+    /*
+     * Return the array default value if any.
+     */
+
+    if (arrayPtr && TclIsVarArray(arrayPtr) && TclGetArrayDefault(arrayPtr)) {
+	return TclGetArrayDefault(arrayPtr);
+    }
+    if (TclIsVarArrayElement(varPtr) && !arrayPtr) {
+	/*
+	 * UGLY! Peek inside the implementation of things. This lets us get
+	 * the default of an array even when we've been [upvar]ed to just an
+	 * element of the array.
+	 */
+
+	ArrayVarHashTable *avhtPtr = (ArrayVarHashTable *)
+		((VarInHash *) varPtr)->entry.tablePtr;
+
+	if (avhtPtr->defaultObj) {
+	    return avhtPtr->defaultObj;
+	}
+    }
+
     if (flags & TCL_LEAVE_ERR_MSG) {
 	if (TclIsVarUndefined(varPtr) && arrayPtr
 		&& !TclIsVarUndefined(arrayPtr)) {
@@ -1768,6 +1804,130 @@ TclPtrSetVar(
 /*
  *----------------------------------------------------------------------
  *
+ * ListAppendInVar, StringAppendInVar --
+ *
+ *	Support functions for TclPtrSetVarIdx that implement various types of
+ *	appending operations.
+ *
+ * Results:
+ *	ListAppendInVar returns a Tcl result code (from the core list append
+ *	operation). StringAppendInVar has no return value.
+ *
+ * Side effects:
+ *	The variable or element of the array is updated. This may make the
+ *	variable/element exist. Reference counts of values may be updated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static inline int
+ListAppendInVar(
+    Tcl_Interp *interp,
+    Var *varPtr,
+    Var *arrayPtr,
+    Tcl_Obj *oldValuePtr,
+    Tcl_Obj *newValuePtr)
+{
+    if (oldValuePtr == NULL) {
+	/*
+	 * No previous value. Check for defaults if there's an array we can
+	 * ask this of.
+	 */
+
+	if (arrayPtr) {
+	    Tcl_Obj *defValuePtr = TclGetArrayDefault(arrayPtr);
+
+	    if (defValuePtr) {
+		oldValuePtr = Tcl_DuplicateObj(defValuePtr);
+	    }
+	}
+
+	if (oldValuePtr == NULL) {
+	    /*
+	     * No default. [lappend] semantics say this is like being an empty
+	     * string.
+	     */
+
+	    TclNewObj(oldValuePtr);
+	}
+	varPtr->value.objPtr = oldValuePtr;
+	Tcl_IncrRefCount(oldValuePtr);	/* Since var is referenced. */
+    } else if (Tcl_IsShared(oldValuePtr)) {
+	varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);
+	TclDecrRefCount(oldValuePtr);
+	oldValuePtr = varPtr->value.objPtr;
+	Tcl_IncrRefCount(oldValuePtr);	/* Since var is referenced. */
+    }
+
+    return Tcl_ListObjAppendElement(interp, oldValuePtr, newValuePtr);
+}
+
+static inline void
+StringAppendInVar(
+    Var *varPtr,
+    Var *arrayPtr,
+    Tcl_Obj *oldValuePtr,
+    Tcl_Obj *newValuePtr)
+{
+    /*
+     * If there was no previous value, either we use the array's default (if
+     * this is an array with a default at all) or we treat this as a simple
+     * set.
+     */
+
+    if (oldValuePtr == NULL) {
+	if (arrayPtr) {
+	    Tcl_Obj *defValuePtr = TclGetArrayDefault(arrayPtr);
+
+	    if (defValuePtr) {
+		/*
+		 * This is *almost* the same as the shared path below, except
+		 * that the original value reference in defValuePtr is not
+		 * decremented.
+		 */
+
+		Tcl_Obj *valuePtr = Tcl_DuplicateObj(defValuePtr);
+
+		varPtr->value.objPtr = valuePtr;
+		TclContinuationsCopy(valuePtr, defValuePtr);
+		Tcl_IncrRefCount(valuePtr);
+		Tcl_AppendObjToObj(valuePtr, newValuePtr);
+		if (newValuePtr->refCount == 0) {
+		    Tcl_DecrRefCount(newValuePtr);
+		}
+		return;
+	    }
+	}
+	varPtr->value.objPtr = newValuePtr;
+	Tcl_IncrRefCount(newValuePtr);
+	return;
+    }
+
+    /*
+     * We append newValuePtr's bytes but don't change its ref count. Unless
+     * the reference is shared, when we have to duplicate in order to be safe
+     * to modify at all.
+     */
+
+    if (Tcl_IsShared(oldValuePtr)) {	/* Append to copy. */
+	varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);
+
+	TclContinuationsCopy(varPtr->value.objPtr, oldValuePtr);
+
+	TclDecrRefCount(oldValuePtr);
+	oldValuePtr = varPtr->value.objPtr;
+	Tcl_IncrRefCount(oldValuePtr);	/* Since var is ref */
+    }
+
+    Tcl_AppendObjToObj(oldValuePtr, newValuePtr);
+    if (newValuePtr->refCount == 0) {
+	Tcl_DecrRefCount(newValuePtr);
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TclPtrSetVarIdx --
  *
  *	This function is the same as Tcl_SetVar2Ex above, except that it
@@ -1880,44 +2040,13 @@ TclPtrSetVarIdx(
     }
     if (flags & (TCL_APPEND_VALUE|TCL_LIST_ELEMENT)) {
 	if (flags & TCL_LIST_ELEMENT) {		/* Append list element. */
-	    if (oldValuePtr == NULL) {
-		TclNewObj(oldValuePtr);
-		varPtr->value.objPtr = oldValuePtr;
-		Tcl_IncrRefCount(oldValuePtr);	/* Since var is referenced. */
-	    } else if (Tcl_IsShared(oldValuePtr)) {
-		varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);
-		TclDecrRefCount(oldValuePtr);
-		oldValuePtr = varPtr->value.objPtr;
-		Tcl_IncrRefCount(oldValuePtr);	/* Since var is referenced. */
-	    }
-	    result = Tcl_ListObjAppendElement(interp, oldValuePtr,
+	    result = ListAppendInVar(interp, varPtr, arrayPtr, oldValuePtr,
 		    newValuePtr);
 	    if (result != TCL_OK) {
 		goto earlyError;
 	    }
 	} else {				/* Append string. */
-	    /*
-	     * We append newValuePtr's bytes but don't change its ref count.
-	     */
-
-	    if (oldValuePtr == NULL) {
-		varPtr->value.objPtr = newValuePtr;
-		Tcl_IncrRefCount(newValuePtr);
-	    } else {
-		if (Tcl_IsShared(oldValuePtr)) {	/* Append to copy. */
-		    varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);
-
-		    TclContinuationsCopy(varPtr->value.objPtr, oldValuePtr);
-
-		    TclDecrRefCount(oldValuePtr);
-		    oldValuePtr = varPtr->value.objPtr;
-		    Tcl_IncrRefCount(oldValuePtr);	/* Since var is ref */
-		}
-		Tcl_AppendObjToObj(oldValuePtr, newValuePtr);
-		if (newValuePtr->refCount == 0) {
-		    Tcl_DecrRefCount(newValuePtr);
-		}
-	    }
+	    StringAppendInVar(varPtr, arrayPtr, oldValuePtr, newValuePtr);
 	}
     } else if (newValuePtr != oldValuePtr) {
 	/*
@@ -2993,7 +3122,7 @@ ArrayObjNext(
     return donerc;
 }
 
-int
+static int
 ArrayForObjCmd(
     ClientData dummy,		/* Not used. */
     Tcl_Interp *interp,		/* Current interpreter. */
@@ -4074,9 +4203,7 @@ ArraySetCmd(
 	    return TCL_ERROR;
 	}
     }
-    TclSetVarArray(varPtr);
-    varPtr->value.tablePtr = ckalloc(sizeof(TclVarHashTable));
-    TclInitVarHashTable(varPtr->value.tablePtr, TclGetVarNsPtr(varPtr));
+    TclInitArrayVar(varPtr);
     return TCL_OK;
 }
 
@@ -4356,6 +4483,7 @@ TclInitArrayCmd(
 {
     static const EnsembleImplMap arrayImplMap[] = {
 	{"anymore",	ArrayAnyMoreCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
+	{"default",	ArrayDefaultCmd,	TclCompileBasic2Or3ArgCmd, NULL, NULL, 0},
 	{"donesearch",	ArrayDoneSearchCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
 	{"exists",	ArrayExistsCmd,		TclCompileArrayExistsCmd, NULL, NULL, 0},
 	{"for",		ArrayForObjCmd,		TclCompileBasic3ArgCmd, ArrayForNRCmd, NULL, 0},
@@ -5546,8 +5674,7 @@ DeleteArray(
 
 	TclClearVarNamespaceVar(elPtr);
     }
-    VarHashDeleteTable(varPtr->value.tablePtr);
-    ckfree(varPtr->value.tablePtr);
+    DeleteArrayVar(varPtr);
 }
 
 /*
@@ -6236,7 +6363,7 @@ AppendLocals(
     Interp *iPtr = (Interp *) interp;
     Var *varPtr;
     int i, localVarCt, added;
-    Tcl_Obj **varNamePtr, *objNamePtr;
+    Tcl_Obj *objNamePtr;
     const char *varName;
     TclVarHashTable *localVarTablePtr;
     Tcl_HashSearch search;
@@ -6246,27 +6373,30 @@ AppendLocals(
     localVarCt = iPtr->varFramePtr->numCompiledLocals;
     varPtr = iPtr->varFramePtr->compiledLocals;
     localVarTablePtr = iPtr->varFramePtr->varTablePtr;
-    varNamePtr = &iPtr->varFramePtr->localCachePtr->varName0;
     if (includeLinks) {
 	Tcl_InitObjHashTable(&addedTable);
     }
 
-    for (i = 0; i < localVarCt; i++, varNamePtr++) {
-	/*
-	 * Skip nameless (temporary) variables and undefined variables.
-	 */
+    if (localVarCt > 0) {
+	Tcl_Obj **varNamePtr = &iPtr->varFramePtr->localCachePtr->varName0;
+
+	for (i = 0; i < localVarCt; i++, varNamePtr++) {
+	    /*
+	     * Skip nameless (temporary) variables and undefined variables.
+	     */
 
-	if (*varNamePtr && !TclIsVarUndefined(varPtr)
+	    if (*varNamePtr && !TclIsVarUndefined(varPtr)
 		&& (includeLinks || !TclIsVarLink(varPtr))) {
-	    varName = TclGetString(*varNamePtr);
-	    if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
-		Tcl_ListObjAppendElement(interp, listPtr, *varNamePtr);
-		if (includeLinks) {
-		    Tcl_CreateHashEntry(&addedTable, *varNamePtr, &added);
+		varName = TclGetString(*varNamePtr);
+		if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
+		    Tcl_ListObjAppendElement(interp, listPtr, *varNamePtr);
+		    if (includeLinks) {
+			Tcl_CreateHashEntry(&addedTable, *varNamePtr, &added);
+		    }
 		}
 	    }
+	    varPtr++;
 	}
-	varPtr++;
     }
 
     /*
@@ -6460,6 +6590,264 @@ CompareVarKeys(
     return ((l1 == l2) && !memcmp(p1, p2, l1));
 }
 
+/*----------------------------------------------------------------------
+ *
+ * ArrayDefaultCmd --
+ *
+ *	This function implements the 'array default' Tcl command.
+ *	Refer to the user documentation for details on what it does.
+ *
+ * Results:
+ *	Returns a standard Tcl result.
+ *
+ * Side effects:
+ *	See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+	/* ARGSUSED */
+static int
+ArrayDefaultCmd(
+    ClientData clientData,	/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    static const char *const options[] = {
+	"get", "set", "exists", "unset", NULL
+    };
+    enum options { OPT_GET, OPT_SET, OPT_EXISTS, OPT_UNSET };
+    Tcl_Obj *arrayNameObj, *defaultValueObj;
+    Var *varPtr, *arrayPtr;
+    int isArray, option;
+
+    /*
+     * Parse arguments.
+     */
+
+    if (objc != 3 && objc != 4) {
+	Tcl_WrongNumArgs(interp, 1, objv, "option arrayName ?value?");
+	return TCL_ERROR;
+    }
+    if (Tcl_GetIndexFromObj(interp, objv[1], options, "option",
+	    0, &option) != TCL_OK) {
+	return TCL_ERROR;
+    }
+
+    arrayNameObj = objv[2];
+
+    if (TCL_ERROR == LocateArray(interp, arrayNameObj, &varPtr, &isArray)) {
+	return TCL_ERROR;
+    }
+
+    switch (option) {
+    case OPT_GET:
+	if (objc != 3) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName");
+	    return TCL_ERROR;
+	}
+	if (!varPtr || TclIsVarUndefined(varPtr) || !isArray) {
+	    return NotArrayError(interp, arrayNameObj);
+	}
+
+	defaultValueObj = TclGetArrayDefault(varPtr);
+	if (!defaultValueObj) {
+	    /* Array default must exist. */
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "array has no default value", -1));
+	    Tcl_SetErrorCode(interp, "TCL", "READ", "ARRAY", "DEFAULT", NULL);
+	    return TCL_ERROR;
+	}
+	Tcl_SetObjResult(interp, defaultValueObj);
+	return TCL_OK;
+
+    case OPT_SET:
+	if (objc != 4) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName value");
+	    return TCL_ERROR;
+	}
+
+	/*
+	 * Attempt to create array if needed.
+	 */
+	varPtr = TclObjLookupVarEx(interp, arrayNameObj, NULL,
+		/*flags*/ TCL_LEAVE_ERR_MSG, /*msg*/ "array default set",
+		/*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
+	if (varPtr == NULL) {
+	    return TCL_ERROR;
+	}
+	if (arrayPtr) {
+	    /*
+	     * Not a valid array name.
+	     */
+
+	    CleanupVar(varPtr, arrayPtr);
+	    TclObjVarErrMsg(interp, arrayNameObj, NULL, "array default set",
+		    needArray, -1);
+	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
+		    TclGetString(arrayNameObj), NULL);
+	    return TCL_ERROR;
+	}
+	if (!TclIsVarArray(varPtr) && !TclIsVarUndefined(varPtr)) {
+	    /*
+	     * Not an array.
+	     */
+
+	    TclObjVarErrMsg(interp, arrayNameObj, NULL, "array default set",
+		    needArray, -1);
+	    Tcl_SetErrorCode(interp, "TCL", "WRITE", "ARRAY", NULL);
+	    return TCL_ERROR;
+	}
+
+	if (!TclIsVarArray(varPtr)) {
+	    TclInitArrayVar(varPtr);
+	}
+	defaultValueObj = objv[3];
+	SetArrayDefault(varPtr, defaultValueObj);
+	return TCL_OK;
+
+    case OPT_EXISTS:
+	if (objc != 3) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName");
+	    return TCL_ERROR;
+	}
+
+	/*
+	 * Undefined variables (whether or not they have storage allocated) do
+	 * not have defaults, and this is not an error case.
+	 */
+
+	if (!varPtr || TclIsVarUndefined(varPtr)) {
+	    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0));
+	} else if (!isArray) {
+	    return NotArrayError(interp, arrayNameObj);
+	} else {
+	    defaultValueObj = TclGetArrayDefault(varPtr);
+	    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(!!defaultValueObj));
+	}
+	return TCL_OK;
+
+    case OPT_UNSET:
+	if (objc != 3) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "arrayName");
+	    return TCL_ERROR;
+	}
+
+	if (varPtr && !TclIsVarUndefined(varPtr)) {
+	    if (!isArray) {
+		return NotArrayError(interp, arrayNameObj);
+	    }
+	    SetArrayDefault(varPtr, NULL);
+	}
+	return TCL_OK;
+    }
+
+    /* Unreached */
+    return TCL_ERROR;
+}
+
+/*
+ * Initialize array variable.
+ */
+
+void
+TclInitArrayVar(
+    Var *arrayPtr)
+{
+    ArrayVarHashTable *tablePtr = ckalloc(sizeof(ArrayVarHashTable));
+
+    /*
+     * Mark the variable as an array.
+     */
+
+    TclSetVarArray(arrayPtr);
+
+    /*
+     * Regular TclVarHashTable initialization.
+     */
+
+    arrayPtr->value.tablePtr = (TclVarHashTable *) tablePtr;
+    TclInitVarHashTable(arrayPtr->value.tablePtr, TclGetVarNsPtr(arrayPtr));
+
+    /*
+     * Default value initialization.
+     */
+
+    tablePtr->defaultObj = NULL;
+}
+
+/*
+ * Cleanup array variable.
+ */
+
+static void
+DeleteArrayVar(
+    Var *arrayPtr)
+{
+    ArrayVarHashTable *tablePtr = (ArrayVarHashTable *)
+	    arrayPtr->value.tablePtr;
+
+    /*
+     * Default value cleanup.
+     */
+
+    SetArrayDefault(arrayPtr, NULL);
+
+    /*
+     * Regular TclVarHashTable cleanup.
+     */
+
+    VarHashDeleteTable(arrayPtr->value.tablePtr);
+    ckfree(tablePtr);
+}
+
+/*
+ * Get array default value if any.
+ */
+
+Tcl_Obj *
+TclGetArrayDefault(
+    Var *arrayPtr)
+{
+    ArrayVarHashTable *tablePtr = (ArrayVarHashTable *)
+	    arrayPtr->value.tablePtr;
+
+    return tablePtr->defaultObj;
+}
+
+/*
+ * Set/replace/unset array default value.
+ */
+
+static void
+SetArrayDefault(
+    Var *arrayPtr,
+    Tcl_Obj *defaultObj)
+{
+    ArrayVarHashTable *tablePtr = (ArrayVarHashTable *)
+	    arrayPtr->value.tablePtr;
+
+    /*
+     * Increment/decrement refcount twice to ensure that the object is shared,
+     * so that it doesn't get modified accidentally by the folling code:
+     *
+     *      array default set v 1
+     *      lappend v(a) 2; # returns a new object {1 2}
+     *      set v(b); # returns the original default object "1"
+     */
+
+    if (tablePtr->defaultObj) {
+        Tcl_DecrRefCount(tablePtr->defaultObj);
+        Tcl_DecrRefCount(tablePtr->defaultObj);
+    }
+    tablePtr->defaultObj = defaultObj;
+    if (tablePtr->defaultObj) {
+        Tcl_IncrRefCount(tablePtr->defaultObj);
+        Tcl_IncrRefCount(tablePtr->defaultObj);
+    }
+}
+
 /*
  * Local Variables:
  * mode: c
diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c
new file mode 100644
index 0000000..19673c8
--- /dev/null
+++ b/generic/tclZipfs.c
@@ -0,0 +1,4525 @@
+/*
+ * tclZipfs.c --
+ *
+ *    Implementation of the ZIP filesystem used in TIP 430
+ *    Adapted from the implentation for AndroWish.
+ *
+ * Coptright (c) 2016-2017 Sean Woods <yoda@etoyoc.com>
+ * Copyright (c) 2013-2015 Christian Werner <chw@ch-werner.de>
+ *
+ * See the file "license.terms" for information on usage and redistribution of
+ * this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * This file is distributed in two ways:
+ *   generic/tclZipfs.c file in the TIP430 enabled tcl cores
+ *   compat/tclZipfs.c file in the tclconfig (TEA) file system, for pre-tip430 projects
+ */
+
+#include "tclInt.h"
+#include "tclFileSystem.h"
+
+#ifdef _WIN32
+#include <winbase.h>
+#else
+#include <sys/mman.h>
+#endif
+#include <errno.h>
+#include <string.h>
+#include <sys/stat.h>
+#include <time.h>
+#include <stdlib.h>
+#include <fcntl.h>
+
+#ifndef MAP_FILE
+#define MAP_FILE 0
+#endif
+
+#ifdef HAVE_ZLIB
+#include "zlib.h"
+#include "crypt.h"
+
+#ifdef CFG_RUNTIME_DLLFILE
+/*
+** We are compiling as part of the core.
+** TIP430 style zipfs prefix
+*/
+#define ZIPFS_VOLUME      "//zipfs:/"
+#define ZIPFS_VOLUME_LEN  9
+#define ZIPFS_APP_MOUNT   "//zipfs:/app"
+#define ZIPFS_ZIP_MOUNT   "//zipfs:/lib/tcl"
+#else
+/*
+** We are compiling from the /compat folder of tclconfig
+** Pre TIP430 style zipfs prefix
+** //zipfs:/ doesn't work straight out of the box on either windows or Unix
+** without other changes made to tip 430
+*/
+#define ZIPFS_VOLUME      "zipfs:/"
+#define ZIPFS_VOLUME_LEN  7
+#define ZIPFS_APP_MOUNT   "zipfs:/app"
+#define ZIPFS_ZIP_MOUNT   "zipfs:/lib/tcl"
+#endif
+/*
+ * Various constants and offsets found in ZIP archive files
+ */
+
+#define ZIP_SIG_LEN                     4
+
+/* Local header of ZIP archive member (at very beginning of each member). */
+#define ZIP_LOCAL_HEADER_SIG            0x04034b50
+#define ZIP_LOCAL_HEADER_LEN            30
+#define ZIP_LOCAL_SIG_OFFS              0
+#define ZIP_LOCAL_VERSION_OFFS          4
+#define ZIP_LOCAL_FLAGS_OFFS            6
+#define ZIP_LOCAL_COMPMETH_OFFS         8
+#define ZIP_LOCAL_MTIME_OFFS            10
+#define ZIP_LOCAL_MDATE_OFFS            12
+#define ZIP_LOCAL_CRC32_OFFS            14
+#define ZIP_LOCAL_COMPLEN_OFFS          18
+#define ZIP_LOCAL_UNCOMPLEN_OFFS        22
+#define ZIP_LOCAL_PATHLEN_OFFS          26
+#define ZIP_LOCAL_EXTRALEN_OFFS         28
+
+/* Central header of ZIP archive member at end of ZIP file. */
+#define ZIP_CENTRAL_HEADER_SIG          0x02014b50
+#define ZIP_CENTRAL_HEADER_LEN          46
+#define ZIP_CENTRAL_SIG_OFFS            0
+#define ZIP_CENTRAL_VERSIONMADE_OFFS    4
+#define ZIP_CENTRAL_VERSION_OFFS        6
+#define ZIP_CENTRAL_FLAGS_OFFS          8
+#define ZIP_CENTRAL_COMPMETH_OFFS       10
+#define ZIP_CENTRAL_MTIME_OFFS          12
+#define ZIP_CENTRAL_MDATE_OFFS          14
+#define ZIP_CENTRAL_CRC32_OFFS          16
+#define ZIP_CENTRAL_COMPLEN_OFFS        20
+#define ZIP_CENTRAL_UNCOMPLEN_OFFS      24
+#define ZIP_CENTRAL_PATHLEN_OFFS        28
+#define ZIP_CENTRAL_EXTRALEN_OFFS       30
+#define ZIP_CENTRAL_FCOMMENTLEN_OFFS    32
+#define ZIP_CENTRAL_DISKFILE_OFFS       34
+#define ZIP_CENTRAL_IATTR_OFFS          36
+#define ZIP_CENTRAL_EATTR_OFFS          38
+#define ZIP_CENTRAL_LOCALHDR_OFFS       42
+
+/* Central end signature at very end of ZIP file. */
+#define ZIP_CENTRAL_END_SIG             0x06054b50
+#define ZIP_CENTRAL_END_LEN             22
+#define ZIP_CENTRAL_END_SIG_OFFS        0
+#define ZIP_CENTRAL_DISKNO_OFFS         4
+#define ZIP_CENTRAL_DISKDIR_OFFS        6
+#define ZIP_CENTRAL_ENTS_OFFS           8
+#define ZIP_CENTRAL_TOTALENTS_OFFS      10
+#define ZIP_CENTRAL_DIRSIZE_OFFS        12
+#define ZIP_CENTRAL_DIRSTART_OFFS       16
+#define ZIP_CENTRAL_COMMENTLEN_OFFS     20
+
+#define ZIP_MIN_VERSION                 20
+#define ZIP_COMPMETH_STORED             0
+#define ZIP_COMPMETH_DEFLATED           8
+
+#define ZIP_PASSWORD_END_SIG            0x5a5a4b50
+
+/* Macro to report errors only if an interp is present */
+#define ZIPFS_ERROR(interp,errstr) \
+    if(interp != NULL) Tcl_SetObjResult(interp, Tcl_NewStringObj(errstr, -1));
+
+/*
+ * Macros to read and write 16 and 32 bit integers from/to ZIP archives.
+ */
+
+#define zip_read_int(p)                         \
+    ((p)[0] | ((p)[1] << 8) | ((p)[2] << 16) | ((p)[3] << 24))
+#define zip_read_short(p)                       \
+    ((p)[0] | ((p)[1] << 8))
+
+#define zip_write_int(p, v)                    \
+    (p)[0] = (v) & 0xff; (p)[1] = ((v) >> 8) & 0xff;        \
+    (p)[2] = ((v) >> 16) & 0xff; (p)[3] = ((v) >> 24) & 0xff;
+#define zip_write_short(p, v)                    \
+    (p)[0] = (v) & 0xff; (p)[1] = ((v) >> 8) & 0xff;
+
+/*
+ * Windows drive letters.
+ */
+
+#ifdef _WIN32
+static const char drvletters[] =
+    "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ";
+#endif
+
+/*
+ * Mutex to protect localtime(3) when no reentrant version available.
+ */
+
+#ifndef _WIN32
+#ifndef HAVE_LOCALTIME_R
+#ifdef TCL_THREADS
+TCL_DECLARE_MUTEX(localtimeMutex)
+#endif
+#endif
+#endif
+
+/*
+ * In-core description of mounted ZIP archive file.
+ */
+
+typedef struct ZipFile {
+    char *name;               /* Archive name */
+    size_t namelen;
+    char is_membuf;           /* When true, not a file but a memory buffer */
+    Tcl_Channel chan;         /* Channel handle or NULL */
+    unsigned char *data;      /* Memory mapped or malloc'ed file */
+    size_t length;            /* Length of memory mapped file */
+    void *tofree;             /* Non-NULL if malloc'ed file */
+    size_t nfiles;            /* Number of files in archive */
+    size_t baseoffs;          /* Archive start */
+    size_t baseoffsp;         /* Password start */
+    size_t centoffs;          /* Archive directory start */
+    unsigned char pwbuf[264]; /* Password buffer */
+    size_t nopen;             /* Number of open files on archive */
+    struct ZipEntry *entries; /* List of files in archive */
+    struct ZipEntry *topents; /* List of top-level dirs in archive */
+    size_t mntptlen;
+    char *mntpt;              /* Mount point */
+#ifdef _WIN32
+    HANDLE mh;
+    int mntdrv;               /* Drive letter of mount point */
+#endif
+} ZipFile;
+
+/*
+ * In-core description of file contained in mounted ZIP archive.
+ */
+
+typedef struct ZipEntry {
+    char *name;               /* The full pathname of the virtual file */
+    ZipFile *zipfile;         /* The ZIP file holding this virtual file */
+    Tcl_WideInt offset;       /* Data offset into memory mapped ZIP file */
+    int nbyte;                /* Uncompressed size of the virtual file */
+    int nbytecompr;           /* Compressed size of the virtual file */
+    int cmeth;                /* Compress method */
+    int isdir;                  /* Set to 1 if directory, or -1 if root */
+    int depth;                   /* Number of slashes in path. */
+    int crc32;                /* CRC-32 */
+    int timestamp;            /* Modification time */
+    int isenc;                /* True if data is encrypted */
+    unsigned char *data;      /* File data if written */
+    struct ZipEntry *next;    /* Next file in the same archive */
+    struct ZipEntry *tnext;   /* Next top-level dir in archive */
+} ZipEntry;
+
+/*
+ * File channel for file contained in mounted ZIP archive.
+ */
+
+typedef struct ZipChannel {
+    ZipFile *zipfile;         /* The ZIP file holding this channel */
+    ZipEntry *zipentry;       /* Pointer back to virtual file */
+    size_t nmax;              /* Max. size for write */
+    size_t nbyte;             /* Number of bytes of uncompressed data */
+    size_t nread;             /* Pos of next byte to be read from the channel */
+    unsigned char *ubuf;      /* Pointer to the uncompressed data */
+    int iscompr;              /* True if data is compressed */
+    int isdir;                /* Set to 1 if directory, or -1 if root */
+    int isenc;                /* True if data is encrypted */
+    int iswr;                 /* True if open for writing */
+    unsigned long keys[3];    /* Key for decryption */
+} ZipChannel;
+
+/*
+ * Global variables.
+ *
+ * Most are kept in single ZipFS struct. When build with threading
+ * support this struct is protected by the ZipFSMutex (see below).
+ *
+ * The "fileHash" component is the process wide global table of all known
+ * ZIP archive members in all mounted ZIP archives.
+ *
+ * The "zipHash" components is the process wide global table of all mounted
+ * ZIP archive files.
+ */
+
+static struct {
+    int initialized;        /* True when initialized */
+    int lock;            /* RW lock, see below */
+    int waiters;        /* RW lock, see below */
+    int wrmax;            /* Maximum write size of a file */
+    int idCount;        /* Counter for channel names */
+    Tcl_HashTable fileHash;    /* File name to ZipEntry mapping */
+    Tcl_HashTable zipHash;    /* Mount to ZipFile mapping */
+} ZipFS = {
+    0, 0, 0, 0, 0,
+};
+
+/*
+ * For password rotation.
+ */
+
+static const char pwrot[16] = {
+    0x00, 0x80, 0x40, 0xc0, 0x20, 0xa0, 0x60, 0xe0,
+    0x10, 0x90, 0x50, 0xd0, 0x30, 0xb0, 0x70, 0xf0
+};
+
+/*
+ * Table to compute CRC32.
+ */
+
+static const z_crc_t crc32tab[256] = {
+    0x00000000, 0x77073096, 0xee0e612c, 0x990951ba, 0x076dc419,
+    0x706af48f, 0xe963a535, 0x9e6495a3, 0x0edb8832, 0x79dcb8a4,
+    0xe0d5e91e, 0x97d2d988, 0x09b64c2b, 0x7eb17cbd, 0xe7b82d07,
+    0x90bf1d91, 0x1db71064, 0x6ab020f2, 0xf3b97148, 0x84be41de,
+    0x1adad47d, 0x6ddde4eb, 0xf4d4b551, 0x83d385c7, 0x136c9856,
+    0x646ba8c0, 0xfd62f97a, 0x8a65c9ec, 0x14015c4f, 0x63066cd9,
+    0xfa0f3d63, 0x8d080df5, 0x3b6e20c8, 0x4c69105e, 0xd56041e4,
+    0xa2677172, 0x3c03e4d1, 0x4b04d447, 0xd20d85fd, 0xa50ab56b,
+    0x35b5a8fa, 0x42b2986c, 0xdbbbc9d6, 0xacbcf940, 0x32d86ce3,
+    0x45df5c75, 0xdcd60dcf, 0xabd13d59, 0x26d930ac, 0x51de003a,
+    0xc8d75180, 0xbfd06116, 0x21b4f4b5, 0x56b3c423, 0xcfba9599,
+    0xb8bda50f, 0x2802b89e, 0x5f058808, 0xc60cd9b2, 0xb10be924,
+    0x2f6f7c87, 0x58684c11, 0xc1611dab, 0xb6662d3d, 0x76dc4190,
+    0x01db7106, 0x98d220bc, 0xefd5102a, 0x71b18589, 0x06b6b51f,
+    0x9fbfe4a5, 0xe8b8d433, 0x7807c9a2, 0x0f00f934, 0x9609a88e,
+    0xe10e9818, 0x7f6a0dbb, 0x086d3d2d, 0x91646c97, 0xe6635c01,
+    0x6b6b51f4, 0x1c6c6162, 0x856530d8, 0xf262004e, 0x6c0695ed,
+    0x1b01a57b, 0x8208f4c1, 0xf50fc457, 0x65b0d9c6, 0x12b7e950,
+    0x8bbeb8ea, 0xfcb9887c, 0x62dd1ddf, 0x15da2d49, 0x8cd37cf3,
+    0xfbd44c65, 0x4db26158, 0x3ab551ce, 0xa3bc0074, 0xd4bb30e2,
+    0x4adfa541, 0x3dd895d7, 0xa4d1c46d, 0xd3d6f4fb, 0x4369e96a,
+    0x346ed9fc, 0xad678846, 0xda60b8d0, 0x44042d73, 0x33031de5,
+    0xaa0a4c5f, 0xdd0d7cc9, 0x5005713c, 0x270241aa, 0xbe0b1010,
+    0xc90c2086, 0x5768b525, 0x206f85b3, 0xb966d409, 0xce61e49f,
+    0x5edef90e, 0x29d9c998, 0xb0d09822, 0xc7d7a8b4, 0x59b33d17,
+    0x2eb40d81, 0xb7bd5c3b, 0xc0ba6cad, 0xedb88320, 0x9abfb3b6,
+    0x03b6e20c, 0x74b1d29a, 0xead54739, 0x9dd277af, 0x04db2615,
+    0x73dc1683, 0xe3630b12, 0x94643b84, 0x0d6d6a3e, 0x7a6a5aa8,
+    0xe40ecf0b, 0x9309ff9d, 0x0a00ae27, 0x7d079eb1, 0xf00f9344,
+    0x8708a3d2, 0x1e01f268, 0x6906c2fe, 0xf762575d, 0x806567cb,
+    0x196c3671, 0x6e6b06e7, 0xfed41b76, 0x89d32be0, 0x10da7a5a,
+    0x67dd4acc, 0xf9b9df6f, 0x8ebeeff9, 0x17b7be43, 0x60b08ed5,
+    0xd6d6a3e8, 0xa1d1937e, 0x38d8c2c4, 0x4fdff252, 0xd1bb67f1,
+    0xa6bc5767, 0x3fb506dd, 0x48b2364b, 0xd80d2bda, 0xaf0a1b4c,
+    0x36034af6, 0x41047a60, 0xdf60efc3, 0xa867df55, 0x316e8eef,
+    0x4669be79, 0xcb61b38c, 0xbc66831a, 0x256fd2a0, 0x5268e236,
+    0xcc0c7795, 0xbb0b4703, 0x220216b9, 0x5505262f, 0xc5ba3bbe,
+    0xb2bd0b28, 0x2bb45a92, 0x5cb36a04, 0xc2d7ffa7, 0xb5d0cf31,
+    0x2cd99e8b, 0x5bdeae1d, 0x9b64c2b0, 0xec63f226, 0x756aa39c,
+    0x026d930a, 0x9c0906a9, 0xeb0e363f, 0x72076785, 0x05005713,
+    0x95bf4a82, 0xe2b87a14, 0x7bb12bae, 0x0cb61b38, 0x92d28e9b,
+    0xe5d5be0d, 0x7cdcefb7, 0x0bdbdf21, 0x86d3d2d4, 0xf1d4e242,
+    0x68ddb3f8, 0x1fda836e, 0x81be16cd, 0xf6b9265b, 0x6fb077e1,
+    0x18b74777, 0x88085ae6, 0xff0f6a70, 0x66063bca, 0x11010b5c,
+    0x8f659eff, 0xf862ae69, 0x616bffd3, 0x166ccf45, 0xa00ae278,
+    0xd70dd2ee, 0x4e048354, 0x3903b3c2, 0xa7672661, 0xd06016f7,
+    0x4969474d, 0x3e6e77db, 0xaed16a4a, 0xd9d65adc, 0x40df0b66,
+    0x37d83bf0, 0xa9bcae53, 0xdebb9ec5, 0x47b2cf7f, 0x30b5ffe9,
+    0xbdbdf21c, 0xcabac28a, 0x53b39330, 0x24b4a3a6, 0xbad03605,
+    0xcdd70693, 0x54de5729, 0x23d967bf, 0xb3667a2e, 0xc4614ab8,
+    0x5d681b02, 0x2a6f2b94, 0xb40bbe37, 0xc30c8ea1, 0x5a05df1b,
+    0x2d02ef8d,
+};
+
+const char *zipfs_literal_tcl_library=NULL;
+
+/* Function prototypes */
+int TclZipfs_Mount(
+    Tcl_Interp *interp,
+    const char *mntpt,
+    const char *zipname,
+    const char *passwd
+);
+int TclZipfs_Mount_Buffer(
+    Tcl_Interp *interp,
+    const char *mntpt,
+    unsigned char *data,
+    size_t datalen,
+    int copy
+);
+static int TclZipfs_AppHook_FindTclInit(const char *archive);
+static int Zip_FSPathInFilesystemProc(Tcl_Obj *pathPtr, ClientData *clientDataPtr);
+static Tcl_Obj *Zip_FSFilesystemPathTypeProc(Tcl_Obj *pathPtr);
+static Tcl_Obj *Zip_FSFilesystemSeparatorProc(Tcl_Obj *pathPtr);
+static int Zip_FSStatProc(Tcl_Obj *pathPtr, Tcl_StatBuf *buf);
+static int Zip_FSAccessProc(Tcl_Obj *pathPtr, int mode);
+static Tcl_Channel Zip_FSOpenFileChannelProc(
+    Tcl_Interp *interp, Tcl_Obj *pathPtr,
+    int mode, int permissions
+);
+static int Zip_FSMatchInDirectoryProc(
+    Tcl_Interp* interp, Tcl_Obj *result,
+    Tcl_Obj *pathPtr, const char *pattern,
+    Tcl_GlobTypeData *types
+);
+static Tcl_Obj *Zip_FSListVolumesProc(void);
+static const char *const *Zip_FSFileAttrStringsProc(Tcl_Obj *pathPtr, Tcl_Obj** objPtrRef);
+static int Zip_FSFileAttrsGetProc(
+    Tcl_Interp *interp, int index, Tcl_Obj *pathPtr,
+    Tcl_Obj **objPtrRef
+);
+static int Zip_FSFileAttrsSetProc(Tcl_Interp *interp, int index, Tcl_Obj *pathPtr,Tcl_Obj *objPtr);
+static int Zip_FSLoadFile(Tcl_Interp *interp, Tcl_Obj *path, Tcl_LoadHandle *loadHandle,
+               Tcl_FSUnloadFileProc **unloadProcPtr, int flags);
+static void TclZipfs_C_Init(void);
+
+/*
+ * Define the ZIP filesystem dispatch table.
+ */
+
+MODULE_SCOPE const Tcl_Filesystem zipfsFilesystem;
+
+const Tcl_Filesystem zipfsFilesystem = {
+    "zipfs",
+    sizeof (Tcl_Filesystem),
+    TCL_FILESYSTEM_VERSION_2,
+    Zip_FSPathInFilesystemProc,
+    NULL, /* dupInternalRepProc */
+    NULL, /* freeInternalRepProc */
+    NULL, /* internalToNormalizedProc */
+    NULL, /* createInternalRepProc */
+    NULL, /* normalizePathProc */
+    Zip_FSFilesystemPathTypeProc,
+    Zip_FSFilesystemSeparatorProc,
+    Zip_FSStatProc,
+    Zip_FSAccessProc,
+    Zip_FSOpenFileChannelProc,
+    Zip_FSMatchInDirectoryProc,
+    NULL, /* utimeProc */
+    NULL, /* linkProc */
+    Zip_FSListVolumesProc,
+    Zip_FSFileAttrStringsProc,
+    Zip_FSFileAttrsGetProc,
+    Zip_FSFileAttrsSetProc,
+    NULL, /* createDirectoryProc */
+    NULL, /* removeDirectoryProc */
+    NULL, /* deleteFileProc */
+    NULL, /* copyFileProc */
+    NULL, /* renameFileProc */
+    NULL, /* copyDirectoryProc */
+    NULL, /* lstatProc */
+    (Tcl_FSLoadFileProc *) Zip_FSLoadFile,
+    NULL, /* getCwdProc */
+    NULL, /* chdirProc*/
+};
+
+
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ReadLock, WriteLock, Unlock --
+ *
+ *    POSIX like rwlock functions to support multiple readers
+ *    and single writer on internal structs.
+ *
+ *    Limitations:
+ *    - a read lock cannot be promoted to a write lock
+ *    - a write lock may not be nested
+ *
+ *-------------------------------------------------------------------------
+ */
+
+TCL_DECLARE_MUTEX(ZipFSMutex)
+
+#ifdef TCL_THREADS
+
+static Tcl_Condition ZipFSCond;
+
+static void
+ReadLock(void)
+{
+    Tcl_MutexLock(&ZipFSMutex);
+    while (ZipFS.lock < 0) {
+        ZipFS.waiters++;
+        Tcl_ConditionWait(&ZipFSCond, &ZipFSMutex, NULL);
+        ZipFS.waiters--;
+    }
+    ZipFS.lock++;
+    Tcl_MutexUnlock(&ZipFSMutex);
+}
+
+static void
+WriteLock(void)
+{
+    Tcl_MutexLock(&ZipFSMutex);
+    while (ZipFS.lock != 0) {
+        ZipFS.waiters++;
+        Tcl_ConditionWait(&ZipFSCond, &ZipFSMutex, NULL);
+        ZipFS.waiters--;
+    }
+    ZipFS.lock = -1;
+    Tcl_MutexUnlock(&ZipFSMutex);
+}
+
+static void
+Unlock(void)
+{
+    Tcl_MutexLock(&ZipFSMutex);
+    if (ZipFS.lock > 0) {
+        --ZipFS.lock;
+    } else if (ZipFS.lock < 0) {
+        ZipFS.lock = 0;
+    }
+    if ((ZipFS.lock == 0) && (ZipFS.waiters > 0)) {
+        Tcl_ConditionNotify(&ZipFSCond);
+    }
+    Tcl_MutexUnlock(&ZipFSMutex);
+}
+
+#else
+
+#define ReadLock()    do {} while (0)
+#define WriteLock()    do {} while (0)
+#define Unlock()    do {} while (0)
+
+#endif
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * DosTimeDate, ToDosTime, ToDosDate --
+ *
+ *    Functions to perform conversions between DOS time stamps
+ *    and POSIX time_t.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static time_t
+DosTimeDate(int dosDate, int dosTime)
+{
+    struct tm tm;
+    time_t ret;
+
+    memset(&tm, 0, sizeof (tm));
+    tm.tm_year = (((dosDate & 0xfe00) >> 9) + 80);
+    tm.tm_mon = ((dosDate & 0x1e0) >> 5) - 1;
+    tm.tm_mday = dosDate & 0x1f;
+    tm.tm_hour = (dosTime & 0xf800) >> 11;
+    tm.tm_min = (dosTime & 0x7e) >> 5;
+    tm.tm_sec = (dosTime & 0x1f) << 1;
+    ret = mktime(&tm);
+    if (ret == (time_t) -1) {
+        /* fallback to 1980-01-01T00:00:00+00:00 (DOS epoch) */
+        ret = (time_t) 315532800;
+    }
+    return ret;
+}
+
+static int
+ToDosTime(time_t when)
+{
+    struct tm *tmp, tm;
+
+#ifdef TCL_THREADS
+#ifdef _WIN32
+    /* Win32 uses thread local storage */
+    tmp = localtime(&when);
+    tm = *tmp;
+#else
+#ifdef HAVE_LOCALTIME_R
+    tmp = &tm;
+    localtime_r(&when, tmp);
+#else
+    Tcl_MutexLock(&localtimeMutex);
+    tmp = localtime(&when);
+    tm = *tmp;
+    Tcl_MutexUnlock(&localtimeMutex);
+#endif
+#endif
+#else
+    tmp = localtime(&when);
+    tm = *tmp;
+#endif
+    return (tm.tm_hour << 11) | (tm.tm_min << 5) | (tm.tm_sec >> 1);
+}
+
+static int
+ToDosDate(time_t when)
+{
+    struct tm *tmp, tm;
+
+#ifdef TCL_THREADS
+#ifdef _WIN32
+    /* Win32 uses thread local storage */
+    tmp = localtime(&when);
+    tm = *tmp;
+#else
+#ifdef HAVE_LOCALTIME_R
+    tmp = &tm;
+    localtime_r(&when, tmp);
+#else
+    Tcl_MutexLock(&localtimeMutex);
+    tmp = localtime(&when);
+    tm = *tmp;
+    Tcl_MutexUnlock(&localtimeMutex);
+#endif
+#endif
+#else
+    tmp = localtime(&when);
+    tm = *tmp;
+#endif
+    return ((tm.tm_year - 80) << 9) | ((tm.tm_mon + 1) << 5) | tm.tm_mday;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * CountSlashes --
+ *
+ *    This function counts the number of slashes in a pathname string.
+ *
+ * Results:
+ *    Number of slashes found in string.
+ *
+ * Side effects:
+ *    None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+CountSlashes(const char *string)
+{
+    int count = 0;
+    const char *p = string;
+
+    while (*p != '\0') {
+        if (*p == '/') {
+            count++;
+        }
+        p++;
+    }
+    return count;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * CanonicalPath --
+ *
+ *    This function computes the canonical path from a directory
+ *    and file name components into the specified Tcl_DString.
+ *
+ * Results:
+ *    Returns the pointer to the canonical path contained in the
+ *    specified Tcl_DString.
+ *
+ * Side effects:
+ *    Modifies the specified Tcl_DString.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static char *
+CanonicalPath(const char *root, const char *tail, Tcl_DString *dsPtr,int ZIPFSPATH)
+{
+    char *path;
+    char *result;
+    int i, j, c, isunc = 0, isvfs=0, n=0;
+#ifdef _WIN32
+    int zipfspath=1;
+    if (
+        (tail[0] != '\0')
+        && (strchr(drvletters, tail[0]) != NULL)
+        && (tail[1] == ':')
+    ) {
+        tail += 2;
+        zipfspath=0;
+    }
+    /* UNC style path */
+    if (tail[0] == '\\') {
+        root = "";
+        ++tail;
+        zipfspath=0;
+    }
+    if (tail[0] == '\\') {
+        root = "/";
+        ++tail;
+        zipfspath=0;
+    }
+    if(zipfspath) {
+#endif
+        /* UNC style path */
+        if(root && strncmp(root,ZIPFS_VOLUME,ZIPFS_VOLUME_LEN)==0) {
+            isvfs=1;
+        } else if (tail && strncmp(tail,ZIPFS_VOLUME,ZIPFS_VOLUME_LEN) == 0) {
+            isvfs=2;
+        }
+        if(isvfs!=1) {
+            if ((root[0] == '/') && (root[1] == '/')) {
+            isunc = 1;
+            }
+        }
+#ifdef _WIN32
+    }
+#endif
+    if(isvfs!=2) {
+        if (tail[0] == '/') {
+            if(isvfs!=1) {
+                root = "";
+            }
+            ++tail;
+            isunc = 0;
+        }
+        if (tail[0] == '/') {
+            if(isvfs!=1) {
+                root = "/";
+            }
+            ++tail;
+            isunc = 1;
+        }
+    }
+    i = strlen(root);
+    j = strlen(tail);
+    if(isvfs==1) {
+        if(i>ZIPFS_VOLUME_LEN) {
+            Tcl_DStringSetLength(dsPtr, i + j + 1);
+            path = Tcl_DStringValue(dsPtr);
+            memcpy(path, root, i);
+            path[i++] = '/';
+            memcpy(path + i, tail, j);
+        } else {
+            Tcl_DStringSetLength(dsPtr, i + j);
+            path = Tcl_DStringValue(dsPtr);
+            memcpy(path, root, i);
+            memcpy(path + i, tail, j);
+        }
+    } else if(isvfs==2) {
+        Tcl_DStringSetLength(dsPtr, j);
+        path = Tcl_DStringValue(dsPtr);
+        memcpy(path, tail, j);
+    } else {
+        if (ZIPFSPATH) {
+            Tcl_DStringSetLength(dsPtr, i + j + ZIPFS_VOLUME_LEN);
+            path = Tcl_DStringValue(dsPtr);
+            memcpy(path, ZIPFS_VOLUME, ZIPFS_VOLUME_LEN);
+            memcpy(path + ZIPFS_VOLUME_LEN + i , tail, j);
+        } else {
+            Tcl_DStringSetLength(dsPtr, i + j + 1);
+            path = Tcl_DStringValue(dsPtr);
+            memcpy(path, root, i);
+            path[i++] = '/';
+            memcpy(path + i, tail, j);
+        }
+    }
+#ifdef _WIN32
+    for (i = 0; path[i] != '\0'; i++) {
+        if (path[i] == '\\') {
+            path[i] = '/';
+        }
+    }
+#endif
+    if(ZIPFSPATH) {
+        n=ZIPFS_VOLUME_LEN;
+    } else {
+        n=0;
+    }
+    for (i = j = n; (c = path[i]) != '\0'; i++) {
+        if (c == '/') {
+            int c2 = path[i + 1];
+            if (c2 == '/') {
+                continue;
+            }
+            if (c2 == '.') {
+                int c3 = path[i + 2];
+                if ((c3 == '/') || (c3 == '\0')) {
+                    i++;
+                    continue;
+                }
+                if (
+                    (c3 == '.')
+                    && ((path[i + 3] == '/') || (path [i + 3] == '\0'))
+                ) {
+                    i += 2;
+                    while ((j > 0) && (path[j - 1] != '/')) {
+                        j--;
+                    }
+                    if (j > isunc) {
+                        --j;
+                        while ((j > 1 + isunc) && (path[j - 2] == '/')) {
+                            j--;
+                        }
+                    }
+                    continue;
+                }
+            }
+        }
+        path[j++] = c;
+    }
+    if (j == 0) {
+        path[j++] = '/';
+    }
+    path[j] = 0;
+    Tcl_DStringSetLength(dsPtr, j);
+    result=Tcl_DStringValue(dsPtr);
+    return result;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipFSLookup --
+ *
+ *    This function returns the ZIP entry struct corresponding to
+ *    the ZIP archive member of the given file name.
+ *
+ * Results:
+ *    Returns the pointer to ZIP entry struct or NULL if the
+ *    the given file name could not be found in the global list
+ *    of ZIP archive members.
+ *
+ * Side effects:
+ *    None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static ZipEntry *
+ZipFSLookup(char *filename)
+{
+    Tcl_HashEntry *hPtr;
+    ZipEntry *z;
+    Tcl_DString ds;
+    Tcl_DStringInit(&ds);
+    hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, filename);
+    z = hPtr ? (ZipEntry *) Tcl_GetHashValue(hPtr) : NULL;
+    Tcl_DStringFree(&ds);
+    return z;
+}
+
+#ifdef NEVER_USED
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipFSLookupMount --
+ *
+ *    This function returns an indication if the given file name
+ *    corresponds to a mounted ZIP archive file.
+ *
+ * Results:
+ *    Returns true, if the given file name is a mounted ZIP archive file.
+ *
+ * Side effects:
+ *    None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipFSLookupMount(char *filename)
+{
+    Tcl_HashEntry *hPtr;
+    Tcl_HashSearch search;
+    ZipFile *zf;
+    int match = 0;
+    hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search);
+    while (hPtr != NULL) {
+        if ((zf = (ZipFile *) Tcl_GetHashValue(hPtr)) == NULL) continue;
+        if (strcmp(zf->mntpt, filename) == 0) {
+            match = 1;
+            break;
+        }
+        hPtr = Tcl_NextHashEntry(&search);
+    }
+    return match;
+}
+#endif
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipFSCloseArchive --
+ *
+ *    This function closes a mounted ZIP archive file.
+ *
+ * Results:
+ *    None.
+ *
+ * Side effects:
+ *    A memory mapped ZIP archive is unmapped, allocated memory is
+ *    released.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static void
+ZipFSCloseArchive(Tcl_Interp *interp, ZipFile *zf)
+{
+    if(zf->namelen) {
+        free(zf->name); //Allocated by strdup
+    }
+    if(zf->is_membuf==1) {
+        /* Pointer to memory */
+        if (zf->tofree != NULL) {
+            Tcl_Free(zf->tofree);
+            zf->tofree = NULL;
+        }
+        zf->data = NULL;
+        return;
+    }
+#ifdef _WIN32
+    if ((zf->data != NULL) && (zf->tofree == NULL)) {
+        UnmapViewOfFile(zf->data);
+        zf->data = NULL;
+    }
+    if (zf->mh != INVALID_HANDLE_VALUE) {
+        CloseHandle(zf->mh);
+    }
+#else
+    if ((zf->data != MAP_FAILED) && (zf->tofree == NULL)) {
+        munmap(zf->data, zf->length);
+        zf->data = MAP_FAILED;
+    }
+#endif
+    if (zf->tofree != NULL) {
+        Tcl_Free(zf->tofree);
+        zf->tofree = NULL;
+    }
+    if(zf->chan != NULL) {
+        Tcl_Close(interp, zf->chan);
+        zf->chan = NULL;
+    }
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipFS_Find_TOC --
+ *
+ *   This function takes a memory mapped zip file and indexes the contents.
+ *   When "needZip" is zero an embedded ZIP archive in an executable file is accepted.
+ *
+ * Results:
+ *    TCL_OK on success, TCL_ERROR otherwise with an error message
+ *    placed into the given "interp" if it is not NULL.
+ *
+ * Side effects:
+ *    The given ZipFile struct is filled with information about the ZIP archive file.
+ *
+ *-------------------------------------------------------------------------
+ */
+static int
+ZipFS_Find_TOC(Tcl_Interp *interp, int needZip, ZipFile *zf)
+{
+    size_t i;
+    unsigned char *p, *q;
+    p = zf->data + zf->length - ZIP_CENTRAL_END_LEN;
+    while (p >= zf->data) {
+        if (*p == (ZIP_CENTRAL_END_SIG & 0xFF)) {
+            if (zip_read_int(p) == ZIP_CENTRAL_END_SIG) {
+            break;
+            }
+            p -= ZIP_SIG_LEN;
+        } else {
+            --p;
+        }
+    }
+    if (p < zf->data) {
+        if (!needZip) {
+            zf->baseoffs = zf->baseoffsp = zf->length;
+            return TCL_OK;
+        }
+        ZIPFS_ERROR(interp,"wrong end signature");
+        goto error;
+    }
+    zf->nfiles = zip_read_short(p + ZIP_CENTRAL_ENTS_OFFS);
+    if (zf->nfiles == 0) {
+        if (!needZip) {
+            zf->baseoffs = zf->baseoffsp = zf->length;
+            return TCL_OK;
+        }
+        ZIPFS_ERROR(interp,"empty archive");
+        goto error;
+    }
+    q = zf->data + zip_read_int(p + ZIP_CENTRAL_DIRSTART_OFFS);
+    p -= zip_read_int(p + ZIP_CENTRAL_DIRSIZE_OFFS);
+    if (
+        (p < zf->data) || (p > (zf->data + zf->length)) ||
+        (q < zf->data) || (q > (zf->data + zf->length))
+    ) {
+        if (!needZip) {
+            zf->baseoffs = zf->baseoffsp = zf->length;
+            return TCL_OK;
+        }
+        ZIPFS_ERROR(interp,"archive directory not found");
+        goto error;
+    }
+    zf->baseoffs = zf->baseoffsp = p - q;
+    zf->centoffs = p - zf->data;
+    q = p;
+    for (i = 0; i < zf->nfiles; i++) {
+        int pathlen, comlen, extra;
+
+        if ((q + ZIP_CENTRAL_HEADER_LEN) > (zf->data + zf->length)) {
+            ZIPFS_ERROR(interp,"wrong header length");
+            goto error;
+        }
+        if (zip_read_int(q) != ZIP_CENTRAL_HEADER_SIG) {
+            ZIPFS_ERROR(interp,"wrong header signature");
+            goto error;
+        }
+        pathlen = zip_read_short(q + ZIP_CENTRAL_PATHLEN_OFFS);
+        comlen = zip_read_short(q + ZIP_CENTRAL_FCOMMENTLEN_OFFS);
+        extra = zip_read_short(q + ZIP_CENTRAL_EXTRALEN_OFFS);
+        q += pathlen + comlen + extra + ZIP_CENTRAL_HEADER_LEN;
+    }
+    q = zf->data + zf->baseoffs;
+    if ((zf->baseoffs >= 6) && (zip_read_int(q - 4) == ZIP_PASSWORD_END_SIG)) {
+        i = q[-5];
+        if (q - 5 - i > zf->data) {
+            zf->pwbuf[0] = i;
+            memcpy(zf->pwbuf + 1, q - 5 - i, i);
+            zf->baseoffsp -= i ? (5 + i) : 0;
+        }
+    }
+
+    return TCL_OK;
+
+error:
+    ZipFSCloseArchive(interp, zf);
+    return TCL_ERROR;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipFSOpenArchive --
+ *
+ *    This function opens a ZIP archive file for reading. An attempt
+ *    is made to memory map that file. Otherwise it is read into
+ *    an allocated memory buffer. The ZIP archive header is verified
+ *    and must be valid for the function to succeed. When "needZip"
+ *    is zero an embedded ZIP archive in an executable file is accepted.
+ *
+ * Results:
+ *    TCL_OK on success, TCL_ERROR otherwise with an error message
+ *    placed into the given "interp" if it is not NULL.
+ *
+ * Side effects:
+ *    ZIP archive is memory mapped or read into allocated memory,
+ *    the given ZipFile struct is filled with information about
+ *    the ZIP archive file.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipFSOpenArchive(Tcl_Interp *interp, const char *zipname, int needZip, ZipFile *zf)
+{
+    size_t i;
+    ClientData handle;
+    zf->namelen=0;
+    zf->is_membuf=0;
+#ifdef _WIN32
+    zf->data = NULL;
+    zf->mh = INVALID_HANDLE_VALUE;
+#else
+    zf->data = MAP_FAILED;
+#endif
+    zf->length = 0;
+    zf->nfiles = 0;
+    zf->baseoffs = zf->baseoffsp = 0;
+    zf->tofree = NULL;
+    zf->pwbuf[0] = 0;
+    zf->chan = Tcl_OpenFileChannel(interp, zipname, "r", 0);
+    if (zf->chan == NULL) {
+        return TCL_ERROR;
+    }
+    if (Tcl_GetChannelHandle(zf->chan, TCL_READABLE, &handle) != TCL_OK) {
+        if (Tcl_SetChannelOption(interp, zf->chan, "-translation", "binary") != TCL_OK) {
+            goto error;
+        }
+        if (Tcl_SetChannelOption(interp, zf->chan, "-encoding", "binary") != TCL_OK) {
+            goto error;
+        }
+        zf->length = Tcl_Seek(zf->chan, 0, SEEK_END);
+        if ((zf->length - ZIP_CENTRAL_END_LEN) > (64 * 1024 * 1024 - ZIP_CENTRAL_END_LEN)) {
+            ZIPFS_ERROR(interp,"illegal file size");
+            goto error;
+        }
+        Tcl_Seek(zf->chan, 0, SEEK_SET);
+        zf->tofree = zf->data = (unsigned char *) Tcl_AttemptAlloc(zf->length);
+        if (zf->tofree == NULL) {
+            ZIPFS_ERROR(interp,"out of memory")
+            goto error;
+        }
+        i = Tcl_Read(zf->chan, (char *) zf->data, zf->length);
+        if (i != zf->length) {
+            ZIPFS_ERROR(interp,"file read error");
+            goto error;
+        }
+        Tcl_Close(interp, zf->chan);
+        zf->chan = NULL;
+    } else {
+#ifdef _WIN32
+#   ifdef _WIN64
+        i = GetFileSizeEx((HANDLE) handle, (PLARGE_INTEGER)&zf->length);
+        if (
+            (i == 0) ||
+#   else
+        zf->length = GetFileSize((HANDLE) handle, 0);
+        if (
+            (zf->length == (size_t)INVALID_FILE_SIZE) ||
+#   endif
+            (zf->length < ZIP_CENTRAL_END_LEN)
+        ) {
+            ZIPFS_ERROR(interp,"invalid file size");
+            goto error;
+        }
+        zf->mh = CreateFileMapping((HANDLE) handle, 0, PAGE_READONLY, 0,
+                       zf->length, 0);
+        if (zf->mh == INVALID_HANDLE_VALUE) {
+            ZIPFS_ERROR(interp,"file mapping failed");
+            goto error;
+        }
+        zf->data = MapViewOfFile(zf->mh, FILE_MAP_READ, 0, 0, zf->length);
+        if (zf->data == NULL) {
+            ZIPFS_ERROR(interp,"file mapping failed");
+            goto error;
+        }
+#else
+        zf->length = lseek(PTR2INT(handle), 0, SEEK_END);
+        if ((zf->length == (size_t)-1) || (zf->length < ZIP_CENTRAL_END_LEN)) {
+            ZIPFS_ERROR(interp,"invalid file size");
+            goto error;
+        }
+        lseek(PTR2INT(handle), 0, SEEK_SET);
+        zf->data = (unsigned char *) mmap(0, zf->length, PROT_READ,
+                          MAP_FILE | MAP_PRIVATE,
+						  PTR2INT(handle), 0);
+        if (zf->data == MAP_FAILED) {
+            ZIPFS_ERROR(interp,"file mapping failed");
+            goto error;
+        }
+#endif
+    }
+    return ZipFS_Find_TOC(interp,needZip,zf);
+
+error:
+    ZipFSCloseArchive(interp, zf);
+    return TCL_ERROR;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipFSRootNode --
+ *
+ *    This function generates the root node for a ZIPFS filesystem
+ *
+ * Results:
+ *    TCL_OK on success, TCL_ERROR otherwise with an error message
+ *    placed into the given "interp" if it is not NULL.
+ *
+ * Side effects:
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipFS_Catalogue_Filesystem(Tcl_Interp *interp, ZipFile *zf0, const char *mntpt, const char *passwd, const char *zipname)
+{
+    int pwlen, isNew;
+    size_t i;
+    ZipFile *zf;
+    ZipEntry *z;
+    Tcl_HashEntry *hPtr;
+    Tcl_DString ds, dsm, fpBuf;
+    unsigned char *q;
+    WriteLock();
+
+    pwlen = 0;
+    if (passwd != NULL) {
+        pwlen = strlen(passwd);
+        if ((pwlen > 255) || (strchr(passwd, 0xff) != NULL)) {
+            if (interp) {
+            Tcl_SetObjResult(interp,
+                Tcl_NewStringObj("illegal password", -1));
+            }
+            return TCL_ERROR;
+        }
+    }
+    /*
+     * Mount point sometimes is a relative or otherwise denormalized path.
+     * But an absolute name is needed as mount point here.
+     */
+    Tcl_DStringInit(&ds);
+    Tcl_DStringInit(&dsm);
+    if (strcmp(mntpt, "/") == 0) {
+        mntpt = "";
+    } else {
+        mntpt = CanonicalPath("",mntpt, &dsm, 1);
+    }
+    hPtr = Tcl_CreateHashEntry(&ZipFS.zipHash, mntpt, &isNew);
+    if (!isNew) {
+        zf = (ZipFile *) Tcl_GetHashValue(hPtr);
+        if (interp != NULL) {
+            Tcl_AppendResult(interp, zf->name, " is already mounted on ", mntpt, (char *) NULL);
+        }
+        Unlock();
+        ZipFSCloseArchive(interp, zf0);
+        return TCL_ERROR;
+    }
+    zf = (ZipFile *) Tcl_AttemptAlloc(sizeof (*zf) + strlen(mntpt) + 1);
+    if (zf == NULL) {
+        if (interp != NULL) {
+            Tcl_AppendResult(interp, "out of memory", (char *) NULL);
+        }
+        Unlock();
+        ZipFSCloseArchive(interp, zf0);
+        return TCL_ERROR;
+    }
+    Unlock();
+    *zf = *zf0;
+    zf->mntpt = Tcl_GetHashKey(&ZipFS.zipHash, hPtr);
+    zf->mntptlen=strlen(zf->mntpt);
+    zf->name = strdup(zipname);
+    zf->namelen= strlen(zipname);
+    zf->entries = NULL;
+    zf->topents = NULL;
+    zf->nopen = 0;
+    Tcl_SetHashValue(hPtr, (ClientData) zf);
+    if ((zf->pwbuf[0] == 0) && pwlen) {
+        int k = 0;
+        i = pwlen;
+        zf->pwbuf[k++] = i;
+        while (i > 0) {
+            zf->pwbuf[k] = (passwd[i - 1] & 0x0f) |
+            pwrot[(passwd[i - 1] >> 4) & 0x0f];
+            k++;
+            i--;
+        }
+        zf->pwbuf[k] = '\0';
+    }
+    if (mntpt[0] != '\0') {
+        z = (ZipEntry *) Tcl_Alloc(sizeof (*z));
+        z->name = NULL;
+        z->tnext = NULL;
+        z->depth = CountSlashes(mntpt);
+        z->zipfile = zf;
+        z->isdir = (zf->baseoffs == 0) ? 1 : -1; /* root marker */
+        z->isenc = 0;
+        z->offset = zf->baseoffs;
+        z->crc32 = 0;
+        z->timestamp = 0;
+        z->nbyte = z->nbytecompr = 0;
+        z->cmeth = ZIP_COMPMETH_STORED;
+        z->data = NULL;
+        hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, mntpt, &isNew);
+        if (!isNew) {
+            /* skip it */
+            Tcl_Free((char *) z);
+        } else {
+            Tcl_SetHashValue(hPtr, (ClientData) z);
+            z->name = Tcl_GetHashKey(&ZipFS.fileHash, hPtr);
+            z->next = zf->entries;
+            zf->entries = z;
+        }
+    }
+    q = zf->data + zf->centoffs;
+    Tcl_DStringInit(&fpBuf);
+    for (i = 0; i < zf->nfiles; i++) {
+        int extra, isdir = 0, dosTime, dosDate, nbcompr;
+        size_t offs, pathlen, comlen;
+        unsigned char *lq, *gq = NULL;
+        char *fullpath, *path;
+
+        pathlen = zip_read_short(q + ZIP_CENTRAL_PATHLEN_OFFS);
+        comlen = zip_read_short(q + ZIP_CENTRAL_FCOMMENTLEN_OFFS);
+        extra = zip_read_short(q + ZIP_CENTRAL_EXTRALEN_OFFS);
+        Tcl_DStringSetLength(&ds, 0);
+        Tcl_DStringAppend(&ds, (char *) q + ZIP_CENTRAL_HEADER_LEN, pathlen);
+        path = Tcl_DStringValue(&ds);
+        if ((pathlen > 0) && (path[pathlen - 1] == '/')) {
+            Tcl_DStringSetLength(&ds, pathlen - 1);
+            path = Tcl_DStringValue(&ds);
+            isdir = 1;
+        }
+        if ((strcmp(path, ".") == 0) || (strcmp(path, "..") == 0)) {
+            goto nextent;
+        }
+        lq = zf->data + zf->baseoffs + zip_read_int(q + ZIP_CENTRAL_LOCALHDR_OFFS);
+        if ((lq < zf->data) || (lq > (zf->data + zf->length))) {
+            goto nextent;
+        }
+        nbcompr = zip_read_int(lq + ZIP_LOCAL_COMPLEN_OFFS);
+        if (
+            !isdir && (nbcompr == 0)
+            && (zip_read_int(lq + ZIP_LOCAL_UNCOMPLEN_OFFS) == 0)
+            && (zip_read_int(lq + ZIP_LOCAL_CRC32_OFFS) == 0)
+        ) {
+            gq = q;
+            nbcompr = zip_read_int(gq + ZIP_CENTRAL_COMPLEN_OFFS);
+        }
+        offs = (lq - zf->data)
+            + ZIP_LOCAL_HEADER_LEN
+            + zip_read_short(lq + ZIP_LOCAL_PATHLEN_OFFS)
+            + zip_read_short(lq + ZIP_LOCAL_EXTRALEN_OFFS);
+        if ((offs + nbcompr) > zf->length) {
+            goto nextent;
+        }
+        if (!isdir && (mntpt[0] == '\0') && !CountSlashes(path)) {
+#ifdef ANDROID
+            /*
+             * When mounting the ZIP archive on the root directory try
+             * to remap top level regular files of the archive to
+             * /assets/.root/... since this directory should not be
+             * in a valid APK due to the leading dot in the file name
+             * component. This trick should make the files
+             * AndroidManifest.xml, resources.arsc, and classes.dex
+             * visible to Tcl.
+             */
+            Tcl_DString ds2;
+
+            Tcl_DStringInit(&ds2);
+            Tcl_DStringAppend(&ds2, "assets/.root/", -1);
+            Tcl_DStringAppend(&ds2, path, -1);
+            hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, Tcl_DStringValue(&ds2));
+            if (hPtr != NULL) {
+                /* should not happen but skip it anyway */
+                Tcl_DStringFree(&ds2);
+                goto nextent;
+            }
+            Tcl_DStringSetLength(&ds, 0);
+            Tcl_DStringAppend(&ds, Tcl_DStringValue(&ds2), Tcl_DStringLength(&ds2));
+            path = Tcl_DStringValue(&ds);
+            Tcl_DStringFree(&ds2);
+#else
+            /*
+             * Regular files skipped when mounting on root.
+             */
+            goto nextent;
+#endif
+        }
+        Tcl_DStringSetLength(&fpBuf, 0);
+        fullpath = CanonicalPath(mntpt, path, &fpBuf, 1);
+        z = (ZipEntry *) Tcl_Alloc(sizeof (*z));
+        z->name = NULL;
+        z->tnext = NULL;
+        z->depth = CountSlashes(fullpath);
+        z->zipfile = zf;
+        z->isdir = isdir;
+        z->isenc = (zip_read_short(lq + ZIP_LOCAL_FLAGS_OFFS) & 1) && (nbcompr > 12);
+        z->offset = offs;
+        if (gq != NULL) {
+            z->crc32 = zip_read_int(gq + ZIP_CENTRAL_CRC32_OFFS);
+            dosDate = zip_read_short(gq + ZIP_CENTRAL_MDATE_OFFS);
+            dosTime = zip_read_short(gq + ZIP_CENTRAL_MTIME_OFFS);
+            z->timestamp = DosTimeDate(dosDate, dosTime);
+            z->nbyte = zip_read_int(gq + ZIP_CENTRAL_UNCOMPLEN_OFFS);
+            z->cmeth = zip_read_short(gq + ZIP_CENTRAL_COMPMETH_OFFS);
+        } else {
+            z->crc32 = zip_read_int(lq + ZIP_LOCAL_CRC32_OFFS);
+            dosDate = zip_read_short(lq + ZIP_LOCAL_MDATE_OFFS);
+            dosTime = zip_read_short(lq + ZIP_LOCAL_MTIME_OFFS);
+            z->timestamp = DosTimeDate(dosDate, dosTime);
+            z->nbyte = zip_read_int(lq + ZIP_LOCAL_UNCOMPLEN_OFFS);
+            z->cmeth = zip_read_short(lq + ZIP_LOCAL_COMPMETH_OFFS);
+        }
+        z->nbytecompr = nbcompr;
+        z->data = NULL;
+        hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, fullpath, &isNew);
+        if (!isNew) {
+            /* should not happen but skip it anyway */
+            Tcl_Free((char *) z);
+        } else {
+            Tcl_SetHashValue(hPtr, (ClientData) z);
+            z->name = Tcl_GetHashKey(&ZipFS.fileHash, hPtr);
+            z->next = zf->entries;
+            zf->entries = z;
+            if (isdir && (mntpt[0] == '\0') && (z->depth == 1)) {
+                z->tnext = zf->topents;
+                zf->topents = z;
+            }
+            if (!z->isdir && (z->depth > 1)) {
+                char *dir, *end;
+                ZipEntry *zd;
+
+                Tcl_DStringSetLength(&ds, strlen(z->name) + 8);
+                Tcl_DStringSetLength(&ds, 0);
+                Tcl_DStringAppend(&ds, z->name, -1);
+                dir = Tcl_DStringValue(&ds);
+                end = strrchr(dir, '/');
+                while ((end != NULL) && (end != dir)) {
+                    Tcl_DStringSetLength(&ds, end - dir);
+                    hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, dir);
+                    if (hPtr != NULL) {
+                        break;
+                    }
+                    zd = (ZipEntry *) Tcl_Alloc(sizeof (*zd));
+                    zd->name = NULL;
+                    zd->tnext = NULL;
+                    zd->depth = CountSlashes(dir);
+                    zd->zipfile = zf;
+                    zd->isdir = 1;
+                    zd->isenc = 0;
+                    zd->offset = z->offset;
+                    zd->crc32 = 0;
+                    zd->timestamp = z->timestamp;
+                    zd->nbyte = zd->nbytecompr = 0;
+                    zd->cmeth = ZIP_COMPMETH_STORED;
+                    zd->data = NULL;
+                    hPtr = Tcl_CreateHashEntry(&ZipFS.fileHash, dir, &isNew);
+                    if (!isNew) {
+                        /* should not happen but skip it anyway */
+                        Tcl_Free((char *) zd);
+                    } else {
+                        Tcl_SetHashValue(hPtr, (ClientData) zd);
+                        zd->name = Tcl_GetHashKey(&ZipFS.fileHash, hPtr);
+                        zd->next = zf->entries;
+                        zf->entries = zd;
+                        if ((mntpt[0] == '\0') && (zd->depth == 1)) {
+                            zd->tnext = zf->topents;
+                            zf->topents = zd;
+                        }
+                    }
+                    end = strrchr(dir, '/');
+                }
+            }
+        }
+nextent:
+        q += pathlen + comlen + extra + ZIP_CENTRAL_HEADER_LEN;
+    }
+    Tcl_DStringFree(&fpBuf);
+    Tcl_DStringFree(&ds);
+    Tcl_FSMountsChanged(NULL);
+    Unlock();
+    return TCL_OK;
+}
+
+static void TclZipfs_C_Init(void) {
+    static const Tcl_Time t = { 0, 0 };
+    if (!ZipFS.initialized) {
+#ifdef TCL_THREADS
+        /*
+         * Inflate condition variable.
+         */
+        Tcl_MutexLock(&ZipFSMutex);
+        Tcl_ConditionWait(&ZipFSCond, &ZipFSMutex, &t);
+        Tcl_MutexUnlock(&ZipFSMutex);
+#endif
+        Tcl_FSRegister(NULL, &zipfsFilesystem);
+        Tcl_InitHashTable(&ZipFS.fileHash, TCL_STRING_KEYS);
+        Tcl_InitHashTable(&ZipFS.zipHash, TCL_STRING_KEYS);
+        ZipFS.initialized = ZipFS.idCount = 1;
+    }
+}
+
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * TclZipfs_Mount --
+ *
+ *      This procedure is invoked to mount a given ZIP archive file on
+ *    a given mountpoint with optional ZIP password.
+ *
+ * Results:
+ *      A standard Tcl result.
+ *
+ * Side effects:
+ *      A ZIP archive file is read, analyzed and mounted, resources are
+ *    allocated.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+int
+TclZipfs_Mount(
+    Tcl_Interp *interp,
+    const char *mntpt,
+    const char *zipname,
+    const char *passwd
+) {
+    int i, pwlen;
+    ZipFile *zf;
+
+    ReadLock();
+    if (!ZipFS.initialized) {
+        TclZipfs_C_Init();
+    }
+    if (mntpt == NULL) {
+        Tcl_HashEntry *hPtr;
+        Tcl_HashSearch search;
+        int ret = TCL_OK;
+        i = 0;
+        hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search);
+        while (hPtr != NULL) {
+            if ((zf = (ZipFile *) Tcl_GetHashValue(hPtr)) != NULL) {
+                if (interp != NULL) {
+                    Tcl_AppendElement(interp, zf->mntpt);
+                    Tcl_AppendElement(interp, zf->name);
+                }
+                ++i;
+            }
+            hPtr = Tcl_NextHashEntry(&search);
+        }
+        if (interp == NULL) {
+            ret = (i > 0) ? TCL_OK : TCL_BREAK;
+        }
+        Unlock();
+        return ret;
+    }
+
+    if (zipname == NULL) {
+        Tcl_HashEntry *hPtr;
+        if (interp == NULL) {
+            Unlock();
+            return TCL_OK;
+        }
+        hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, mntpt);
+        if (hPtr != NULL) {
+            if ((zf = Tcl_GetHashValue(hPtr)) != NULL) {
+                Tcl_SetObjResult(interp,Tcl_NewStringObj(zf->name, -1));
+            }
+        }
+        Unlock();
+        return TCL_OK;
+    }
+    Unlock();
+    pwlen = 0;
+    if (passwd != NULL) {
+        pwlen = strlen(passwd);
+        if ((pwlen > 255) || (strchr(passwd, 0xff) != NULL)) {
+            if (interp) {
+            Tcl_SetObjResult(interp,
+                Tcl_NewStringObj("illegal password", -1));
+            }
+            return TCL_ERROR;
+        }
+    }
+    zf = (ZipFile *) Tcl_AttemptAlloc(sizeof (*zf) + strlen(mntpt) + 1);
+    if (zf == NULL) {
+        if (interp != NULL) {
+            Tcl_AppendResult(interp, "out of memory", (char *) NULL);
+        }
+        return TCL_ERROR;
+    }
+    if (ZipFSOpenArchive(interp, zipname, 1, zf) != TCL_OK) {
+        return TCL_ERROR;
+    }
+    return ZipFS_Catalogue_Filesystem(interp,zf,mntpt,passwd,zipname);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * TclZipfs_Mount_Buffer --
+ *
+ *      This procedure is invoked to mount a given ZIP archive file on
+ *    a given mountpoint with optional ZIP password.
+ *
+ * Results:
+ *      A standard Tcl result.
+ *
+ * Side effects:
+ *      A ZIP archive file is read, analyzed and mounted, resources are
+ *    allocated.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+int
+TclZipfs_Mount_Buffer(
+    Tcl_Interp *interp,
+    const char *mntpt,
+    unsigned char *data,
+    size_t datalen,
+    int copy
+) {
+    int i;
+    ZipFile *zf;
+
+    ReadLock();
+    if (!ZipFS.initialized) {
+        TclZipfs_C_Init();
+    }
+    if (mntpt == NULL) {
+        Tcl_HashEntry *hPtr;
+        Tcl_HashSearch search;
+        int ret = TCL_OK;
+
+        i = 0;
+        hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search);
+        while (hPtr != NULL) {
+            if ((zf = (ZipFile *) Tcl_GetHashValue(hPtr)) != NULL) {
+                if (interp != NULL) {
+                    Tcl_AppendElement(interp, zf->mntpt);
+                    Tcl_AppendElement(interp, zf->name);
+                }
+                ++i;
+            }
+            hPtr = Tcl_NextHashEntry(&search);
+        }
+        if (interp == NULL) {
+            ret = (i > 0) ? TCL_OK : TCL_BREAK;
+        }
+        Unlock();
+        return ret;
+    }
+
+    if (data == NULL) {
+        Tcl_HashEntry *hPtr;
+
+        if (interp == NULL) {
+            Unlock();
+            return TCL_OK;
+        }
+        hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, mntpt);
+        if (hPtr != NULL) {
+            if ((zf = Tcl_GetHashValue(hPtr)) != NULL) {
+                Tcl_SetObjResult(interp,Tcl_NewStringObj(zf->name, -1));
+            }
+        }
+        Unlock();
+        return TCL_OK;
+    }
+    Unlock();
+    zf = (ZipFile *) Tcl_AttemptAlloc(sizeof (*zf) + strlen(mntpt) + 1);
+    if (zf == NULL) {
+        if (interp != NULL) {
+            Tcl_AppendResult(interp, "out of memory", (char *) NULL);
+        }
+        return TCL_ERROR;
+    }
+    zf->is_membuf=1;
+    zf->length=datalen;
+    if(copy) {
+        zf->data=(unsigned char *)Tcl_AttemptAlloc(datalen);
+        if (zf->data == NULL) {
+            if (interp != NULL) {
+                Tcl_AppendResult(interp, "out of memory", (char *) NULL);
+            }
+            return TCL_ERROR;
+        }
+        memcpy(zf->data,data,datalen);
+        zf->tofree=zf->data;
+    } else {
+        zf->data=data;
+        zf->tofree=NULL;
+    }
+    if(ZipFS_Find_TOC(interp,0,zf)!=TCL_OK) {
+        return TCL_ERROR;
+    }
+    return ZipFS_Catalogue_Filesystem(interp,zf,mntpt,NULL,"Memory Buffer");
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * TclZipfs_Unmount --
+ *
+ *      This procedure is invoked to unmount a given ZIP archive.
+ *
+ * Results:
+ *      A standard Tcl result.
+ *
+ * Side effects:
+ *      A mounted ZIP archive file is unmounted, resources are free'd.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+int
+TclZipfs_Unmount(Tcl_Interp *interp, const char *mntpt)
+{
+    ZipFile *zf;
+    ZipEntry *z, *znext;
+    Tcl_HashEntry *hPtr;
+    Tcl_DString dsm;
+    int ret = TCL_OK, unmounted = 0;
+
+    WriteLock();
+    if (!ZipFS.initialized) goto done;
+    /*
+     * Mount point sometimes is a relative or otherwise denormalized path.
+     * But an absolute name is needed as mount point here.
+     */
+    Tcl_DStringInit(&dsm);
+    mntpt = CanonicalPath("", mntpt, &dsm, 1);
+
+    hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, mntpt);
+
+    /* don't report error */
+    if (hPtr == NULL) goto done;
+
+    zf = (ZipFile *) Tcl_GetHashValue(hPtr);
+    if (zf->nopen > 0) {
+        ZIPFS_ERROR(interp,"filesystem is busy");
+        ret = TCL_ERROR;
+        goto done;
+    }
+    Tcl_DeleteHashEntry(hPtr);
+    for (z = zf->entries; z; z = znext) {
+        znext = z->next;
+        hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, z->name);
+        if (hPtr) {
+            Tcl_DeleteHashEntry(hPtr);
+        }
+        if (z->data != NULL) {
+            Tcl_Free((char *) z->data);
+        }
+        Tcl_Free((char *) z);
+    }
+    ZipFSCloseArchive(interp, zf);
+    Tcl_Free((char *) zf);
+    unmounted = 1;
+done:
+    Unlock();
+    if (unmounted) {
+        Tcl_FSMountsChanged(NULL);
+    }
+    return ret;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipFSMountObjCmd --
+ *
+ *      This procedure is invoked to process the "zipfs::mount" command.
+ *
+ * Results:
+ *      A standard Tcl result.
+ *
+ * Side effects:
+ *      A ZIP archive file is mounted, resources are allocated.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipFSMountObjCmd(
+    ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]
+) {
+    if (objc > 4) {
+        Tcl_WrongNumArgs(interp, 1, objv,
+                 "?mountpoint? ?zipfile? ?password?");
+        return TCL_ERROR;
+    }
+    return TclZipfs_Mount(interp, (objc > 1) ? Tcl_GetString(objv[1]) : NULL,
+               (objc > 2) ? Tcl_GetString(objv[2]) : NULL,
+               (objc > 3) ? Tcl_GetString(objv[3]) : NULL);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipFSMountObjCmd --
+ *
+ *      This procedure is invoked to process the "zipfs::mount" command.
+ *
+ * Results:
+ *      A standard Tcl result.
+ *
+ * Side effects:
+ *      A ZIP archive file is mounted, resources are allocated.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipFSMountBufferObjCmd(
+    ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]
+) {
+    const char *mntpt;
+    unsigned char *data;
+    int length;
+    if (objc > 4) {
+        Tcl_WrongNumArgs(interp, 1, objv, "?mountpoint? ?data?");
+        return TCL_ERROR;
+    }
+    if(objc<2) {
+        int i;
+        Tcl_HashEntry *hPtr;
+        Tcl_HashSearch search;
+        int ret = TCL_OK;
+        ZipFile *zf;
+
+        ReadLock();
+        i = 0;
+        hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search);
+        while (hPtr != NULL) {
+            if ((zf = (ZipFile *) Tcl_GetHashValue(hPtr)) != NULL) {
+                if (interp != NULL) {
+                    Tcl_AppendElement(interp, zf->mntpt);
+                    Tcl_AppendElement(interp, zf->name);
+                }
+                ++i;
+            }
+            hPtr = Tcl_NextHashEntry(&search);
+        }
+        if (interp == NULL) {
+            ret = (i > 0) ? TCL_OK : TCL_BREAK;
+        }
+        Unlock();
+        return ret;
+    }
+    mntpt=Tcl_GetString(objv[1]);
+    if(objc<3) {
+        Tcl_HashEntry *hPtr;
+        ZipFile *zf;
+
+        if (interp == NULL) {
+            Unlock();
+            return TCL_OK;
+        }
+        hPtr = Tcl_FindHashEntry(&ZipFS.zipHash, mntpt);
+        if (hPtr != NULL) {
+            if ((zf = Tcl_GetHashValue(hPtr)) != NULL) {
+                Tcl_SetObjResult(interp,Tcl_NewStringObj(zf->name, -1));
+            }
+        }
+        Unlock();
+        return TCL_OK;
+    }
+    data=Tcl_GetByteArrayFromObj(objv[2],&length);
+    return TclZipfs_Mount_Buffer(interp, mntpt,data,length,1);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipFSRootObjCmd --
+ *
+ *      This procedure is invoked to process the "zipfs::root" command. It
+ *      returns the root that all zipfs file systems are mounted under.
+ *
+ * Results:
+ *      A standard Tcl result.
+ *
+ * Side effects:
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipFSRootObjCmd(
+    ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]
+) {
+    Tcl_SetObjResult(interp,Tcl_NewStringObj(ZIPFS_VOLUME, -1));
+    return TCL_OK;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipFSUnmountObjCmd --
+ *
+ *      This procedure is invoked to process the "zipfs::unmount" command.
+ *
+ * Results:
+ *      A standard Tcl result.
+ *
+ * Side effects:
+ *      A mounted ZIP archive file is unmounted, resources are free'd.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipFSUnmountObjCmd(
+    ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]
+) {
+    if (objc != 2) {
+        Tcl_WrongNumArgs(interp, 1, objv, "zipfile");
+        return TCL_ERROR;
+    }
+    return TclZipfs_Unmount(interp, Tcl_GetString(objv[1]));
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipFSMkKeyObjCmd --
+ *
+ *      This procedure is invoked to process the "zipfs::mkkey" command.
+ *    It produces a rotated password to be embedded into an image file.
+ *
+ * Results:
+ *      A standard Tcl result.
+ *
+ * Side effects:
+ *      None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipFSMkKeyObjCmd(
+    ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]
+) {
+    int len, i = 0;
+    char *pw, pwbuf[264];
+
+    if (objc != 2) {
+    Tcl_WrongNumArgs(interp, 1, objv, "password");
+        return TCL_ERROR;
+    }
+    pw = Tcl_GetString(objv[1]);
+    len = strlen(pw);
+    if (len == 0) {
+        return TCL_OK;
+    }
+    if ((len > 255) || (strchr(pw, 0xff) != NULL)) {
+        Tcl_SetObjResult(interp, Tcl_NewStringObj("illegal password", -1));
+        return TCL_ERROR;
+    }
+    while (len > 0) {
+        int ch = pw[len - 1];
+
+        pwbuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f];
+        i++;
+        len--;
+    }
+    pwbuf[i] = i;
+    ++i;
+    pwbuf[i++] = (char) ZIP_PASSWORD_END_SIG;
+    pwbuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 8);
+    pwbuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 16);
+    pwbuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 24);
+    pwbuf[i] = '\0';
+    Tcl_AppendResult(interp, pwbuf, (char *) NULL);
+    return TCL_OK;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipAddFile --
+ *
+ *      This procedure is used by ZipFSMkZipOrImgCmd() to add a single
+ *    file to the output ZIP archive file being written. A ZipEntry
+ *    struct about the input file is added to the given fileHash table
+ *    for later creation of the central ZIP directory.
+ *
+ * Results:
+ *      A standard Tcl result.
+ *
+ * Side effects:
+ *    Input file is read and (compressed and) written to the output
+ *    ZIP archive file.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipAddFile(
+    Tcl_Interp *interp, const char *path, const char *name,
+    Tcl_Channel out, const char *passwd,
+    char *buf, int bufsize, Tcl_HashTable *fileHash
+) {
+    Tcl_Channel in;
+    Tcl_HashEntry *hPtr;
+    ZipEntry *z;
+    z_stream stream;
+    const char *zpath;
+    int crc, flush, zpathlen;
+    size_t nbyte, nbytecompr, len, olen, align = 0;
+    Tcl_WideInt pos[3];
+    int mtime = 0, isNew, cmeth;
+    unsigned long keys[3], keys0[3];
+    char obuf[4096];
+
+    zpath = name;
+    while (zpath != NULL && zpath[0] == '/') {
+        zpath++;
+    }
+    if ((zpath == NULL) || (zpath[0] == '\0')) {
+        return TCL_OK;
+    }
+    zpathlen = strlen(zpath);
+    if (zpathlen + ZIP_CENTRAL_HEADER_LEN > bufsize) {
+        Tcl_AppendResult(interp, "path too long for \"", path, "\"", (char *) NULL);
+        return TCL_ERROR;
+    }
+    in = Tcl_OpenFileChannel(interp, path, "r", 0);
+    if (
+        (in == NULL)
+        || (Tcl_SetChannelOption(interp, in, "-translation", "binary") != TCL_OK)
+        || (Tcl_SetChannelOption(interp, in, "-encoding", "binary") != TCL_OK)
+    ) {
+#ifdef _WIN32
+         /* hopefully a directory */
+         if (strcmp("permission denied", Tcl_PosixError(interp)) == 0) {
+            Tcl_Close(interp, in);
+            return TCL_OK;
+        }
+#endif
+        Tcl_Close(interp, in);
+        return TCL_ERROR;
+    } else {
+        Tcl_Obj *pathObj = Tcl_NewStringObj(path, -1);
+        Tcl_StatBuf statBuf;
+
+        Tcl_IncrRefCount(pathObj);
+        if (Tcl_FSStat(pathObj, &statBuf) != -1) {
+            mtime = statBuf.st_mtime;
+        }
+        Tcl_DecrRefCount(pathObj);
+    }
+    Tcl_ResetResult(interp);
+    crc = 0;
+    nbyte = nbytecompr = 0;
+    while ((len = Tcl_Read(in, buf, bufsize)) + 1 > 1) {
+        crc = crc32(crc, (unsigned char *) buf, len);
+        nbyte += len;
+    }
+    if (len == (size_t)-1) {
+        if (nbyte == 0) {
+            if (strcmp("illegal operation on a directory",
+                   Tcl_PosixError(interp)) == 0) {
+            Tcl_Close(interp, in);
+            return TCL_OK;
+            }
+        }
+        Tcl_AppendResult(interp, "read error on \"", path, "\"",
+                 (char *) NULL);
+        Tcl_Close(interp, in);
+        return TCL_ERROR;
+    }
+    if (Tcl_Seek(in, 0, SEEK_SET) == -1) {
+        Tcl_AppendResult(interp, "seek error on \"", path, "\"",
+                 (char *) NULL);
+        Tcl_Close(interp, in);
+        return TCL_ERROR;
+    }
+    pos[0] = Tcl_Tell(out);
+    memset(buf, '\0', ZIP_LOCAL_HEADER_LEN);
+    memcpy(buf + ZIP_LOCAL_HEADER_LEN, zpath, zpathlen);
+    len = zpathlen + ZIP_LOCAL_HEADER_LEN;
+    if ((size_t)Tcl_Write(out, buf, len) != len) {
+wrerr:
+    Tcl_AppendResult(interp, "write error", (char *) NULL);
+    Tcl_Close(interp, in);
+    return TCL_ERROR;
+    }
+    if ((len + pos[0]) & 3) {
+        unsigned char abuf[8];
+
+        /*
+         * Align payload to next 4-byte boundary using a dummy extra
+         * entry similar to the zipalign tool from Android's SDK.
+         */
+        align = 4 + ((len + pos[0]) & 3);
+        zip_write_short(abuf, 0xffff);
+        zip_write_short(abuf + 2, align - 4);
+        zip_write_int(abuf + 4, 0x03020100);
+        if ((size_t)Tcl_Write(out, (const char *)abuf, align) != align) {
+            goto wrerr;
+        }
+    }
+    if (passwd != NULL) {
+        int i, ch, tmp;
+        unsigned char kvbuf[24];
+        Tcl_Obj *ret;
+
+        init_keys(passwd, keys, crc32tab);
+        for (i = 0; i < 12 - 2; i++) {
+            if (Tcl_EvalEx(interp, "expr int(rand() * 256) % 256", -1, 0) != TCL_OK) {
+                Tcl_AppendResult(interp, "PRNG error", (char *) NULL);
+                Tcl_Close(interp, in);
+                return TCL_ERROR;
+            }
+            ret = Tcl_GetObjResult(interp);
+            if (Tcl_GetIntFromObj(interp, ret, &ch) != TCL_OK) {
+                Tcl_Close(interp, in);
+                return TCL_ERROR;
+            }
+            kvbuf[i + 12] = (unsigned char) zencode(keys, crc32tab, ch, tmp);
+        }
+        Tcl_ResetResult(interp);
+        init_keys(passwd, keys, crc32tab);
+        for (i = 0; i < 12 - 2; i++) {
+            kvbuf[i] = (unsigned char) zencode(keys, crc32tab, kvbuf[i + 12], tmp);
+        }
+        kvbuf[i++] = (unsigned char) zencode(keys, crc32tab, crc >> 16, tmp);
+        kvbuf[i++] = (unsigned char) zencode(keys, crc32tab, crc >> 24, tmp);
+        len = Tcl_Write(out, (char *) kvbuf, 12);
+        memset(kvbuf, 0, 24);
+        if (len != 12) {
+            Tcl_AppendResult(interp, "write error", (char *) NULL);
+            Tcl_Close(interp, in);
+            return TCL_ERROR;
+        }
+        memcpy(keys0, keys, sizeof (keys0));
+        nbytecompr += 12;
+    }
+    Tcl_Flush(out);
+    pos[2] = Tcl_Tell(out);
+    cmeth = ZIP_COMPMETH_DEFLATED;
+    memset(&stream, 0, sizeof (stream));
+    stream.zalloc = Z_NULL;
+    stream.zfree = Z_NULL;
+    stream.opaque = Z_NULL;
+    if (deflateInit2(&stream, 9, Z_DEFLATED, -15, 8, Z_DEFAULT_STRATEGY) != Z_OK) {
+        Tcl_AppendResult(interp, "compression init error on \"", path, "\"",
+                 (char *) NULL);
+        Tcl_Close(interp, in);
+        return TCL_ERROR;
+    }
+    do {
+    len = Tcl_Read(in, buf, bufsize);
+    if (len == (size_t)-1) {
+        Tcl_AppendResult(interp, "read error on \"", path, "\"",
+                 (char *) NULL);
+        deflateEnd(&stream);
+        Tcl_Close(interp, in);
+        return TCL_ERROR;
+    }
+    stream.avail_in = len;
+    stream.next_in = (unsigned char *) buf;
+    flush = Tcl_Eof(in) ? Z_FINISH : Z_NO_FLUSH;
+    do {
+        stream.avail_out = sizeof (obuf);
+        stream.next_out = (unsigned char *) obuf;
+        len = deflate(&stream, flush);
+        if (len == (size_t)Z_STREAM_ERROR) {
+            Tcl_AppendResult(interp, "deflate error on \"", path, "\"",
+                     (char *) NULL);
+            deflateEnd(&stream);
+            Tcl_Close(interp, in);
+            return TCL_ERROR;
+        }
+        olen = sizeof (obuf) - stream.avail_out;
+        if (passwd != NULL) {
+            size_t i;
+            int tmp;
+
+            for (i = 0; i < olen; i++) {
+                obuf[i] = (char) zencode(keys, crc32tab, obuf[i], tmp);
+            }
+        }
+        if (olen && ((size_t)Tcl_Write(out, obuf, olen) != olen)) {
+            Tcl_AppendResult(interp, "write error", (char *) NULL);
+            deflateEnd(&stream);
+            Tcl_Close(interp, in);
+            return TCL_ERROR;
+        }
+        nbytecompr += olen;
+    } while (stream.avail_out == 0);
+    } while (flush != Z_FINISH);
+    deflateEnd(&stream);
+    Tcl_Flush(out);
+    pos[1] = Tcl_Tell(out);
+    if (nbyte - nbytecompr <= 0) {
+        /*
+         * Compressed file larger than input,
+         * write it again uncompressed.
+         */
+        if (Tcl_Seek(in, 0, SEEK_SET) != 0) {
+            goto seekErr;
+        }
+        if (Tcl_Seek(out, pos[2], SEEK_SET) != pos[2]) {
+seekErr:
+            Tcl_Close(interp, in);
+            Tcl_AppendResult(interp, "seek error", (char *) NULL);
+            return TCL_ERROR;
+        }
+        nbytecompr = (passwd != NULL) ? 12 : 0;
+        while (1) {
+            len = Tcl_Read(in, buf, bufsize);
+            if (len == (size_t)-1) {
+            Tcl_AppendResult(interp, "read error on \"", path, "\"",
+                     (char *) NULL);
+            Tcl_Close(interp, in);
+            return TCL_ERROR;
+            } else if (len == 0) {
+            break;
+            }
+            if (passwd != NULL) {
+            size_t i;
+            int tmp;
+
+            for (i = 0; i < len; i++) {
+                buf[i] = (char) zencode(keys0, crc32tab, buf[i], tmp);
+            }
+            }
+            if ((size_t)Tcl_Write(out, buf, len) != len) {
+            Tcl_AppendResult(interp, "write error", (char *) NULL);
+            Tcl_Close(interp, in);
+            return TCL_ERROR;
+            }
+            nbytecompr += len;
+        }
+        cmeth = ZIP_COMPMETH_STORED;
+        Tcl_Flush(out);
+        pos[1] = Tcl_Tell(out);
+        Tcl_TruncateChannel(out, pos[1]);
+    }
+    Tcl_Close(interp, in);
+
+    z = (ZipEntry *) Tcl_Alloc(sizeof (*z));
+    z->name = NULL;
+    z->tnext = NULL;
+    z->depth = 0;
+    z->zipfile = NULL;
+    z->isdir = 0;
+    z->isenc = (passwd != NULL) ? 1 : 0;
+    z->offset = pos[0];
+    z->crc32 = crc;
+    z->timestamp = mtime;
+    z->nbyte = nbyte;
+    z->nbytecompr = nbytecompr;
+    z->cmeth = cmeth;
+    z->data = NULL;
+    hPtr = Tcl_CreateHashEntry(fileHash, zpath, &isNew);
+    if (!isNew) {
+        Tcl_AppendResult(interp, "non-unique path name \"", path, "\"",
+                 (char *) NULL);
+        Tcl_Free((char *) z);
+        return TCL_ERROR;
+    } else {
+        Tcl_SetHashValue(hPtr, (ClientData) z);
+        z->name = Tcl_GetHashKey(fileHash, hPtr);
+        z->next = NULL;
+    }
+
+    /*
+     * Write final local header information.
+     */
+    zip_write_int(buf + ZIP_LOCAL_SIG_OFFS, ZIP_LOCAL_HEADER_SIG);
+    zip_write_short(buf + ZIP_LOCAL_VERSION_OFFS, ZIP_MIN_VERSION);
+    zip_write_short(buf + ZIP_LOCAL_FLAGS_OFFS, z->isenc);
+    zip_write_short(buf + ZIP_LOCAL_COMPMETH_OFFS, z->cmeth);
+    zip_write_short(buf + ZIP_LOCAL_MTIME_OFFS, ToDosTime(z->timestamp));
+    zip_write_short(buf + ZIP_LOCAL_MDATE_OFFS, ToDosDate(z->timestamp));
+    zip_write_int(buf + ZIP_LOCAL_CRC32_OFFS, z->crc32);
+    zip_write_int(buf + ZIP_LOCAL_COMPLEN_OFFS, z->nbytecompr);
+    zip_write_int(buf + ZIP_LOCAL_UNCOMPLEN_OFFS, z->nbyte);
+    zip_write_short(buf + ZIP_LOCAL_PATHLEN_OFFS, zpathlen);
+    zip_write_short(buf + ZIP_LOCAL_EXTRALEN_OFFS, align);
+    if (Tcl_Seek(out, pos[0], SEEK_SET) != pos[0]) {
+        Tcl_DeleteHashEntry(hPtr);
+        Tcl_Free((char *) z);
+        Tcl_AppendResult(interp, "seek error", (char *) NULL);
+        return TCL_ERROR;
+    }
+    if (Tcl_Write(out, buf, ZIP_LOCAL_HEADER_LEN) != ZIP_LOCAL_HEADER_LEN) {
+        Tcl_DeleteHashEntry(hPtr);
+        Tcl_Free((char *) z);
+        Tcl_AppendResult(interp, "write error", (char *) NULL);
+        return TCL_ERROR;
+    }
+    Tcl_Flush(out);
+    if (Tcl_Seek(out, pos[1], SEEK_SET) != pos[1]) {
+        Tcl_DeleteHashEntry(hPtr);
+        Tcl_Free((char *) z);
+        Tcl_AppendResult(interp, "seek error", (char *) NULL);
+        return TCL_ERROR;
+    }
+    return TCL_OK;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipFSMkZipOrImgObjCmd --
+ *
+ *      This procedure is creates a new ZIP archive file or image file
+ *        given output filename, input directory of files to be archived,
+ *        optional password, and optional image to be prepended to the
+ *        output ZIP archive file.
+ *
+ * Results:
+ *      A standard Tcl result.
+ *
+ * Side effects:
+ *        A new ZIP archive file or image file is written.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipFSMkZipOrImgObjCmd(ClientData clientData, Tcl_Interp *interp,
+                      int isImg, int isList, int objc, Tcl_Obj *const objv[])
+{
+    Tcl_Channel out;
+    int pwlen = 0, count, ret = TCL_ERROR, lobjc;
+    size_t len, slen = 0, i = 0;
+    Tcl_WideInt pos[3];
+    Tcl_Obj **lobjv, *list = NULL;
+    ZipEntry *z;
+    Tcl_HashEntry *hPtr;
+    Tcl_HashSearch search;
+    Tcl_HashTable fileHash;
+    char *strip = NULL, *pw = NULL, pwbuf[264], buf[4096];
+
+    if (isList) {
+        if ((objc < 3) || (objc > (isImg ? 5 : 4))) {
+            Tcl_WrongNumArgs(interp, 1, objv, isImg ?
+                             "outfile inlist ?password infile?" :
+                             "outfile inlist ?password?");
+            return TCL_ERROR;
+        }
+    } else {
+        if ((objc < 3) || (objc > (isImg ? 6 : 5))) {
+            Tcl_WrongNumArgs(interp, 1, objv, isImg ?
+                             "outfile indir ?strip? ?password? ?infile?" :
+                             "outfile indir ?strip? ?password?");
+            return TCL_ERROR;
+        }
+    }
+    pwbuf[0] = 0;
+    if (objc > (isList ? 3 : 4)) {
+        pw = Tcl_GetString(objv[isList ? 3 : 4]);
+        pwlen = strlen(pw);
+        if ((pwlen > 255) || (strchr(pw, 0xff) != NULL)) {
+            Tcl_SetObjResult(interp,
+                             Tcl_NewStringObj("illegal password", -1));
+            return TCL_ERROR;
+        }
+    }
+    if (isList) {
+        list = objv[2];
+        Tcl_IncrRefCount(list);
+    } else {
+        Tcl_Obj *cmd[3];
+
+        cmd[1] = Tcl_NewStringObj("::tcl::zipfs::find", -1);
+        cmd[2] = objv[2];
+        cmd[0] = Tcl_NewListObj(2, cmd + 1);
+        Tcl_IncrRefCount(cmd[0]);
+        if (Tcl_EvalObjEx(interp, cmd[0], TCL_EVAL_DIRECT) != TCL_OK) {
+            Tcl_DecrRefCount(cmd[0]);
+            return TCL_ERROR;
+        }
+        Tcl_DecrRefCount(cmd[0]);
+        list = Tcl_GetObjResult(interp);
+        Tcl_IncrRefCount(list);
+    }
+    if (Tcl_ListObjGetElements(interp, list, &lobjc, &lobjv) != TCL_OK) {
+        Tcl_DecrRefCount(list);
+        return TCL_ERROR;
+    }
+    if (isList && (lobjc % 2)) {
+        Tcl_DecrRefCount(list);
+        Tcl_SetObjResult(interp,
+                Tcl_NewStringObj("need even number of elements", -1));
+        return TCL_ERROR;
+    }
+    if (lobjc == 0) {
+        Tcl_DecrRefCount(list);
+        Tcl_SetObjResult(interp, Tcl_NewStringObj("empty archive", -1));
+        return TCL_ERROR;
+    }
+    out = Tcl_OpenFileChannel(interp, Tcl_GetString(objv[1]), "w", 0755);
+    if (
+        (out == NULL)
+        || (Tcl_SetChannelOption(interp, out, "-translation", "binary") != TCL_OK)
+        || (Tcl_SetChannelOption(interp, out, "-encoding", "binary") != TCL_OK)
+    ) {
+        Tcl_DecrRefCount(list);
+        Tcl_Close(interp, out);
+        return TCL_ERROR;
+    }
+    if (pwlen <= 0) {
+        pw = NULL;
+        pwlen = 0;
+    }
+    if (isImg) {
+        ZipFile *zf, zf0;
+        int isMounted = 0;
+        const char *imgName;
+
+        if (isList) {
+            imgName = (objc > 4) ? Tcl_GetString(objv[4]) : Tcl_GetNameOfExecutable();
+        } else {
+            imgName = (objc > 5) ? Tcl_GetString(objv[5]) : Tcl_GetNameOfExecutable();
+        }
+        if (pwlen) {
+            i = 0;
+            len = pwlen;
+            while (len > 0) {
+                int ch = pw[len - 1];
+
+                pwbuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f];
+                i++;
+                len--;
+            }
+            pwbuf[i] = i;
+            ++i;
+            pwbuf[i++] = (char) ZIP_PASSWORD_END_SIG;
+            pwbuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 8);
+            pwbuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 16);
+            pwbuf[i++] = (char) (ZIP_PASSWORD_END_SIG >> 24);
+            pwbuf[i] = '\0';
+        }
+        /* Check for mounted image */
+        WriteLock();
+        hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search);
+        while (hPtr != NULL) {
+            if ((zf = (ZipFile *) Tcl_GetHashValue(hPtr)) != NULL) {
+                if (strcmp(zf->name, imgName) == 0) {
+                    isMounted = 1;
+                    zf->nopen++;
+                    break;
+                }
+            }
+            hPtr = Tcl_NextHashEntry(&search);
+        }
+        Unlock();
+        if (!isMounted) {
+            zf = &zf0;
+        }
+        if (isMounted ||
+            (ZipFSOpenArchive(interp, imgName, 0, zf) == TCL_OK)) {
+            if ((size_t)Tcl_Write(out, (char *) zf->data, zf->baseoffsp) != zf->baseoffsp) {
+                memset(pwbuf, 0, sizeof (pwbuf));
+                Tcl_DecrRefCount(list);
+                Tcl_SetObjResult(interp, Tcl_NewStringObj("write error", -1));
+                Tcl_Close(interp, out);
+                if (zf == &zf0) {
+                    ZipFSCloseArchive(interp, zf);
+                } else {
+                    WriteLock();
+                    zf->nopen--;
+                    Unlock();
+                }
+                return TCL_ERROR;
+            }
+            if (zf == &zf0) {
+                ZipFSCloseArchive(interp, zf);
+            } else {
+                WriteLock();
+                zf->nopen--;
+                Unlock();
+            }
+        } else {
+            size_t k;
+            int m, n;
+            Tcl_Channel in;
+            const char *errMsg = "seek error";
+
+            /*
+             * Fall back to read it as plain file which
+             * hopefully is a static tclsh or wish binary
+             * with proper zipfs infrastructure built in.
+             */
+            Tcl_ResetResult(interp);
+            in = Tcl_OpenFileChannel(interp, imgName, "r", 0644);
+            if (in == NULL) {
+                memset(pwbuf, 0, sizeof (pwbuf));
+                Tcl_DecrRefCount(list);
+                Tcl_Close(interp, out);
+                return TCL_ERROR;
+            }
+            Tcl_SetChannelOption(interp, in, "-translation", "binary");
+            Tcl_SetChannelOption(interp, in, "-encoding", "binary");
+            i = Tcl_Seek(in, 0, SEEK_END);
+            if (i == (size_t)-1) {
+cperr:
+                memset(pwbuf, 0, sizeof (pwbuf));
+                Tcl_DecrRefCount(list);
+                Tcl_SetObjResult(interp, Tcl_NewStringObj(errMsg, -1));
+                Tcl_Close(interp, out);
+                Tcl_Close(interp, in);
+                return TCL_ERROR;
+            }
+            Tcl_Seek(in, 0, SEEK_SET);
+            k = 0;
+            while (k < i) {
+                m = i - k;
+                if (m > (int)sizeof (buf)) {
+                    m = (int)sizeof (buf);
+                }
+                n = Tcl_Read(in, buf, m);
+                if (n == -1) {
+                    errMsg = "read error";
+                    goto cperr;
+                } else if (n == 0) {
+                    break;
+                }
+                m = Tcl_Write(out, buf, n);
+                if (m != n) {
+                    errMsg = "write error";
+                    goto cperr;
+                }
+                k += m;
+            }
+            Tcl_Close(interp, in);
+        }
+        len = strlen(pwbuf);
+        if (len > 0) {
+            i = Tcl_Write(out, pwbuf, len);
+            if (i != len) {
+                Tcl_DecrRefCount(list);
+                Tcl_SetObjResult(interp, Tcl_NewStringObj("write error", -1));
+                Tcl_Close(interp, out);
+                return TCL_ERROR;
+            }
+        }
+        memset(pwbuf, 0, sizeof (pwbuf));
+        Tcl_Flush(out);
+    }
+    Tcl_InitHashTable(&fileHash, TCL_STRING_KEYS);
+    pos[0] = Tcl_Tell(out);
+    if (!isList && (objc > 3)) {
+        strip = Tcl_GetString(objv[3]);
+        slen = strlen(strip);
+    }
+    for (i = 0; i < (size_t)lobjc; i += (isList ? 2 : 1)) {
+        const char *path, *name;
+
+        path = Tcl_GetString(lobjv[i]);
+        if (isList) {
+            name = Tcl_GetString(lobjv[i + 1]);
+        } else {
+            name = path;
+            if (slen > 0) {
+                len = strlen(name);
+                if ((len <= slen) || (strncmp(strip, name, slen) != 0)) {
+                    continue;
+                }
+                name += slen;
+            }
+        }
+        while (name[0] == '/') {
+            ++name;
+        }
+        if (name[0] == '\0') {
+            continue;
+        }
+        if (ZipAddFile(interp, path, name, out, pw, buf, sizeof (buf),
+                       &fileHash) != TCL_OK) {
+            goto done;
+        }
+    }
+    pos[1] = Tcl_Tell(out);
+    count = 0;
+    for (i = 0; i < (size_t)lobjc; i += (isList ? 2 : 1)) {
+        const char *path, *name;
+
+        path = Tcl_GetString(lobjv[i]);
+        if (isList) {
+            name = Tcl_GetString(lobjv[i + 1]);
+        } else {
+            name = path;
+            if (slen > 0) {
+                len = strlen(name);
+                if ((len <= slen) || (strncmp(strip, name, slen) != 0)) {
+                    continue;
+                }
+                name += slen;
+            }
+        }
+        while (name[0] == '/') {
+            ++name;
+        }
+        if (name[0] == '\0') {
+            continue;
+        }
+        hPtr = Tcl_FindHashEntry(&fileHash, name);
+        if (hPtr == NULL) {
+            continue;
+        }
+        z = (ZipEntry *) Tcl_GetHashValue(hPtr);
+        len = strlen(z->name);
+        zip_write_int(buf + ZIP_CENTRAL_SIG_OFFS, ZIP_CENTRAL_HEADER_SIG);
+        zip_write_short(buf + ZIP_CENTRAL_VERSIONMADE_OFFS, ZIP_MIN_VERSION);
+        zip_write_short(buf + ZIP_CENTRAL_VERSION_OFFS, ZIP_MIN_VERSION);
+        zip_write_short(buf + ZIP_CENTRAL_FLAGS_OFFS, z->isenc ? 1 : 0);
+        zip_write_short(buf + ZIP_CENTRAL_COMPMETH_OFFS, z->cmeth);
+        zip_write_short(buf + ZIP_CENTRAL_MTIME_OFFS, ToDosTime(z->timestamp));
+        zip_write_short(buf + ZIP_CENTRAL_MDATE_OFFS, ToDosDate(z->timestamp));
+        zip_write_int(buf + ZIP_CENTRAL_CRC32_OFFS, z->crc32);
+        zip_write_int(buf + ZIP_CENTRAL_COMPLEN_OFFS, z->nbytecompr);
+        zip_write_int(buf + ZIP_CENTRAL_UNCOMPLEN_OFFS, z->nbyte);
+        zip_write_short(buf + ZIP_CENTRAL_PATHLEN_OFFS, len);
+        zip_write_short(buf + ZIP_CENTRAL_EXTRALEN_OFFS, 0);
+        zip_write_short(buf + ZIP_CENTRAL_FCOMMENTLEN_OFFS, 0);
+        zip_write_short(buf + ZIP_CENTRAL_DISKFILE_OFFS, 0);
+        zip_write_short(buf + ZIP_CENTRAL_IATTR_OFFS, 0);
+        zip_write_int(buf + ZIP_CENTRAL_EATTR_OFFS, 0);
+        zip_write_int(buf + ZIP_CENTRAL_LOCALHDR_OFFS, z->offset - pos[0]);
+        if (
+            (Tcl_Write(out, buf, ZIP_CENTRAL_HEADER_LEN) != ZIP_CENTRAL_HEADER_LEN)
+            || ((size_t)Tcl_Write(out, z->name, len) != len)
+        ) {
+            Tcl_SetObjResult(interp, Tcl_NewStringObj("write error", -1));
+            goto done;
+        }
+        count++;
+    }
+    Tcl_Flush(out);
+    pos[2] = Tcl_Tell(out);
+    zip_write_int(buf + ZIP_CENTRAL_END_SIG_OFFS, ZIP_CENTRAL_END_SIG);
+    zip_write_short(buf + ZIP_CENTRAL_DISKNO_OFFS, 0);
+    zip_write_short(buf + ZIP_CENTRAL_DISKDIR_OFFS, 0);
+    zip_write_short(buf + ZIP_CENTRAL_ENTS_OFFS, count);
+    zip_write_short(buf + ZIP_CENTRAL_TOTALENTS_OFFS, count);
+    zip_write_int(buf + ZIP_CENTRAL_DIRSIZE_OFFS, pos[2] - pos[1]);
+    zip_write_int(buf + ZIP_CENTRAL_DIRSTART_OFFS, pos[1] - pos[0]);
+    zip_write_short(buf + ZIP_CENTRAL_COMMENTLEN_OFFS, 0);
+    if (Tcl_Write(out, buf, ZIP_CENTRAL_END_LEN) != ZIP_CENTRAL_END_LEN) {
+        Tcl_SetObjResult(interp, Tcl_NewStringObj("write error", -1));
+        goto done;
+    }
+    Tcl_Flush(out);
+    ret = TCL_OK;
+done:
+    if (ret == TCL_OK) {
+        ret = Tcl_Close(interp, out);
+    } else {
+        Tcl_Close(interp, out);
+    }
+    Tcl_DecrRefCount(list);
+    hPtr = Tcl_FirstHashEntry(&fileHash, &search);
+    while (hPtr != NULL) {
+        z = (ZipEntry *) Tcl_GetHashValue(hPtr);
+        Tcl_Free((char *) z);
+        Tcl_DeleteHashEntry(hPtr);
+        hPtr = Tcl_NextHashEntry(&search);
+    }
+    Tcl_DeleteHashTable(&fileHash);
+    return ret;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipFSMkZipObjCmd --
+ *
+ *      This procedure is invoked to process the "zipfs::mkzip" command.
+ *    See description of ZipFSMkZipOrImgCmd().
+ *
+ * Results:
+ *      A standard Tcl result.
+ *
+ * Side effects:
+ *    See description of ZipFSMkZipOrImgCmd().
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipFSMkZipObjCmd(
+    ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]
+) {
+    return ZipFSMkZipOrImgObjCmd(clientData, interp, 0, 0, objc, objv);
+}
+
+static int
+ZipFSLMkZipObjCmd(
+    ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]
+) {
+    return ZipFSMkZipOrImgObjCmd(clientData, interp, 0, 1, objc, objv);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipFSZipFSOpenArchiveObjCmd --
+ *
+ *      This procedure is invoked to process the "zipfs::mkimg" command.
+ *    See description of ZipFSMkZipOrImgCmd().
+ *
+ * Results:
+ *      A standard Tcl result.
+ *
+ * Side effects:
+ *    See description of ZipFSMkZipOrImgCmd().
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipFSMkImgObjCmd(ClientData clientData, Tcl_Interp *interp,
+         int objc, Tcl_Obj *const objv[])
+{
+    return ZipFSMkZipOrImgObjCmd(clientData, interp, 1, 0, objc, objv);
+}
+
+static int
+ZipFSLMkImgObjCmd(ClientData clientData, Tcl_Interp *interp,
+          int objc, Tcl_Obj *const objv[])
+{
+    return ZipFSMkZipOrImgObjCmd(clientData, interp, 1, 1, objc, objv);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipFSCanonicalObjCmd --
+ *
+ *      This procedure is invoked to process the "zipfs::canonical" command.
+ *    It returns the canonical name for a file within zipfs
+ *
+ * Results:
+ *      Always TCL_OK.
+ *
+ * Side effects:
+ *      None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipFSCanonicalObjCmd(
+    ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]
+) {
+    char *mntpoint=NULL;
+    char *filename=NULL;
+    char *result;
+    Tcl_DString dPath;
+
+    if (objc != 2 && objc != 3 && objc!=4) {
+        Tcl_WrongNumArgs(interp, 1, objv, "?mntpnt? filename ?ZIPFS?");
+        return TCL_ERROR;
+    }
+    Tcl_DStringInit(&dPath);
+    if(objc==2) {
+        filename = Tcl_GetString(objv[1]);
+        result=CanonicalPath("",filename,&dPath,1);
+    } else if (objc==3) {
+        mntpoint = Tcl_GetString(objv[1]);
+        filename = Tcl_GetString(objv[2]);
+        result=CanonicalPath(mntpoint,filename,&dPath,1);
+    } else {
+        int zipfs=0;
+        if(Tcl_GetBooleanFromObj(interp,objv[3],&zipfs)) {
+            return TCL_ERROR;
+        }
+        mntpoint = Tcl_GetString(objv[1]);
+        filename = Tcl_GetString(objv[2]);
+        result=CanonicalPath(mntpoint,filename,&dPath,zipfs);
+    }
+    Tcl_SetObjResult(interp,Tcl_NewStringObj(result,-1));
+    return TCL_OK;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipFSExistsObjCmd --
+ *
+ *      This procedure is invoked to process the "zipfs::exists" command.
+ *    It tests for the existence of a file in the ZIP filesystem and
+ *    places a boolean into the interp's result.
+ *
+ * Results:
+ *      Always TCL_OK.
+ *
+ * Side effects:
+ *      None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipFSExistsObjCmd(
+    ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]
+) {
+    char *filename;
+    int exists;
+    Tcl_DString ds;
+
+    if (objc != 2) {
+      Tcl_WrongNumArgs(interp, 1, objv, "filename");
+      return TCL_ERROR;
+    }
+
+    /* prepend ZIPFS_VOLUME to filename, eliding the final / */
+    filename = Tcl_GetStringFromObj(objv[1], 0);
+    Tcl_DStringInit(&ds);
+    Tcl_DStringAppend(&ds, ZIPFS_VOLUME, ZIPFS_VOLUME_LEN-1);
+    Tcl_DStringAppend(&ds, filename, -1);
+    filename = Tcl_DStringValue(&ds);
+
+    ReadLock();
+    exists = ZipFSLookup(filename) != NULL;
+    Unlock();
+
+    Tcl_SetObjResult(interp,Tcl_NewBooleanObj(exists));
+    return TCL_OK;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipFSInfoObjCmd --
+ *
+ *      This procedure is invoked to process the "zipfs::info" command.
+ *    On success, it returns a Tcl list made up of name of ZIP archive
+ *    file, size uncompressed, size compressed, and archive offset of
+ *    a file in the ZIP filesystem.
+ *
+ * Results:
+ *      A standard Tcl result.
+ *
+ * Side effects:
+ *      None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipFSInfoObjCmd(
+    ClientData clientData, Tcl_Interp *interp,int objc, Tcl_Obj *const objv[]
+) {
+    char *filename;
+    ZipEntry *z;
+
+    if (objc != 2) {
+        Tcl_WrongNumArgs(interp, 1, objv, "filename");
+        return TCL_ERROR;
+    }
+    filename = Tcl_GetStringFromObj(objv[1], 0);
+    ReadLock();
+    z = ZipFSLookup(filename);
+    if (z != NULL) {
+        Tcl_Obj *result = Tcl_GetObjResult(interp);
+
+        Tcl_ListObjAppendElement(interp, result,
+                     Tcl_NewStringObj(z->zipfile->name, -1));
+        Tcl_ListObjAppendElement(interp, result, Tcl_NewWideIntObj(z->nbyte));
+        Tcl_ListObjAppendElement(interp, result, Tcl_NewWideIntObj(z->nbytecompr));
+        Tcl_ListObjAppendElement(interp, result, Tcl_NewWideIntObj(z->offset));
+    }
+    Unlock();
+    return TCL_OK;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipFSListObjCmd --
+ *
+ *      This procedure is invoked to process the "zipfs::list" command.
+ *    On success, it returns a Tcl list of files of the ZIP filesystem
+ *    which match a search pattern (glob or regexp).
+ *
+ * Results:
+ *      A standard Tcl result.
+ *
+ * Side effects:
+ *      None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipFSListObjCmd(
+    ClientData clientData, Tcl_Interp *interp,int objc, Tcl_Obj *const objv[]
+) {
+    char *pattern = NULL;
+    Tcl_RegExp regexp = NULL;
+    Tcl_HashEntry *hPtr;
+    Tcl_HashSearch search;
+    Tcl_Obj *result = Tcl_GetObjResult(interp);
+
+    if (objc > 3) {
+        Tcl_WrongNumArgs(interp, 1, objv, "?(-glob|-regexp)? ?pattern?");
+        return TCL_ERROR;
+    }
+    if (objc == 3) {
+        int n;
+        char *what = Tcl_GetStringFromObj(objv[1], &n);
+
+        if ((n >= 2) && (strncmp(what, "-glob", n) == 0)) {
+            pattern = Tcl_GetString(objv[2]);
+        } else if ((n >= 2) && (strncmp(what, "-regexp", n) == 0)) {
+            regexp = Tcl_RegExpCompile(interp, Tcl_GetString(objv[2]));
+            if (regexp == NULL) {
+                return TCL_ERROR;
+            }
+        } else {
+            Tcl_AppendResult(interp, "unknown option \"", what,"\"", (char *) NULL);
+            return TCL_ERROR;
+        }
+    } else if (objc == 2) {
+        pattern = Tcl_GetStringFromObj(objv[1], 0);
+    }
+    ReadLock();
+    if (pattern != NULL) {
+        for (
+            hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search);
+            hPtr != NULL;
+            hPtr = Tcl_NextHashEntry(&search)
+        ) {
+            ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr);
+
+            if (Tcl_StringMatch(z->name, pattern)) {
+                Tcl_ListObjAppendElement(interp, result,Tcl_NewStringObj(z->name, -1));
+            }
+        }
+    } else if (regexp != NULL) {
+        for (
+            hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search);
+            hPtr != NULL;
+            hPtr = Tcl_NextHashEntry(&search)
+        ) {
+            ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr);
+            if (Tcl_RegExpExec(interp, regexp, z->name, z->name)) {
+                Tcl_ListObjAppendElement(interp, result,Tcl_NewStringObj(z->name, -1));
+            }
+        }
+    } else {
+        for (
+            hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search);
+            hPtr != NULL;
+            hPtr = Tcl_NextHashEntry(&search)
+        ) {
+            ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr);
+
+            Tcl_ListObjAppendElement(interp, result, Tcl_NewStringObj(z->name, -1));
+        }
+    }
+    Unlock();
+    return TCL_OK;
+}
+
+#ifdef _WIN32
+#define LIBRARY_SIZE        64
+static int
+ToUtf(
+    const WCHAR *wSrc,
+    char *dst)
+{
+    char *start;
+
+    start = dst;
+    while (*wSrc != '\0') {
+    dst += Tcl_UniCharToUtf(*wSrc, dst);
+    wSrc++;
+    }
+    *dst = '\0';
+    return (int) (dst - start);
+}
+#endif
+
+Tcl_Obj *TclZipfs_TclLibrary(void) {
+    if(zipfs_literal_tcl_library) {
+        return Tcl_NewStringObj(zipfs_literal_tcl_library,-1);
+    } else {
+        Tcl_Obj *vfsinitscript;
+        int found=0;
+#ifdef _WIN32
+        HMODULE hModule = TclWinGetTclInstance();
+        WCHAR wName[MAX_PATH + LIBRARY_SIZE];
+        char dllname[(MAX_PATH + LIBRARY_SIZE) * TCL_UTF_MAX];
+#endif
+        /* Look for the library file system within the executable */
+        vfsinitscript=Tcl_NewStringObj(ZIPFS_APP_MOUNT "/tcl_library/init.tcl",-1);
+        Tcl_IncrRefCount(vfsinitscript);
+        found=Tcl_FSAccess(vfsinitscript,F_OK);
+        Tcl_DecrRefCount(vfsinitscript);
+        if(found==TCL_OK) {
+            zipfs_literal_tcl_library=ZIPFS_APP_MOUNT "/tcl_library";
+            return Tcl_NewStringObj(zipfs_literal_tcl_library,-1);
+        }
+#ifdef _WIN32
+        if (GetModuleFileNameW(hModule, wName, MAX_PATH) == 0) {
+            GetModuleFileNameA(hModule, dllname, MAX_PATH);
+        } else {
+            ToUtf(wName, dllname);
+        }
+        /* Mount zip file and dll before releasing to search */
+        if(TclZipfs_AppHook_FindTclInit(dllname)==TCL_OK) {
+            return Tcl_NewStringObj(zipfs_literal_tcl_library,-1);
+        }
+#else
+#ifdef CFG_RUNTIME_DLLFILE
+        /* Mount zip file and dll before releasing to search */
+        if(TclZipfs_AppHook_FindTclInit(CFG_RUNTIME_LIBDIR "/" CFG_RUNTIME_DLLFILE)==TCL_OK) {
+            return Tcl_NewStringObj(zipfs_literal_tcl_library,-1);
+        }
+#endif
+#endif
+#ifdef CFG_RUNTIME_ZIPFILE
+        if(TclZipfs_AppHook_FindTclInit(CFG_RUNTIME_LIBDIR "/" CFG_RUNTIME_ZIPFILE)==TCL_OK) {
+            return Tcl_NewStringObj(zipfs_literal_tcl_library,-1);
+        }
+        if(TclZipfs_AppHook_FindTclInit(CFG_RUNTIME_SCRDIR "/" CFG_RUNTIME_ZIPFILE)==TCL_OK) {
+            return Tcl_NewStringObj(zipfs_literal_tcl_library,-1);
+        }
+#endif
+    }
+    if(zipfs_literal_tcl_library) {
+        return Tcl_NewStringObj(zipfs_literal_tcl_library,-1);
+    }
+    return NULL;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipFSTclLibraryObjCmd --
+ *
+ *      This procedure is invoked to process the "zipfs::root" command. It
+ *      returns the root that all zipfs file systems are mounted under.
+ *
+ * Results:
+ *      A standard Tcl result.
+ *
+ * Side effects:
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipFSTclLibraryObjCmd(ClientData clientData, Tcl_Interp *interp,
+         int objc, Tcl_Obj *const objv[])
+{
+    Tcl_Obj *pResult;
+
+    pResult=TclZipfs_TclLibrary();
+    if(!pResult) {
+        pResult=Tcl_NewObj();
+    }
+    Tcl_SetObjResult(interp,pResult);
+    return TCL_OK;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipChannelClose --
+ *
+ *    This function is called to close a channel.
+ *
+ * Results:
+ *    Always TCL_OK.
+ *
+ * Side effects:
+ *    Resources are free'd.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipChannelClose(ClientData instanceData, Tcl_Interp *interp)
+{
+    ZipChannel *info = (ZipChannel *) instanceData;
+
+    if (info->iscompr && (info->ubuf != NULL)) {
+        Tcl_Free((char *) info->ubuf);
+        info->ubuf = NULL;
+    }
+    if (info->isenc) {
+        info->isenc = 0;
+        memset(info->keys, 0, sizeof (info->keys));
+    }
+    if (info->iswr) {
+        ZipEntry *z = info->zipentry;
+        unsigned char *newdata;
+
+        newdata = (unsigned char *) Tcl_AttemptRealloc((char *) info->ubuf, info->nread);
+        if (newdata != NULL) {
+            if (z->data != NULL) {
+                Tcl_Free((char *) z->data);
+            }
+            z->data = newdata;
+            z->nbyte = z->nbytecompr = info->nbyte;
+            z->cmeth = ZIP_COMPMETH_STORED;
+            z->timestamp = time(NULL);
+            z->isdir = 0;
+            z->isenc = 0;
+            z->offset = 0;
+            z->crc32 = 0;
+        } else {
+            Tcl_Free((char *) info->ubuf);
+        }
+    }
+    WriteLock();
+    info->zipfile->nopen--;
+    Unlock();
+    Tcl_Free((char *) info);
+    return TCL_OK;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipChannelRead --
+ *
+ *        This function is called to read data from channel.
+ *
+ * Results:
+ *        Number of bytes read or -1 on error with error number set.
+ *
+ * Side effects:
+ *        Data is read and file pointer is advanced.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipChannelRead(ClientData instanceData, char *buf, int toRead, int *errloc)
+{
+    ZipChannel *info = (ZipChannel *) instanceData;
+    unsigned long nextpos;
+
+    if (info->isdir < 0) {
+        /*
+         * Special case: when executable combined with ZIP archive file
+         * read data in front of ZIP, i.e. the executable itself.
+         */
+        nextpos = info->nread + toRead;
+        if (nextpos > info->zipfile->baseoffs) {
+            toRead = info->zipfile->baseoffs - info->nread;
+            nextpos = info->zipfile->baseoffs;
+        }
+        if (toRead == 0) {
+            return 0;
+        }
+        memcpy(buf, info->zipfile->data, toRead);
+        info->nread = nextpos;
+        *errloc = 0;
+        return toRead;
+    }
+    if (info->isdir) {
+        *errloc = EISDIR;
+        return -1;
+    }
+    nextpos = info->nread + toRead;
+    if (nextpos > info->nbyte) {
+        toRead = info->nbyte - info->nread;
+        nextpos = info->nbyte;
+    }
+    if (toRead == 0) {
+        return 0;
+    }
+    if (info->isenc) {
+        int i, ch;
+
+        for (i = 0; i < toRead; i++) {
+            ch = info->ubuf[i + info->nread];
+            buf[i] = zdecode(info->keys, crc32tab, ch);
+        }
+    } else {
+        memcpy(buf, info->ubuf + info->nread, toRead);
+    }
+    info->nread = nextpos;
+    *errloc = 0;
+    return toRead;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipChannelWrite --
+ *
+ *    This function is called to write data into channel.
+ *
+ * Results:
+ *    Number of bytes written or -1 on error with error number set.
+ *
+ * Side effects:
+ *    Data is written and file pointer is advanced.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipChannelWrite(ClientData instanceData, const char *buf,
+        int toWrite, int *errloc)
+{
+    ZipChannel *info = (ZipChannel *) instanceData;
+    unsigned long nextpos;
+
+    if (!info->iswr) {
+        *errloc = EINVAL;
+        return -1;
+    }
+    nextpos = info->nread + toWrite;
+    if (nextpos > info->nmax) {
+        toWrite = info->nmax - info->nread;
+        nextpos = info->nmax;
+    }
+    if (toWrite == 0) {
+        return 0;
+    }
+    memcpy(info->ubuf + info->nread, buf, toWrite);
+    info->nread = nextpos;
+    if (info->nread > info->nbyte) {
+        info->nbyte = info->nread;
+    }
+    *errloc = 0;
+    return toWrite;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipChannelSeek --
+ *
+ *        This function is called to position file pointer of channel.
+ *
+ * Results:
+ *        New file position or -1 on error with error number set.
+ *
+ * Side effects:
+ *        File pointer is repositioned according to offset and mode.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipChannelSeek(ClientData instanceData, long offset, int mode, int *errloc)
+{
+    ZipChannel *info = (ZipChannel *) instanceData;
+    unsigned long end;
+
+    if (!info->iswr && (info->isdir < 0)) {
+        /*
+         * Special case: when executable combined with ZIP archive file,
+         * seek within front of ZIP, i.e. the executable itself.
+         */
+        end = info->zipfile->baseoffs;
+    } else if (info->isdir) {
+        *errloc = EINVAL;
+        return -1;
+    } else {
+        end = info->nbyte;
+    }
+    switch (mode) {
+    case SEEK_CUR:
+        offset += info->nread;
+        break;
+    case SEEK_END:
+        offset += end;
+        break;
+    case SEEK_SET:
+        break;
+    default:
+        *errloc = EINVAL;
+        return -1;
+    }
+    if (offset < 0) {
+        *errloc = EINVAL;
+        return -1;
+    }
+    if (info->iswr) {
+        if ((unsigned long) offset > info->nmax) {
+            *errloc = EINVAL;
+            return -1;
+        }
+        if ((unsigned long) offset > info->nbyte) {
+            info->nbyte = offset;
+        }
+    } else if ((unsigned long) offset > end) {
+        *errloc = EINVAL;
+        return -1;
+    }
+    info->nread = (unsigned long) offset;
+    return info->nread;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipChannelWatchChannel --
+ *
+ *    This function is called for event notifications on channel.
+ *
+ * Results:
+ *    None.
+ *
+ * Side effects:
+ *    None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static void
+ZipChannelWatchChannel(ClientData instanceData, int mask)
+{
+    return;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipChannelGetFile --
+ *
+ *    This function is called to retrieve OS handle for channel.
+ *
+ * Results:
+ *    Always TCL_ERROR since there's never an OS handle for a
+ *    file within a ZIP archive.
+ *
+ * Side effects:
+ *    None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipChannelGetFile(
+    ClientData instanceData, int direction,ClientData *handlePtr
+) {
+    return TCL_ERROR;
+}
+
+/*
+ * The channel type/driver definition used for ZIP archive members.
+ */
+
+static Tcl_ChannelType ZipChannelType = {
+    "zip",                  /* Type name. */
+#ifdef TCL_CHANNEL_VERSION_4
+    TCL_CHANNEL_VERSION_4,
+    ZipChannelClose,        /* Close channel, clean instance data */
+    ZipChannelRead,         /* Handle read request */
+    ZipChannelWrite,        /* Handle write request */
+    ZipChannelSeek,         /* Move location of access point, NULL'able */
+    NULL,                   /* Set options, NULL'able */
+    NULL,                   /* Get options, NULL'able */
+    ZipChannelWatchChannel, /* Initialize notifier */
+    ZipChannelGetFile,      /* Get OS handle from the channel */
+    NULL,                   /* 2nd version of close channel, NULL'able */
+    NULL,                   /* Set blocking mode for raw channel, NULL'able */
+    NULL,                   /* Function to flush channel, NULL'able */
+    NULL,                   /* Function to handle event, NULL'able */
+    NULL,                   /* Wide seek function, NULL'able */
+    NULL,                   /* Thread action function, NULL'able */
+#else
+    NULL,                   /* Set blocking/nonblocking behaviour, NULL'able */
+    ZipChannelClose,        /* Close channel, clean instance data */
+    ZipChannelRead,         /* Handle read request */
+    ZipChannelWrite,        /* Handle write request */
+    ZipChannelSeek,         /* Move location of access point, NULL'able */
+    NULL,                   /* Set options, NULL'able */
+    NULL,                   /* Get options, NULL'able */
+    ZipChannelWatchChannel, /* Initialize notifier */
+    ZipChannelGetFile,      /* Get OS handle from the channel */
+#endif
+};
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipChannelOpen --
+ *
+ *    This function opens a Tcl_Channel on a file from a mounted ZIP
+ *    archive according to given open mode.
+ *
+ * Results:
+ *    Tcl_Channel on success, or NULL on error.
+ *
+ * Side effects:
+ *    Memory is allocated, the file from the ZIP archive is uncompressed.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static Tcl_Channel
+ZipChannelOpen(Tcl_Interp *interp, char *filename, int mode, int permissions)
+{
+    ZipEntry *z;
+    ZipChannel *info;
+    int i, ch, trunc, wr, flags = 0;
+    char cname[128];
+
+    if (
+        (mode & O_APPEND)
+        || ((ZipFS.wrmax <= 0) && (mode & (O_WRONLY | O_RDWR)))
+    ) {
+        if (interp != NULL) {
+            Tcl_SetObjResult(interp, Tcl_NewStringObj("unsupported open mode", -1));
+        }
+        return NULL;
+    }
+    WriteLock();
+    z = ZipFSLookup(filename);
+    if (z == NULL) {
+        if (interp != NULL) {
+            Tcl_SetObjResult(interp, Tcl_NewStringObj("file not found", -1));
+            Tcl_AppendResult(interp, " \"", filename, "\"", NULL);
+        }
+        goto error;
+    }
+    trunc = (mode & O_TRUNC) != 0;
+    wr = (mode & (O_WRONLY | O_RDWR)) != 0;
+    if ((z->cmeth != ZIP_COMPMETH_STORED) && (z->cmeth != ZIP_COMPMETH_DEFLATED)) {
+        ZIPFS_ERROR(interp,"unsupported compression method");
+        goto error;
+    }
+    if (wr && z->isdir) {
+        ZIPFS_ERROR(interp,"unsupported file type");
+        goto error;
+    }
+    if (!trunc) {
+        flags |= TCL_READABLE;
+        if (z->isenc && (z->zipfile->pwbuf[0] == 0)) {
+            ZIPFS_ERROR(interp,"decryption failed");
+            goto error;
+        } else if (wr && (z->data == NULL) && (z->nbyte > ZipFS.wrmax)) {
+            ZIPFS_ERROR(interp,"file too large");
+            goto error;
+        }
+    } else {
+        flags = TCL_WRITABLE;
+    }
+    info = (ZipChannel *) Tcl_AttemptAlloc(sizeof (*info));
+    if (info == NULL) {
+        ZIPFS_ERROR(interp,"out of memory");
+        goto error;
+    }
+    info->zipfile = z->zipfile;
+    info->zipentry = z;
+    info->nread = 0;
+    if (wr) {
+        flags |= TCL_WRITABLE;
+        info->iswr = 1;
+        info->isdir = 0;
+        info->nmax = ZipFS.wrmax;
+        info->iscompr = 0;
+        info->isenc = 0;
+        info->ubuf = (unsigned char *) Tcl_AttemptAlloc(info->nmax);
+        if (info->ubuf == NULL) {
+merror0:
+            if (info->ubuf != NULL) {
+                Tcl_Free((char *) info->ubuf);
+            }
+            Tcl_Free((char *) info);
+            ZIPFS_ERROR(interp,"out of memory");
+            goto error;
+        }
+        memset(info->ubuf, 0, info->nmax);
+        if (trunc) {
+            info->nbyte = 0;
+        } else {
+            if (z->data != NULL) {
+                unsigned int j = z->nbyte;
+
+                if (j > info->nmax) {
+                    j = info->nmax;
+                }
+                memcpy(info->ubuf, z->data, j);
+                info->nbyte = j;
+            } else {
+                unsigned char *zbuf = z->zipfile->data + z->offset;
+
+                if (z->isenc) {
+                    int len = z->zipfile->pwbuf[0];
+                    char pwbuf[260];
+
+                    for (i = 0; i < len; i++) {
+                        ch = z->zipfile->pwbuf[len - i];
+                        pwbuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f];
+                    }
+                    pwbuf[i] = '\0';
+                    init_keys(pwbuf, info->keys, crc32tab);
+                    memset(pwbuf, 0, sizeof (pwbuf));
+                    for (i = 0; i < 12; i++) {
+                        ch = info->ubuf[i];
+                        zdecode(info->keys, crc32tab, ch);
+                    }
+                    zbuf += i;
+                }
+                if (z->cmeth == ZIP_COMPMETH_DEFLATED) {
+                    z_stream stream;
+                    int err;
+                    unsigned char *cbuf = NULL;
+
+                    memset(&stream, 0, sizeof (stream));
+                    stream.zalloc = Z_NULL;
+                    stream.zfree = Z_NULL;
+                    stream.opaque = Z_NULL;
+                    stream.avail_in = z->nbytecompr;
+                        if (z->isenc) {
+                        unsigned int j;
+
+                        stream.avail_in -= 12;
+                        cbuf = (unsigned char *)
+                            Tcl_AttemptAlloc(stream.avail_in);
+                        if (cbuf == NULL) {
+                            goto merror0;
+                        }
+                        for (j = 0; j < stream.avail_in; j++) {
+                            ch = info->ubuf[j];
+                            cbuf[j] = zdecode(info->keys, crc32tab, ch);
+                        }
+                        stream.next_in = cbuf;
+                    } else {
+                        stream.next_in = zbuf;
+                    }
+                    stream.next_out = info->ubuf;
+                    stream.avail_out = info->nmax;
+                    if (inflateInit2(&stream, -15) != Z_OK) goto cerror0;
+                    err = inflate(&stream, Z_SYNC_FLUSH);
+                    inflateEnd(&stream);
+                    if ((err == Z_STREAM_END) || ((err == Z_OK) && (stream.avail_in == 0))) {
+                        if (cbuf != NULL) {
+                            memset(info->keys, 0, sizeof (info->keys));
+                            Tcl_Free((char *) cbuf);
+                        }
+                        goto wrapchan;
+                    }
+cerror0:
+                    if (cbuf != NULL) {
+                        memset(info->keys, 0, sizeof (info->keys));
+                        Tcl_Free((char *) cbuf);
+                    }
+                    if (info->ubuf != NULL) {
+                        Tcl_Free((char *) info->ubuf);
+                    }
+                    Tcl_Free((char *) info);
+                    ZIPFS_ERROR(interp,"decompression error");
+                    goto error;
+                } else if (z->isenc) {
+                    for (i = 0; i < z->nbyte - 12; i++) {
+                        ch = zbuf[i];
+                        info->ubuf[i] = zdecode(info->keys, crc32tab, ch);
+                    }
+                } else {
+                    memcpy(info->ubuf, zbuf, z->nbyte);
+                }
+                memset(info->keys, 0, sizeof (info->keys));
+                goto wrapchan;
+            }
+        }
+    } else if (z->data != NULL) {
+        flags |= TCL_READABLE;
+        info->iswr = 0;
+        info->iscompr = 0;
+        info->isdir = 0;
+        info->isenc = 0;
+        info->nbyte = z->nbyte;
+        info->nmax = 0;
+        info->ubuf = z->data;
+    } else {
+        flags |= TCL_READABLE;
+        info->iswr = 0;
+        info->iscompr = z->cmeth == ZIP_COMPMETH_DEFLATED;
+        info->ubuf = z->zipfile->data + z->offset;
+        info->isdir = z->isdir;
+        info->isenc = z->isenc;
+        info->nbyte = z->nbyte;
+        info->nmax = 0;
+        if (info->isenc) {
+            int len = z->zipfile->pwbuf[0];
+            char pwbuf[260];
+
+            for (i = 0; i < len; i++) {
+                ch = z->zipfile->pwbuf[len - i];
+                pwbuf[i] = (ch & 0x0f) | pwrot[(ch >> 4) & 0x0f];
+            }
+            pwbuf[i] = '\0';
+            init_keys(pwbuf, info->keys, crc32tab);
+            memset(pwbuf, 0, sizeof (pwbuf));
+            for (i = 0; i < 12; i++) {
+                ch = info->ubuf[i];
+                zdecode(info->keys, crc32tab, ch);
+            }
+            info->ubuf += i;
+        }
+        if (info->iscompr) {
+            z_stream stream;
+            int err;
+            unsigned char *ubuf = NULL;
+            unsigned int j;
+
+            memset(&stream, 0, sizeof (stream));
+            stream.zalloc = Z_NULL;
+            stream.zfree = Z_NULL;
+            stream.opaque = Z_NULL;
+            stream.avail_in = z->nbytecompr;
+            if (info->isenc) {
+                stream.avail_in -= 12;
+                ubuf = (unsigned char *) Tcl_AttemptAlloc(stream.avail_in);
+                if (ubuf == NULL) {
+                    info->ubuf = NULL;
+                    goto merror;
+                }
+                for (j = 0; j < stream.avail_in; j++) {
+                    ch = info->ubuf[j];
+                    ubuf[j] = zdecode(info->keys, crc32tab, ch);
+                }
+                stream.next_in = ubuf;
+                } else {
+                stream.next_in = info->ubuf;
+            }
+            stream.next_out = info->ubuf = (unsigned char *) Tcl_AttemptAlloc(info->nbyte);
+            if (info->ubuf == NULL) {
+merror:
+                if (ubuf != NULL) {
+                    info->isenc = 0;
+                    memset(info->keys, 0, sizeof (info->keys));
+                    Tcl_Free((char *) ubuf);
+                }
+                Tcl_Free((char *) info);
+                if (interp != NULL) {
+                    Tcl_SetObjResult(interp,
+                    Tcl_NewStringObj("out of memory", -1));
+                }
+                goto error;
+            }
+            stream.avail_out = info->nbyte;
+            if (inflateInit2(&stream, -15) != Z_OK) {
+                goto cerror;
+            }
+            err = inflate(&stream, Z_SYNC_FLUSH);
+            inflateEnd(&stream);
+            if ((err == Z_STREAM_END) || ((err == Z_OK) && (stream.avail_in == 0))) {
+                if (ubuf != NULL) {
+                    info->isenc = 0;
+                    memset(info->keys, 0, sizeof (info->keys));
+                    Tcl_Free((char *) ubuf);
+                }
+                goto wrapchan;
+            }
+cerror:
+            if (ubuf != NULL) {
+                info->isenc = 0;
+                memset(info->keys, 0, sizeof (info->keys));
+                Tcl_Free((char *) ubuf);
+            }
+            if (info->ubuf != NULL) {
+                Tcl_Free((char *) info->ubuf);
+            }
+            Tcl_Free((char *) info);
+            ZIPFS_ERROR(interp,"decompression error");
+            goto error;
+        }
+    }
+wrapchan:
+    sprintf(cname, "zipfs_%" TCL_LL_MODIFIER "x_%d", z->offset, ZipFS.idCount++);
+    z->zipfile->nopen++;
+    Unlock();
+    return Tcl_CreateChannel(&ZipChannelType, cname, (ClientData) info, flags);
+
+error:
+    Unlock();
+    return NULL;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipEntryStat --
+ *
+ *    This function implements the ZIP filesystem specific version
+ *    of the library version of stat.
+ *
+ * Results:
+ *    See stat documentation.
+ *
+ * Side effects:
+ *    See stat documentation.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipEntryStat(char *path, Tcl_StatBuf *buf)
+{
+    ZipEntry *z;
+    int ret = -1;
+
+    ReadLock();
+    z = ZipFSLookup(path);
+    if (z == NULL) goto done;
+
+    memset(buf, 0, sizeof (Tcl_StatBuf));
+    if (z->isdir) {
+        buf->st_mode = S_IFDIR | 0555;
+    } else {
+        buf->st_mode = S_IFREG | 0555;
+    }
+    buf->st_size = z->nbyte;
+    buf->st_mtime = z->timestamp;
+    buf->st_ctime = z->timestamp;
+    buf->st_atime = z->timestamp;
+    ret = 0;
+done:
+    Unlock();
+    return ret;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * ZipEntryAccess --
+ *
+ *    This function implements the ZIP filesystem specific version
+ *    of the library version of access.
+ *
+ * Results:
+ *    See access documentation.
+ *
+ * Side effects:
+ *    See access documentation.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+ZipEntryAccess(char *path, int mode)
+{
+    ZipEntry *z;
+
+    if (mode & 3) return -1;
+    ReadLock();
+    z = ZipFSLookup(path);
+    Unlock();
+    return (z != NULL) ? 0 : -1;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * Zip_FSOpenFileChannelProc --
+ *
+ * Results:
+ *
+ * Side effects:
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static Tcl_Channel
+Zip_FSOpenFileChannelProc(Tcl_Interp *interp, Tcl_Obj *pathPtr,
+              int mode, int permissions)
+{
+    int len;
+    if (!(pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr))) return NULL;
+    return ZipChannelOpen(interp, Tcl_GetStringFromObj(pathPtr, &len), mode, permissions);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * Zip_FSStatProc --
+ *
+ *    This function implements the ZIP filesystem specific version
+ *    of the library version of stat.
+ *
+ * Results:
+ *    See stat documentation.
+ *
+ * Side effects:
+ *    See stat documentation.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+Zip_FSStatProc(Tcl_Obj *pathPtr, Tcl_StatBuf *buf)
+{
+    int len;
+    if (!(pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr))) return -1;
+    return ZipEntryStat(Tcl_GetStringFromObj(pathPtr, &len), buf);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * Zip_FSAccessProc --
+ *
+ *    This function implements the ZIP filesystem specific version
+ *    of the library version of access.
+ *
+ * Results:
+ *    See access documentation.
+ *
+ * Side effects:
+ *    See access documentation.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+Zip_FSAccessProc(Tcl_Obj *pathPtr, int mode)
+{
+    int len;
+    if (!(pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr))) return -1;
+    return ZipEntryAccess(Tcl_GetStringFromObj(pathPtr, &len), mode);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * Zip_FSFilesystemSeparatorProc --
+ *
+ *    This function returns the separator to be used for a given path. The
+ *    object returned should have a refCount of zero
+ *
+ * Results:
+ *    A Tcl object, with a refCount of zero. If the caller needs to retain a
+ *    reference to the object, it should call Tcl_IncrRefCount, and should
+ *    otherwise free the object.
+ *
+ * Side effects:
+ *    None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+Zip_FSFilesystemSeparatorProc(Tcl_Obj *pathPtr)
+{
+    return Tcl_NewStringObj("/", -1);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * Zip_FSMatchInDirectoryProc --
+ *
+ *    This routine is used by the globbing code to search a directory for
+ *    all files which match a given pattern.
+ *
+ * Results:
+ *    The return value is a standard Tcl result indicating whether an
+ *    error occurred in globbing. Errors are left in interp, good
+ *    results are lappend'ed to resultPtr (which must be a valid object).
+ *
+ * Side effects:
+ *    None.
+ *
+ *-------------------------------------------------------------------------
+ */
+static int
+Zip_FSMatchInDirectoryProc(Tcl_Interp* interp, Tcl_Obj *result,
+               Tcl_Obj *pathPtr, const char *pattern,
+               Tcl_GlobTypeData *types)
+{
+    Tcl_HashEntry *hPtr;
+    Tcl_HashSearch search;
+    Tcl_Obj *normPathPtr;
+    int scnt, l, dirOnly = -1, prefixLen, strip = 0;
+    size_t len;
+    char *pat, *prefix, *path;
+    Tcl_DString dsPref;
+
+    if (!(normPathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr))) return -1;
+
+    if (types != NULL) {
+        dirOnly = (types->type & TCL_GLOB_TYPE_DIR) == TCL_GLOB_TYPE_DIR;
+    }
+
+    /* the prefix that gets prepended to results */
+    prefix = Tcl_GetStringFromObj(pathPtr, &prefixLen);
+
+    /* the (normalized) path we're searching */
+    path = Tcl_GetString(normPathPtr);
+    len = normPathPtr->length;
+
+    Tcl_DStringInit(&dsPref);
+    Tcl_DStringAppend(&dsPref, prefix, prefixLen);
+
+    if (strcmp(prefix, path) == 0) {
+        prefix = NULL;
+    } else {
+        strip = len + 1;
+    }
+    if (prefix != NULL) {
+        Tcl_DStringAppend(&dsPref, "/", 1);
+        prefixLen++;
+        prefix = Tcl_DStringValue(&dsPref);
+    }
+    ReadLock();
+    if ((types != NULL) && (types->type == TCL_GLOB_TYPE_MOUNT)) {
+    l = CountSlashes(path);
+    if (path[len - 1] == '/') {
+        len--;
+    } else {
+        l++;
+    }
+    if ((pattern == NULL) || (pattern[0] == '\0')) {
+        pattern = "*";
+    }
+    hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search);
+    while (hPtr != NULL) {
+        ZipFile *zf = (ZipFile *) Tcl_GetHashValue(hPtr);
+
+        if (zf->mntptlen == 0) {
+            ZipEntry *z = zf->topents;
+            while (z != NULL) {
+                size_t lenz = strlen(z->name);
+                if (
+                    (lenz > len + 1)
+                    && (strncmp(z->name, path, len) == 0)
+                    && (z->name[len] == '/')
+                    && (CountSlashes(z->name) == l)
+                    && Tcl_StringCaseMatch(z->name + len + 1, pattern, 0)
+                ) {
+                    if (prefix != NULL) {
+                        Tcl_DStringAppend(&dsPref, z->name, lenz);
+                        Tcl_ListObjAppendElement(
+                            NULL, result,
+                            Tcl_NewStringObj(Tcl_DStringValue(&dsPref),
+                            Tcl_DStringLength(&dsPref))
+                        );
+                        Tcl_DStringSetLength(&dsPref, prefixLen);
+                    } else {
+                        Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj(z->name, lenz));
+                    }
+                }
+                z = z->tnext;
+            }
+        } else if (
+            (zf->mntptlen > len + 1)
+            && (strncmp(zf->mntpt, path, len) == 0)
+            && (zf->mntpt[len] == '/')
+            && (CountSlashes(zf->mntpt) == l)
+            && Tcl_StringCaseMatch(zf->mntpt + len + 1, pattern, 0)
+        ) {
+            if (prefix != NULL) {
+                Tcl_DStringAppend(&dsPref, zf->mntpt, zf->mntptlen);
+                Tcl_ListObjAppendElement(NULL, result,
+                    Tcl_NewStringObj(Tcl_DStringValue(&dsPref),
+                    Tcl_DStringLength(&dsPref)));
+                Tcl_DStringSetLength(&dsPref, prefixLen);
+            } else {
+                Tcl_ListObjAppendElement(NULL, result,
+                    Tcl_NewStringObj(zf->mntpt, zf->mntptlen));
+            }
+        }
+        hPtr = Tcl_NextHashEntry(&search);
+    }
+    goto end;
+    }
+    if ((pattern == NULL) || (pattern[0] == '\0')) {
+    hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, path);
+    if (hPtr != NULL) {
+        ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr);
+
+        if ((dirOnly < 0) ||
+            (!dirOnly && !z->isdir) ||
+            (dirOnly && z->isdir)) {
+        if (prefix != NULL) {
+            Tcl_DStringAppend(&dsPref, z->name, -1);
+            Tcl_ListObjAppendElement(NULL, result,
+                Tcl_NewStringObj(Tcl_DStringValue(&dsPref),
+                Tcl_DStringLength(&dsPref)));
+            Tcl_DStringSetLength(&dsPref, prefixLen);
+        } else {
+            Tcl_ListObjAppendElement(NULL, result,
+                Tcl_NewStringObj(z->name, -1));
+        }
+        }
+    }
+    goto end;
+    }
+    l = strlen(pattern);
+    pat = Tcl_Alloc(len + l + 2);
+    memcpy(pat, path, len);
+    while ((len > 1) && (pat[len - 1] == '/')) {
+        --len;
+    }
+    if ((len > 1) || (pat[0] != '/')) {
+        pat[len] = '/';
+        ++len;
+    }
+    memcpy(pat + len, pattern, l + 1);
+    scnt = CountSlashes(pat);
+    for (
+        hPtr = Tcl_FirstHashEntry(&ZipFS.fileHash, &search);
+        hPtr != NULL;
+        hPtr = Tcl_NextHashEntry(&search)
+    ) {
+        ZipEntry *z = (ZipEntry *) Tcl_GetHashValue(hPtr);
+        if (
+            (dirOnly >= 0) && ((dirOnly && !z->isdir) || (!dirOnly && z->isdir))
+        ) {
+            continue;
+        }
+        if ((z->depth == scnt) && Tcl_StringCaseMatch(z->name, pat, 0)) {
+            if (prefix != NULL) {
+                Tcl_DStringAppend(&dsPref, z->name + strip, -1);
+                Tcl_ListObjAppendElement(
+                    NULL, result,
+                    Tcl_NewStringObj(Tcl_DStringValue(&dsPref),
+                    Tcl_DStringLength(&dsPref))
+                );
+                Tcl_DStringSetLength(&dsPref, prefixLen);
+            } else {
+                Tcl_ListObjAppendElement(NULL, result, Tcl_NewStringObj(z->name + strip, -1));
+            }
+        }
+    }
+    Tcl_Free(pat);
+end:
+    Unlock();
+    Tcl_DStringFree(&dsPref);
+    return TCL_OK;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * Zip_FSPathInFilesystemProc --
+ *
+ *    This function determines if the given path object is in the
+ *    ZIP filesystem.
+ *
+ * Results:
+ *    TCL_OK when the path object is in the ZIP filesystem, -1 otherwise.
+ *
+ * Side effects:
+ *    None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+Zip_FSPathInFilesystemProc(Tcl_Obj *pathPtr, ClientData *clientDataPtr)
+{
+    Tcl_HashEntry *hPtr;
+    Tcl_HashSearch search;
+    ZipFile *zf;
+    int ret = -1;
+    size_t len;
+    char *path;
+
+    if (!(pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr))) return -1;
+
+    path = Tcl_GetString(pathPtr);
+    if(strncmp(path,ZIPFS_VOLUME,ZIPFS_VOLUME_LEN)!=0) {
+        return -1;
+    }
+
+    len = pathPtr->length;
+
+    ReadLock();
+    hPtr = Tcl_FindHashEntry(&ZipFS.fileHash, path);
+    if (hPtr != NULL) {
+        ret = TCL_OK;
+        goto endloop;
+    }
+    hPtr = Tcl_FirstHashEntry(&ZipFS.zipHash, &search);
+    while (hPtr != NULL) {
+        zf = (ZipFile *) Tcl_GetHashValue(hPtr);
+        if (zf->mntptlen == 0) {
+            ZipEntry *z = zf->topents;
+            while (z != NULL) {
+                size_t lenz = strlen(z->name);
+                if (
+                    (len >= lenz) && (strncmp(path, z->name, lenz) == 0)
+                ) {
+                    ret = TCL_OK;
+                    goto endloop;
+                }
+                z = z->tnext;
+            }
+        } else if (
+            (len >= zf->mntptlen) && (strncmp(path, zf->mntpt, zf->mntptlen) == 0)
+        ) {
+            ret = TCL_OK;
+            goto endloop;
+        }
+        hPtr = Tcl_NextHashEntry(&search);
+    }
+endloop:
+    Unlock();
+    return ret;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * Zip_FSListVolumesProc --
+ *
+ *    Lists the currently mounted ZIP filesystem volumes.
+ *
+ * Results:
+ *    The list of volumes.
+ *
+ * Side effects:
+ *    None
+ *
+ *-------------------------------------------------------------------------
+ */
+static Tcl_Obj *
+Zip_FSListVolumesProc(void) {
+    return Tcl_NewStringObj(ZIPFS_VOLUME, -1);
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * Zip_FSFileAttrStringsProc --
+ *
+ *    This function implements the ZIP filesystem dependent 'file attributes'
+ *    subcommand, for listing the set of possible attribute strings.
+ *
+ * Results:
+ *    An array of strings
+ *
+ * Side effects:
+ *    None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static const char *const *
+Zip_FSFileAttrStringsProc(Tcl_Obj *pathPtr, Tcl_Obj** objPtrRef)
+{
+    static const char *const attrs[] = {
+    "-uncompsize",
+    "-compsize",
+    "-offset",
+    "-mount",
+    "-archive",
+    "-permissions",
+    NULL,
+    };
+    return attrs;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * Zip_FSFileAttrsGetProc --
+ *
+ *    This function implements the ZIP filesystem specific
+ *    'file attributes' subcommand, for 'get' operations.
+ *
+ * Results:
+ *    Standard Tcl return code. The object placed in objPtrRef (if TCL_OK
+ *    was returned) is likely to have a refCount of zero. Either way we must
+ *    either store it somewhere (e.g. the Tcl result), or Incr/Decr its
+ *    refCount to ensure it is properly freed.
+ *
+ * Side effects:
+ *    None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+Zip_FSFileAttrsGetProc(Tcl_Interp *interp, int index, Tcl_Obj *pathPtr,
+               Tcl_Obj **objPtrRef)
+{
+    int len, ret = TCL_OK;
+    char *path;
+    ZipEntry *z;
+
+    if (!(pathPtr = Tcl_FSGetNormalizedPath(NULL, pathPtr))) return -1;
+    path = Tcl_GetStringFromObj(pathPtr, &len);
+    ReadLock();
+    z = ZipFSLookup(path);
+    if (z == NULL) {
+        ZIPFS_ERROR(interp,"file not found");
+        ret = TCL_ERROR;
+        goto done;
+    }
+    switch (index) {
+        case 0:
+        *objPtrRef = Tcl_NewWideIntObj(z->nbyte);
+        goto done;
+        case 1:
+        *objPtrRef = Tcl_NewWideIntObj(z->nbytecompr);
+        goto done;
+        case 2:
+        *objPtrRef= Tcl_NewWideIntObj(z->offset);
+        goto done;
+        case 3:
+        *objPtrRef= Tcl_NewStringObj(z->zipfile->mntpt, z->zipfile->mntptlen);
+        goto done;
+        case 4:
+        *objPtrRef= Tcl_NewStringObj(z->zipfile->name, -1);
+        goto done;
+        case 5:
+        *objPtrRef= Tcl_NewStringObj("0555", -1);
+        goto done;
+    }
+    ZIPFS_ERROR(interp,"unknown attribute");
+    ret = TCL_ERROR;
+done:
+    Unlock();
+    return ret;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * Zip_FSFileAttrsSetProc --
+ *
+ *    This function implements the ZIP filesystem specific
+ *    'file attributes' subcommand, for 'set' operations.
+ *
+ * Results:
+ *    Standard Tcl return code.
+ *
+ * Side effects:
+ *    None.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+Zip_FSFileAttrsSetProc(Tcl_Interp *interp, int index, Tcl_Obj *pathPtr,Tcl_Obj *objPtr)
+{
+    if (interp != NULL) {
+        Tcl_SetObjResult(interp, Tcl_NewStringObj("unsupported operation", -1));
+    }
+    return TCL_ERROR;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * Zip_FSFilesystemPathTypeProc --
+ *
+ * Results:
+ *
+ * Side effects:
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static Tcl_Obj *
+Zip_FSFilesystemPathTypeProc(Tcl_Obj *pathPtr)
+{
+    return Tcl_NewStringObj("zip", -1);
+}
+
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * Zip_FSLoadFile --
+ *
+ *        This functions deals with loading native object code. If
+ *        the given path object refers to a file within the ZIP
+ *        filesystem, an approriate error code is returned to delegate
+ *        loading to the caller (by copying the file to temp store
+ *        and loading from there). As fallback when the file refers
+ *        to the ZIP file system but is not present, it is looked up
+ *        relative to the executable and loaded from there when available.
+ *
+ * Results:
+ *        TCL_OK on success, TCL_ERROR otherwise with error message left.
+ *
+ * Side effects:
+ *        Loads native code into the process address space.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+static int
+Zip_FSLoadFile(Tcl_Interp *interp, Tcl_Obj *path, Tcl_LoadHandle *loadHandle,
+               Tcl_FSUnloadFileProc **unloadProcPtr, int flags)
+{
+    Tcl_FSLoadFileProc2 *loadFileProc;
+#ifdef ANDROID
+    /*
+     * Force loadFileProc to native implementation since the
+     * package manager already extracted the shared libraries
+     * from the APK at install time.
+     */
+
+    loadFileProc = (Tcl_FSLoadFileProc2 *) tclNativeFilesystem.loadFileProc;
+    if (loadFileProc != NULL) {
+        return loadFileProc(interp, path, loadHandle, unloadProcPtr, flags);
+    }
+    Tcl_SetErrno(ENOENT);
+    ZIPFS_ERROR(interp,Tcl_PosixError(interp));
+    return TCL_ERROR;
+#else
+    Tcl_Obj *altPath = NULL;
+    int ret = TCL_ERROR;
+
+    if (Tcl_FSAccess(path, R_OK) == 0) {
+        /*
+         * EXDEV should trigger loading by copying to temp store.
+         */
+
+        Tcl_SetErrno(EXDEV);
+        ZIPFS_ERROR(interp,Tcl_PosixError(interp));
+        return ret;
+    } else {
+        Tcl_Obj *objs[2] = { NULL, NULL };
+
+        objs[1] = TclPathPart(interp, path, TCL_PATH_DIRNAME);
+        if ((objs[1] != NULL) && (Zip_FSAccessProc(objs[1], R_OK) == 0)) {
+            const char *execName = Tcl_GetNameOfExecutable();
+
+            /*
+             * Shared object is not in ZIP but its path prefix is,
+             * thus try to load from directory where the executable
+             * came from.
+             */
+            TclDecrRefCount(objs[1]);
+            objs[1] = TclPathPart(interp, path, TCL_PATH_TAIL);
+            /*
+             * Get directory name of executable manually to deal
+             * with cases where [file dirname [info nameofexecutable]]
+             * is equal to [info nameofexecutable] due to VFS effects.
+             */
+            if (execName != NULL) {
+                const char *p = strrchr(execName, '/');
+
+                if (p > execName + 1) {
+                    --p;
+                    objs[0] = Tcl_NewStringObj(execName, p - execName);
+                }
+            }
+            if (objs[0] == NULL) {
+                objs[0] = TclPathPart(interp, TclGetObjNameOfExecutable(),
+                                          TCL_PATH_DIRNAME);
+            }
+            if (objs[0] != NULL) {
+                altPath = TclJoinPath(2, objs);
+                if (altPath != NULL) {
+                    Tcl_IncrRefCount(altPath);
+                    if (Tcl_FSAccess(altPath, R_OK) == 0) {
+                        path = altPath;
+                    }
+                }
+            }
+        }
+        if (objs[0] != NULL) {
+            Tcl_DecrRefCount(objs[0]);
+        }
+        if (objs[1] != NULL) {
+            Tcl_DecrRefCount(objs[1]);
+        }
+    }
+    loadFileProc = (Tcl_FSLoadFileProc2 *) tclNativeFilesystem.loadFileProc;
+    if (loadFileProc != NULL) {
+        ret = loadFileProc(interp, path, loadHandle, unloadProcPtr, flags);
+    } else {
+        Tcl_SetErrno(ENOENT);
+        ZIPFS_ERROR(interp,Tcl_PosixError(interp));
+    }
+    if (altPath != NULL) {
+        Tcl_DecrRefCount(altPath);
+    }
+    return ret;
+#endif
+}
+
+#endif /* HAVE_ZLIB */
+
+
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * TclZipfs_Init --
+ *
+ *    Perform per interpreter initialization of this module.
+ *
+ * Results:
+ *    The return value is a standard Tcl result.
+ *
+ * Side effects:
+ *    Initializes this module if not already initialized, and adds
+ *    module related commands to the given interpreter.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+MODULE_SCOPE int
+TclZipfs_Init(Tcl_Interp *interp)
+{
+#ifdef HAVE_ZLIB
+    /* one-time initialization */
+    WriteLock();
+    /* Tcl_StaticPackage(interp, "zipfs", TclZipfs_Init, TclZipfs_Init); */
+    if (!ZipFS.initialized) {
+        TclZipfs_C_Init();
+    }
+    Unlock();
+    if(interp != NULL) {
+        static const EnsembleImplMap initMap[] = {
+            {"mkimg",      ZipFSMkImgObjCmd,    NULL, NULL, NULL, 0},
+            {"mkzip",      ZipFSMkZipObjCmd,    NULL, NULL, NULL, 0},
+            {"lmkimg",      ZipFSLMkImgObjCmd,    NULL, NULL, NULL, 0},
+            {"lmkzip",      ZipFSLMkZipObjCmd,    NULL, NULL, NULL, 0},
+            /* The 4 entries above are not available in safe interpreters */
+            {"mount",      ZipFSMountObjCmd,    NULL, NULL, NULL, 0},
+            {"mount_data",      ZipFSMountBufferObjCmd,    NULL, NULL, NULL, 0},
+            {"unmount",      ZipFSUnmountObjCmd,    NULL, NULL, NULL, 0},
+            {"mkkey",      ZipFSMkKeyObjCmd,    NULL, NULL, NULL, 0},
+            {"exists",      ZipFSExistsObjCmd,    NULL, NULL, NULL, 1},
+            {"info",      ZipFSInfoObjCmd,    NULL, NULL, NULL, 1},
+            {"list",      ZipFSListObjCmd,    NULL, NULL, NULL, 1},
+            {"canonical", ZipFSCanonicalObjCmd, NULL, NULL, NULL, 1},
+            {"root",      ZipFSRootObjCmd, NULL, NULL, NULL, 1},
+            {"tcl_library",      ZipFSTclLibraryObjCmd,    NULL, NULL, NULL, 0},
+
+            {NULL, NULL, NULL, NULL, NULL, 0}
+        };
+        static const char findproc[] =
+            "namespace eval ::tcl::zipfs::zipfs {}\n"
+            "proc ::tcl::zipfs::find dir {\n"
+            " set result {}\n"
+            " if {[catch {glob -directory $dir -tails -nocomplain * .*} list]} {\n"
+            "  return $result\n"
+            " }\n"
+            " foreach file $list {\n"
+            "  if {$file eq \".\" || $file eq \"..\"} {\n"
+            "   continue\n"
+            "  }\n"
+            "  set file [file join $dir $file]\n"
+            "  lappend result $file\n"
+            "  foreach file [::tcl::zipfs::find $file] {\n"
+            "   lappend result $file\n"
+            "  }\n"
+            " }\n"
+            " return [lsort $result]\n"
+            "}\n";
+        Tcl_EvalEx(interp, findproc, -1, TCL_EVAL_GLOBAL);
+        Tcl_LinkVar(interp, "::tcl::zipfs::wrmax", (char *) &ZipFS.wrmax,TCL_LINK_INT);
+        TclMakeEnsemble(interp, "zipfs", Tcl_IsSafe(interp) ? (initMap+4) : initMap);
+        Tcl_PkgProvide(interp, "zipfs", "2.0");
+    }
+    return TCL_OK;
+#else
+    ZIPFS_ERROR(interp,"no zlib available");
+    return TCL_ERROR;
+#endif
+}
+
+static int TclZipfs_AppHook_FindTclInit(const char *archive){
+    Tcl_Obj *vfsinitscript;
+    int found;
+    if(zipfs_literal_tcl_library) {
+        return TCL_ERROR;
+    }
+    if(TclZipfs_Mount(NULL, ZIPFS_ZIP_MOUNT, archive, NULL)) {
+        /* Either the file doesn't exist or it is not a zip archive */
+        return TCL_ERROR;
+    }
+    vfsinitscript=Tcl_NewStringObj(ZIPFS_ZIP_MOUNT "/init.tcl",-1);
+    Tcl_IncrRefCount(vfsinitscript);
+    found=Tcl_FSAccess(vfsinitscript,F_OK);
+    Tcl_DecrRefCount(vfsinitscript);
+    if(found==0) {
+        zipfs_literal_tcl_library=ZIPFS_ZIP_MOUNT;
+        return TCL_OK;
+    }
+    vfsinitscript=Tcl_NewStringObj(ZIPFS_ZIP_MOUNT "/tcl_library/init.tcl",-1);
+    Tcl_IncrRefCount(vfsinitscript);
+    found=Tcl_FSAccess(vfsinitscript,F_OK);
+    Tcl_DecrRefCount(vfsinitscript);
+    if(found==0) {
+        zipfs_literal_tcl_library=ZIPFS_ZIP_MOUNT "/tcl_library";
+        return TCL_OK;
+    }
+    return TCL_ERROR;
+}
+
+#ifdef _WIN32
+int TclZipfs_AppHook(int *argc, TCHAR ***argv)
+#else
+int TclZipfs_AppHook(int *argc, char ***argv)
+#endif
+{
+#ifdef _WIN32
+    Tcl_DString ds;
+#endif
+    /*
+     * Tclkit_MainHook --
+     * Performs the argument munging for the shell
+     */
+    char *archive;
+
+    Tcl_FindExecutable((*argv)[0]);
+    archive=(char *)Tcl_GetNameOfExecutable();
+    TclZipfs_Init(NULL);
+    /*
+    ** Look for init.tcl in one of the locations mounted later in this function
+    */
+    if(!TclZipfs_Mount(NULL, ZIPFS_APP_MOUNT, archive, NULL)) {
+        int found;
+        Tcl_Obj *vfsinitscript;
+        vfsinitscript=Tcl_NewStringObj(ZIPFS_APP_MOUNT "/main.tcl",-1);
+        Tcl_IncrRefCount(vfsinitscript);
+        if(Tcl_FSAccess(vfsinitscript,F_OK)==0) {
+            /* Startup script should be set before calling Tcl_AppInit */
+            Tcl_SetStartupScript(vfsinitscript,NULL);
+        } else {
+            Tcl_DecrRefCount(vfsinitscript);
+        }
+        /* Set Tcl Encodings */
+        if(!zipfs_literal_tcl_library) {
+            vfsinitscript=Tcl_NewStringObj(ZIPFS_APP_MOUNT "/tcl_library/init.tcl",-1);
+            Tcl_IncrRefCount(vfsinitscript);
+            found=Tcl_FSAccess(vfsinitscript,F_OK);
+            Tcl_DecrRefCount(vfsinitscript);
+            if(found==TCL_OK) {
+                zipfs_literal_tcl_library=ZIPFS_APP_MOUNT "/tcl_library";
+                return TCL_OK;
+            }
+        }
+    } else if (*argc>1) {
+        return TCL_OK;
+#ifdef _WIN32
+        archive = Tcl_WinTCharToUtf((*argv)[1], -1, &ds);
+#else
+        archive=(*argv)[1];
+#endif
+        if (strcmp(archive,"install")==0) {
+            /* If the first argument is mkzip, run the mkzip program */
+            Tcl_Obj *vfsinitscript;
+            /* Run this now to ensure the file is present by the time Tcl_Main wants it */
+            TclZipfs_TclLibrary();
+            vfsinitscript=Tcl_NewStringObj(ZIPFS_ZIP_MOUNT "/tcl_library/install.tcl",-1);
+            Tcl_IncrRefCount(vfsinitscript);
+            if(Tcl_FSAccess(vfsinitscript,F_OK)==0) {
+             Tcl_SetStartupScript(vfsinitscript,NULL);
+            }
+            return TCL_OK;
+        } else {
+            if(!TclZipfs_Mount(NULL, ZIPFS_APP_MOUNT, archive, NULL)) {
+                int found;
+                Tcl_Obj *vfsinitscript;
+                vfsinitscript=Tcl_NewStringObj(ZIPFS_APP_MOUNT "/main.tcl",-1);
+                Tcl_IncrRefCount(vfsinitscript);
+                if(Tcl_FSAccess(vfsinitscript,F_OK)==0) {
+                    /* Startup script should be set before calling Tcl_AppInit */
+                    Tcl_SetStartupScript(vfsinitscript,NULL);
+                } else {
+                    Tcl_DecrRefCount(vfsinitscript);
+                }
+                /* Set Tcl Encodings */
+                vfsinitscript=Tcl_NewStringObj(ZIPFS_APP_MOUNT "/tcl_library/init.tcl",-1);
+                Tcl_IncrRefCount(vfsinitscript);
+                found=Tcl_FSAccess(vfsinitscript,F_OK);
+                Tcl_DecrRefCount(vfsinitscript);
+                if(found==TCL_OK) {
+                    zipfs_literal_tcl_library=ZIPFS_APP_MOUNT "/tcl_library";
+                    return TCL_OK;
+                }
+            }
+        }
+#ifdef _WIN32
+        Tcl_DStringFree(&ds);
+#endif
+    }
+    return TCL_OK;
+}
+
+
+#ifndef HAVE_ZLIB
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * TclZipfs_Mount, TclZipfs_Unmount --
+ *
+ *    Dummy version when no ZLIB support available.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+int
+TclZipfs_Mount(Tcl_Interp *interp, const char *mntpt, const char *zipname,
+        const char *passwd)
+{
+    return TclZipfs_Init(interp, 1);
+}
+
+int
+TclZipfs_Unmount(Tcl_Interp *interp, const char *zipname)
+{
+    return TclZipfs_Init(interp, 1);
+}
+
+#endif
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclZlib.c b/generic/tclZlib.c
index 994bcef..644ac8b 100644
--- a/generic/tclZlib.c
+++ b/generic/tclZlib.c
@@ -3909,6 +3909,12 @@ TclZlibInit(
     Tcl_RegisterConfig(interp, "zlib", cfg, "iso8859-1");
 
     /*
+     * Allow command type introspection to do something sensible with streams.
+     */
+
+    TclRegisterCommandTypeName(ZlibStreamCmd, "zlibStream");
+
+    /*
      * Formally provide the package as a Tcl built-in.
      */
 
diff --git a/library/auto.tcl b/library/auto.tcl
index a7a8979..d8f9d88 100644
--- a/library/auto.tcl
+++ b/library/auto.tcl
@@ -74,6 +74,54 @@ proc tcl_findLibrary {basename version patch initScript enVarName varName} {
             lappend dirs $env($enVarName)
         }
 
+	catch {
+      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]
+	    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 $dllfile $mountpoint
+	        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"]
+  	      }
+          foreach path $paths {
+            set archive [file join $path $zipfile]
+            if {![file exists $archive]} continue
+            zipfs mount $archive $mountpoint
+            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.
 
diff --git a/library/http/http.tcl b/library/http/http.tcl
index 186d067..f82bced 100644
--- a/library/http/http.tcl
+++ b/library/http/http.tcl
@@ -11,7 +11,7 @@
 package require Tcl 8.6-
 # Keep this in sync with pkgIndex.tcl and with the install directories in
 # Makefiles
-package provide http 2.8.13
+package provide http 2.9.0
 
 namespace eval http {
     # Allow resourcing to not clobber existing data
@@ -20,26 +20,30 @@ namespace eval http {
     if {![info exists http]} {
 	array set http {
 	    -accept */*
+	    -pipeline 1
+	    -postfresh 0
 	    -proxyhost {}
 	    -proxyport {}
 	    -proxyfilter http::ProxyRequired
+	    -repost 0
 	    -urlencoding utf-8
+	    -zip 1
 	}
-	# We need a useragent string of this style or various servers will refuse to
-	# send us compressed content even when we ask for it. This follows the
-	# de-facto layout of user-agent strings in current browsers.
+	# We need a useragent string of this style or various servers will
+	# refuse to send us compressed content even when we ask for it. This
+	# follows the de-facto layout of user-agent strings in current browsers.
 	# Safe interpreters do not have ::tcl_platform(os) or
 	# ::tcl_platform(osVersion).
 	if {[interp issafe]} {
 	    set http(-useragent) "Mozilla/5.0\
-                (Windows; U;\
-                Windows NT 10.0)\
-                http/[package provide http] Tcl/[package provide Tcl]"
+		(Windows; U;\
+		Windows NT 10.0)\
+		http/[package provide http] Tcl/[package provide Tcl]"
 	} else {
 	    set http(-useragent) "Mozilla/5.0\
-                ([string totitle $::tcl_platform(platform)]; U;\
-                $::tcl_platform(os) $::tcl_platform(osVersion))\
-                http/[package provide http] Tcl/[package provide Tcl]"
+		([string totitle $::tcl_platform(platform)]; U;\
+		$::tcl_platform(os) $::tcl_platform(osVersion))\
+		http/[package provide http] Tcl/[package provide Tcl]"
 	}
     }
 
@@ -60,14 +64,42 @@ namespace eval http {
 	variable formMap [array get map]
 
 	# Create a map for HTTP/1.1 open sockets
-	variable socketmap
-	if {[info exists socketmap]} {
-	    # Close but don't remove open sockets on re-init
-	    foreach {url sock} [array get socketmap] {
-		catch {close $sock}
+	variable socketMapping
+	variable socketRdState
+	variable socketWrState
+	variable socketRdQueue
+	variable socketWrQueue
+	variable socketClosing
+	variable socketPlayCmd
+	if {[info exists socketMapping]} {
+	    # Close open sockets on re-init.  Do not permit retries.
+	    foreach {url sock} [array get socketMapping] {
+		unset -nocomplain socketClosing($url)
+		unset -nocomplain socketPlayCmd($url)
+		CloseSocket $sock
 	    }
 	}
-	array set socketmap {}
+
+	# CloseSocket should have unset the socket* arrays, one element at
+	# a time.  Now unset anything that was overlooked.
+	# Traces on "unset socketRdState(*)" will call CancelReadPipeline and
+	# cancel any queued responses.
+	# Traces on "unset socketWrState(*)" will call CancelWritePipeline and
+	# cancel any queued requests.
+	array unset socketMapping
+	array unset socketRdState
+	array unset socketWrState
+	array unset socketRdQueue
+	array unset socketWrQueue
+	array unset socketClosing
+	array unset socketPlayCmd
+	array set socketMapping {}
+	array set socketRdState {}
+	array set socketWrState {}
+	array set socketRdQueue {}
+	array set socketWrQueue {}
+	array set socketClosing {}
+	array set socketPlayCmd {}
     }
     init
 
@@ -95,8 +127,13 @@ namespace eval http {
 	set defaultKeepalive 0
     }
 
-    namespace export geturl config reset wait formatQuery register unregister
-    # Useful, but not exported: data size status code
+    namespace export geturl config reset wait formatQuery quoteString
+    namespace export register unregister registerError
+    # - Useful, but not exported: data, size, status, code, cleanup, error,
+    #   meta, ncode, mapReply, init.  Comments suggest that "init" can be used
+    #   for re-initialisation, although the command is undocumented.
+    # - Not exported, probably should be upper-case initial letter as part
+    #   of the internals: getTextLine, make-transformation-chunked.
 }
 
 # http::Log --
@@ -190,40 +227,279 @@ proc http::config {args} {
 # Arguments:
 #	token	    Connection token.
 #	errormsg    (optional) If set, forces status to error.
-#       skipCB      (optional) If set, don't call the -command callback. This
+#	skipCB      (optional) If set, don't call the -command callback. This
 #		    is useful when geturl wants to throw an exception instead
 #		    of calling the callback. That way, the same error isn't
 #		    reported to two places.
 #
 # Side Effects:
-#        Closes the socket
+#        May close the socket.
 
 proc http::Finish {token {errormsg ""} {skipCB 0}} {
+    variable socketMapping
+    variable socketRdState
+    variable socketWrState
+    variable socketRdQueue
+    variable socketWrQueue
+    variable socketClosing
+    variable socketPlayCmd
+
     variable $token
     upvar 0 $token state
     global errorInfo errorCode
+    set closeQueue 0
     if {$errormsg ne ""} {
 	set state(error) [list $errormsg $errorInfo $errorCode]
 	set state(status) "error"
     }
-    if { ($state(status) eq "timeout")
+    if {[info commands ${token}EventCoroutine] ne {}} {
+	rename ${token}EventCoroutine {}
+    }
+    if {  ($state(status) eq "timeout")
        || ($state(status) eq "error")
+       || ($state(status) eq "eof")
        || ([info exists state(-keepalive)] && !$state(-keepalive))
        || ([info exists state(connection)] && ($state(connection) eq "close"))
     } {
-        CloseSocket $state(sock) $token
+	set closeQueue 1
+	set connId $state(socketinfo)
+	set sock $state(sock)
+	CloseSocket $state(sock) $token
+    } elseif {
+	  ([info exists state(-keepalive)] && $state(-keepalive))
+       && ([info exists state(connection)] && ($state(connection) ne "close"))
+    } {
+	KeepSocket $token
     }
     if {[info exists state(after)]} {
 	after cancel $state(after)
+	unset state(after)
     }
-    if {[info exists state(-command)] && !$skipCB
-	    && ![info exists state(done-command-cb)]} {
+    if {[info exists state(-command)] && (!$skipCB)
+	    && (![info exists state(done-command-cb)])} {
 	set state(done-command-cb) yes
 	if {[catch {eval $state(-command) {$token}} err] && $errormsg eq ""} {
 	    set state(error) [list $err $errorInfo $errorCode]
 	    set state(status) error
 	}
     }
+
+    if {    $closeQueue
+	 && [info exists socketMapping($connId)]
+	 && ($socketMapping($connId) eq $sock)
+    } {
+	http::CloseQueuedQueries $connId $token
+    }
+}
+
+# http::KeepSocket -
+#
+#	Keep a socket in the persistent sockets table and connect it to its next
+#	queued task if possible.  Otherwise leave it idle and ready for its next
+#	use.
+#
+#	If $socketClosing(*), then ($state(connection) eq "close") and therefore
+#	this command will not be called by Finish.
+#
+# Arguments:
+#	token	    Connection token.
+
+proc http::KeepSocket {token} {
+    variable http
+    variable socketMapping
+    variable socketRdState
+    variable socketWrState
+    variable socketRdQueue
+    variable socketWrQueue
+    variable socketClosing
+    variable socketPlayCmd
+
+    variable $token
+    upvar 0 $token state
+    set tk [namespace tail $token]
+
+    # Keep this socket open for another request ("Keep-Alive").
+    # React if the server half-closes the socket.
+    # Discussion is in http::geturl.
+    catch {fileevent $state(sock) readable [list http::CheckEof $state(sock)]}
+
+    # The line below should not be changed in production code.
+    # It is edited by the test suite.
+    set TEST_EOF 0
+    if {$TEST_EOF} {
+	# ONLY for testing reaction to server eof.
+	# No server timeouts will be caught.
+	catch {fileevent $state(sock) readable {}}
+    }
+
+    if {    [info exists state(socketinfo)]
+	 && [info exists socketMapping($state(socketinfo))]
+    } {
+	set connId $state(socketinfo)
+	# The value "Rready" is set only here.
+	set socketRdState($connId) Rready
+
+	if {    $state(-pipeline)
+	     && [info exists socketRdQueue($connId)]
+	     && [llength $socketRdQueue($connId)]
+	} {
+	    # The usual case for pipelined responses - if another response is
+	    # queued, arrange to read it.
+	    set token3 [lindex $socketRdQueue($connId) 0]
+	    set socketRdQueue($connId) [lrange $socketRdQueue($connId) 1 end]
+	    variable $token3
+	    upvar 0 $token3 state3
+	    set tk2 [namespace tail $token3]
+
+	    #Log pipelined, GRANT read access to $token3 in KeepSocket
+	    set socketRdState($connId) $token3
+	    ReceiveResponse $token3
+
+	    # Other pipelined cases.
+	    # - The test above ensures that, for the pipelined cases in the two
+	    #   tests below, the read queue is empty.
+	    # - In those two tests, check whether the next write will be
+	    #   nonpipeline.
+	} elseif {
+		$state(-pipeline)
+	     && [info exists socketWrState($connId)]
+	     && ($socketWrState($connId) eq "peNding")
+
+	     && [info exists socketWrQueue($connId)]
+	     && [llength $socketWrQueue($connId)]
+	     && (![set token3 [lindex $socketWrQueue($connId) 0]
+		   set ${token3}(-pipeline)
+		  ]
+		)
+	} {
+	    # This case:
+	    # - Now it the time to run the "pending" request.
+	    # - The next token in the write queue is nonpipeline, and
+	    #   socketWrState has been marked "pending" (in
+	    #   http::NextPipelinedWrite or http::geturl) so a new pipelined
+	    #   request cannot jump the queue.
+	    #
+	    # Tests:
+	    # - In this case the read queue (tested above) is empty and this
+	    #   "pending" write token is in front of the rest of the write
+	    #   queue.
+	    # - The write state is not Wready and therefore appears to be busy,
+	    #   but because it is "pending" we know that it is reserved for the
+	    #   first item in the write queue, a non-pipelined request that is
+	    #   waiting for the read queue to empty.  That has now happened: so
+	    #   give that request read and write access.
+	    variable $token3
+	    set conn [set ${token3}(tmpConnArgs)]
+	    #Log nonpipeline, GRANT r/w access to $token3 in KeepSocket
+	    set socketRdState($connId) $token3
+	    set socketWrState($connId) $token3
+	    set socketWrQueue($connId) [lrange $socketWrQueue($connId) 1 end]
+	    # Connect does its own fconfigure.
+	    fileevent $state(sock) writable [list http::Connect $token3 {*}$conn]
+	    #Log ---- $state(sock) << conn to $token3 for HTTP request (c)
+
+	} elseif {
+		$state(-pipeline)
+	     && [info exists socketWrState($connId)]
+	     && ($socketWrState($connId) eq "peNding")
+
+	} {
+	    # Should not come here.  The second block in the previous "elseif"
+	    # test should be tautologous (but was needed in an earlier
+	    # implementation) and will be removed after testing.
+	    # If we get here, the value "pending" was assigned in error.
+	    # This error would block the queue for ever.
+	    Log ^X$tk <<<<< Error in queueing of requests >>>>> - token $token
+
+	} elseif {
+		$state(-pipeline)
+	     && [info exists socketWrState($connId)]
+	     && ($socketWrState($connId) eq "Wready")
+
+	     && [info exists socketWrQueue($connId)]
+	     && [llength $socketWrQueue($connId)]
+	     && (![set token3 [lindex $socketWrQueue($connId) 0]
+		   set ${token3}(-pipeline)
+		  ]
+		)
+	} {
+	    # This case:
+	    # - The next token in the write queue is nonpipeline, and
+	    #   socketWrState is Wready.  Get the next event from socketWrQueue.
+	    # Tests:
+	    # - In this case the read state (tested above) is Rready and the
+	    #   write state (tested here) is Wready - there is no "pending"
+	    #   request.
+	    # Code:
+	    # - The code is the same as the code below for the nonpipelined
+	    #   case with a queued request.
+	    variable $token3
+	    set conn [set ${token3}(tmpConnArgs)]
+	    #Log nonpipeline, GRANT r/w access to $token3 in KeepSocket
+	    set socketRdState($connId) $token3
+	    set socketWrState($connId) $token3
+	    set socketWrQueue($connId) [lrange $socketWrQueue($connId) 1 end]
+	    # Connect does its own fconfigure.
+	    fileevent $state(sock) writable [list http::Connect $token3 {*}$conn]
+	    #Log ---- $state(sock) << conn to $token3 for HTTP request (c)
+
+	} elseif {
+		(!$state(-pipeline))
+	     && [info exists socketWrQueue($connId)]
+	     && [llength $socketWrQueue($connId)]
+	     && ($state(connection) ne "close")
+	} {
+	    # If not pipelined, (socketRdState eq Rready) tells us that we are
+	    # ready for the next write - there is no need to check
+	    # socketWrState. Write the next request, if one is waiting.
+	    # If the next request is pipelined, it receives premature read
+	    # access to the socket. This is not a problem.
+	    set token3 [lindex $socketWrQueue($connId) 0]
+	    variable $token3
+	    set conn [set ${token3}(tmpConnArgs)]
+	    #Log nonpipeline, GRANT r/w access to $token3 in KeepSocket
+	    set socketRdState($connId) $token3
+	    set socketWrState($connId) $token3
+	    set socketWrQueue($connId) [lrange $socketWrQueue($connId) 1 end]
+	    # Connect does its own fconfigure.
+	    fileevent $state(sock) writable [list http::Connect $token3 {*}$conn]
+	    #Log ---- $state(sock) << conn to $token3 for HTTP request (d)
+
+	} elseif {(!$state(-pipeline))} {
+	    set socketWrState($connId) Wready
+	    # Rready and Wready and idle: nothing to do.
+	}
+
+    } else {
+	CloseSocket $state(sock) $token
+	# There is no socketMapping($state(socketinfo)), so it does not matter
+	# that CloseQueuedQueries is not called.
+    }
+}
+
+# http::CheckEof -
+#
+#	Read from a socket and close it if eof.
+#	The command is bound to "fileevent readable" on an idle socket, and
+#	"eof" is the only event that should trigger the binding, occurring when
+#	the server times out and half-closes the socket.
+#
+#	A read is necessary so that [eof] gives a meaningful result.
+#	Any bytes sent are junk (or a bug).
+
+proc http::CheckEof {sock} {
+    set junk [read $sock]
+    set n [string length $junk]
+    if {$n} {
+	Log "WARNING: $n bytes received but no HTTP request sent"
+    }
+
+    if {[catch {eof $sock} res] || $res} {
+	# The server has half-closed the socket.
+	# If a new write has started, its transaction will fail and
+	# will then be error-handled.
+	CloseSocket $sock
+    }
 }
 
 # http::CloseSocket -
@@ -231,44 +507,137 @@ proc http::Finish {token {errormsg ""} {skipCB 0}} {
 #	Close a socket and remove it from the persistent sockets table.  If
 #	possible an http token is included here but when we are called from a
 #	fileevent on remote closure we need to find the correct entry - hence
-#	the second section.
+#	the "else" block of the first "if" command.
+
+proc http::CloseSocket {s {token {}}} {
+    variable socketMapping
+    variable socketRdState
+    variable socketWrState
+    variable socketRdQueue
+    variable socketWrQueue
+    variable socketClosing
+    variable socketPlayCmd
+
+    set tk [namespace tail $token]
 
-proc ::http::CloseSocket {s {token {}}} {
-    variable socketmap
     catch {fileevent $s readable {}}
-    set conn_id {}
+    set connId {}
     if {$token ne ""} {
-        variable $token
-        upvar 0 $token state
-        if {[info exists state(socketinfo)]} {
-	    set conn_id $state(socketinfo)
-        }
+	variable $token
+	upvar 0 $token state
+	if {[info exists state(socketinfo)]} {
+	    set connId $state(socketinfo)
+	}
     } else {
-        set map [array get socketmap]
-        set ndx [lsearch -exact $map $s]
-        if {$ndx != -1} {
+	set map [array get socketMapping]
+	set ndx [lsearch -exact $map $s]
+	if {$ndx != -1} {
 	    incr ndx -1
-	    set conn_id [lindex $map $ndx]
-        }
+	    set connId [lindex $map $ndx]
+	}
     }
-    if {$conn_id eq {} || ![info exists socketmap($conn_id)]} {
-        Log "Closing socket $s (no connection info)"
-        if {[catch {close $s} err]} {
-	    Log "Error: $err"
+    if {    ($connId ne {})
+	 && [info exists socketMapping($connId)]
+	 && ($socketMapping($connId) eq $s)
+    } {
+	Log "Closing connection $connId (sock $socketMapping($connId))"
+	if {[catch {close $socketMapping($connId)} err]} {
+	    Log "Error closing connection: $err"
+	}
+	if {$token eq {}} {
+	    # Cases with a non-empty token are handled by Finish, so the tokens
+	    # are finished in connection order.
+	    http::CloseQueuedQueries $connId
 	}
     } else {
-	if {[info exists socketmap($conn_id)]} {
-	    Log "Closing connection $conn_id (sock $socketmap($conn_id))"
-	    if {[catch {close $socketmap($conn_id)} err]} {
-		Log "Error: $err"
-	    }
-	    unset socketmap($conn_id)
-	} else {
-	    Log "Cannot close connection $conn_id - no socket in socket map"
+	Log "Closing socket $s (no connection info)"
+	if {[catch {close $s} err]} {
+	    Log "Error closing socket: $err"
 	}
     }
 }
 
+# http::CloseQueuedQueries
+#
+#	connId  - identifier "domain:port" for the connection
+#	token   - (optional) used only for logging
+#
+# Called from http::CloseSocket and http::Finish, after a connection is closed,
+# to clear the read and write queues if this has not already been done.
+
+proc http::CloseQueuedQueries {connId {token {}}} {
+    variable socketMapping
+    variable socketRdState
+    variable socketWrState
+    variable socketRdQueue
+    variable socketWrQueue
+    variable socketClosing
+    variable socketPlayCmd
+
+    if {![info exists socketMapping($connId)]} {
+	# Command has already been called.
+	# Don't come here again - especially recursively.
+	return
+    }
+
+    # Used only for logging.
+    if {$token eq {}} {
+	set tk {}
+    } else {
+	set tk [namespace tail $token]
+    }
+
+    if {    [info exists socketPlayCmd($connId)]
+	 && ($socketPlayCmd($connId) ne {ReplayIfClose Wready {} {}})
+    } {
+	# Before unsetting, there is some unfinished business.
+	# - If the server sent "Connection: close", we have stored the command
+	#   for retrying any queued requests in socketPlayCmd, so copy that
+	#   value for execution below.  socketClosing(*) was also set.
+	# - Also clear the queues to prevent calls to Finish that would set the
+	#   state for the requests that will be retried to "finished with error
+	#   status".
+	set unfinished $socketPlayCmd($connId)
+	set socketRdQueue($connId) {}
+	set socketWrQueue($connId) {}
+    } else {
+	set unfinished {}
+    }
+
+    Unset $connId
+
+    if {$unfinished ne {}} {
+	Log ^R$tk Any unfinished transactions (excluding $token) failed \
+		- token $token
+	{*}$unfinished
+    }
+}
+
+# http::Unset
+#
+#	The trace on "unset socketRdState(*)" will call CancelReadPipeline
+#	and cancel any queued responses.
+#	The trace on "unset socketWrState(*)" will call CancelWritePipeline
+#	and cancel any queued requests.
+
+proc http::Unset {connId} {
+    variable socketMapping
+    variable socketRdState
+    variable socketWrState
+    variable socketRdQueue
+    variable socketWrQueue
+    variable socketClosing
+    variable socketPlayCmd
+
+    unset socketMapping($connId)
+    unset socketRdState($connId)
+    unset socketWrState($connId)
+    unset -nocomplain socketRdQueue($connId)
+    unset -nocomplain socketWrQueue($connId)
+    unset -nocomplain socketClosing($connId)
+    unset -nocomplain socketPlayCmd($connId)
+}
+
 # http::reset --
 #
 #	See documentation for details.
@@ -278,7 +647,7 @@ proc ::http::CloseSocket {s {token {}}} {
 #	why	Status info.
 #
 # Side Effects:
-#       See Finish
+#        See Finish
 
 proc http::reset {token {why reset}} {
     variable $token
@@ -299,8 +668,8 @@ proc http::reset {token {why reset}} {
 #	Establishes a connection to a remote url via http.
 #
 # Arguments:
-#       url		The http URL to goget.
-#       args		Option value pairs. Valid options include:
+#	url		The http URL to goget.
+#	args		Option value pairs. Valid options include:
 #				-blocksize, -validate, -headers, -timeout
 # Results:
 #	Returns a token for this connection. This token is the name of an
@@ -320,9 +689,12 @@ proc http::geturl {url args} {
 	set http(uid) 0
     }
     set token [namespace current]::[incr http(uid)]
+    ##Log Starting http::geturl - token $token
     variable $token
     upvar 0 $token state
+    set tk [namespace tail $token]
     reset $token
+    Log ^A$tk URL $url - token $token
 
     # Process command options.
 
@@ -337,8 +709,9 @@ proc http::geturl {url args} {
 	-queryprogress	{}
 	-protocol	1.1
 	binary		0
-	state		connecting
+	state		created
 	meta		{}
+	method		{}
 	coding		{}
 	currentsize	0
 	totalsize	0
@@ -555,14 +928,7 @@ proc http::geturl {url args} {
     # Don't append the fragment!
     set state(url) $url
 
-    # If a timeout is specified we set up the after event and arrange for an
-    # asynchronous socket connection.
-
     set sockopts [list -async]
-    if {$state(-timeout) > 0} {
-	set state(after) [after $state(-timeout) \
-		[list http::reset $token timeout]]
-    }
 
     # If we are using the proxy, we must pass in the full URL that includes
     # the server name.
@@ -580,52 +946,295 @@ proc http::geturl {url args} {
     # c11a51c482]
     set state(accept-types) $http(-accept)
 
+    if {$isQuery || $isQueryChannel} {
+	# It's a POST.
+	# A client wishing to send a non-idempotent request SHOULD wait to send
+	# that request until it has received the response status for the
+	# previous request.
+	if {$http(-postfresh)} {
+	    # Override -keepalive for a POST.  Use a new connection, and thus
+	    # avoid the small risk of a race against server timeout.
+	    set state(-keepalive) 0
+	} else {
+	    # Allow -keepalive but do not -pipeline - wait for the previous
+	    # transaction to finish.
+	    # There is a small risk of a race against server timeout.
+	    set state(-pipeline) 0
+	}
+    } else {
+	# It's a GET or HEAD.
+	set state(-pipeline) $http(-pipeline)
+    }
+
     # See if we are supposed to use a previously opened channel.
+    # - In principle, ANY call to http::geturl could use a previously opened
+    #   channel if it is available - the "Connection: keep-alive" header is a
+    #   request to leave the channel open AFTER completion of this call.
+    # - In fact, we try to use an existing channel only if -keepalive 1 -- this
+    #   means that at most one channel is left open for each value of
+    #   $state(socketinfo). This property simplifies the mapping of open
+    #   channels.
+    set reusing 0
+    set alreadyQueued 0
     if {$state(-keepalive)} {
-	variable socketmap
-	if {[info exists socketmap($state(socketinfo))]} {
-	    if {[catch {fconfigure $socketmap($state(socketinfo))}]} {
-		Log "WARNING: socket for $state(socketinfo) was closed"
-		unset socketmap($state(socketinfo))
+	variable socketMapping
+	variable socketRdState
+	variable socketWrState
+	variable socketRdQueue
+	variable socketWrQueue
+	variable socketClosing
+	variable socketPlayCmd
+
+	if {[info exists socketMapping($state(socketinfo))]} {
+	    # - If the connection is idle, it has a "fileevent readable" binding
+	    #   to http::CheckEof, in case the server times out and half-closes
+	    #   the socket (http::CheckEof closes the other half).
+	    # - We leave this binding in place until just before the last
+	    #   puts+flush in http::Connected (GET/HEAD) or http::Write (POST),
+	    #   after which the HTTP response might be generated.
+
+	    if {    [info exists socketClosing($state(socketinfo))]
+		       && $socketClosing($state(socketinfo))
+	    } {
+		# socketClosing(*) is set because the server has sent a
+		# "Connection: close" header.
+		# Do not use the persistent socket again.
+		# Since we have only one persistent socket per server, and the
+		# old socket is not yet dead, add the request to the write queue
+		# of the dying socket, which will be replayed by ReplayIfClose.
+		# Also add it to socketWrQueue(*) which is used only if an error
+		# causes a call to Finish.
+		set reusing 1
+		set sock $socketMapping($state(socketinfo))
+		Log "reusing socket $sock for $state(socketinfo) - token $token"
+
+		set alreadyQueued 1
+		lassign $socketPlayCmd($state(socketinfo)) com0 com1 com2 com3
+		lappend com3 $token
+		set socketPlayCmd($state(socketinfo)) [list $com0 $com1 $com2 $com3]
+		lappend socketWrQueue($state(socketinfo)) $token
+	    } elseif {[catch {fconfigure $socketMapping($state(socketinfo))}]} {
+		# FIXME Is it still possible for this code to be executed? If
+		#       so, this could be another place to call TestForReplay,
+		#       rather than discarding the queued transactions.
+		Log "WARNING: socket for $state(socketinfo) was closed\
+			- token $token"
+		Log "WARNING - if testing, pay special attention to this\
+			case (GH) which is seldom executed - token $token"
+
+		# This will call CancelReadPipeline, CancelWritePipeline, and
+		# cancel any queued requests, responses.
+		Unset $state(socketinfo)
 	    } else {
-		set sock $socketmap($state(socketinfo))
-		Log "reusing socket $sock for $state(socketinfo)"
-		catch {fileevent $sock writable {}}
-		catch {fileevent $sock readable {}}
+		# Use the persistent socket.
+		# The socket may not be ready to write: an earlier request might
+		# still be still writing (in the pipelined case) or
+		# writing/reading (in the nonpipeline case). This possibility
+		# is handled by socketWrQueue later in this command.
+		set reusing 1
+		set sock $socketMapping($state(socketinfo))
+		Log "reusing socket $sock for $state(socketinfo) - token $token"
+
 	    }
+	    # Do not automatically close the connection socket.
+	    set state(connection) {}
 	}
-	# don't automatically close this connection socket
-	set state(connection) {}
     }
+
+    if {$reusing} {
+	# Define state(tmpState) and state(tmpOpenCmd) for use
+	# by http::ReplayIfDead if the persistent connection has died.
+	set state(tmpState) [array get state]
+
+	# Pass -myaddr directly to the socket command
+	if {[info exists state(-myaddr)]} {
+	    lappend sockopts -myaddr $state(-myaddr)
+	}
+
+	set state(tmpOpenCmd) [list {*}$defcmd {*}$sockopts {*}$targetAddr]
+    }
+
+    set state(reusing) $reusing
+    # Excluding ReplayIfDead and the decision whether to call it, there are four
+    # places outside http::geturl where state(reusing) is used:
+    # - Connected   - if reusing and not pipelined, start the state(-timeout)
+    #                 timeout (when writing).
+    # - DoneRequest - if reusing and pipelined, send the next pipelined write
+    # - Event       - if reusing and pipelined, start the state(-timeout)
+    #                 timeout (when reading).
+    # - Event       - if (not reusing) and pipelined, send the next pipelined
+    #                 write
+
+    # See comments above re the start of this timeout in other cases.
+    if {(!$state(reusing)) && ($state(-timeout) > 0)} {
+	set state(after) [after $state(-timeout) \
+		[list http::reset $token timeout]]
+    }
+
     if {![info exists sock]} {
 	# Pass -myaddr directly to the socket command
 	if {[info exists state(-myaddr)]} {
 	    lappend sockopts -myaddr $state(-myaddr)
 	}
-        if {[catch {eval $defcmd $sockopts $targetAddr} sock errdict]} {
-	    # something went wrong while trying to establish the connection.
+	set pre [clock milliseconds]
+	##Log pre socket opened, - token $token
+	##Log [concat $defcmd $sockopts $targetAddr] - token $token
+	if {[catch {eval $defcmd $sockopts $targetAddr} sock errdict]} {
+	    # Something went wrong while trying to establish the connection.
 	    # Clean up after events and such, but DON'T call the command
 	    # callback (if available) because we're going to throw an
 	    # exception from here instead.
 
-	    set state(sock) $sock
-	    Finish $token "" 1
+	    set state(sock) NONE
+	    Finish $token $sock 1
 	    cleanup $token
 	    dict unset errdict -level
 	    return -options $errdict $sock
-        }
+	} else {
+	    # Initialisation of a new socket.
+	    ##Log post socket opened, - token $token
+	    ##Log socket opened, now fconfigure - token $token
+	    set delay [expr {[clock milliseconds] - $pre}]
+	    if {$delay > 3000} {
+		Log socket delay $delay - token $token
+	    }
+	    fconfigure $sock -translation {auto crlf} \
+			     -buffersize $state(-blocksize)
+	    ##Log socket opened, DONE fconfigure - token $token
+	}
     }
+    # Command [socket] is called with -async, but takes 5s to 5.1s to return,
+    # with probability of order 1 in 10,000.  This may be a bizarre scheduling
+    # issue with my (KJN's) system (Fedora Linux).
+    # This does not cause a problem (unless the request times out when this
+    # command returns).
+
     set state(sock) $sock
-    Log "Using $sock for $state(socketinfo)" \
-        [expr {$state(-keepalive)?"keepalive":""}]
-    if {$state(-keepalive)} {
-        set socketmap($state(socketinfo)) $sock
+    Log "Using $sock for $state(socketinfo) - token $token" \
+	[expr {$state(-keepalive)?"keepalive":""}]
+
+    if {    $state(-keepalive)
+	 && (![info exists socketMapping($state(socketinfo))])
+    } {
+	# Freshly-opened socket that we would like to become persistent.
+	set socketMapping($state(socketinfo)) $sock
+
+	if {![info exists socketRdState($state(socketinfo))]} {
+	    set socketRdState($state(socketinfo)) {}
+	    set varName ::http::socketRdState($state(socketinfo))
+	    trace add variable $varName unset ::http::CancelReadPipeline
+	}
+	if {![info exists socketWrState($state(socketinfo))]} {
+	    set socketWrState($state(socketinfo)) {}
+	    set varName ::http::socketWrState($state(socketinfo))
+	    trace add variable $varName unset ::http::CancelWritePipeline
+	}
+
+	if {$state(-pipeline)} {
+	    #Log new, init for pipelined, GRANT write access to $token in geturl
+	    # Also grant premature read access to the socket. This is OK.
+	    set socketRdState($state(socketinfo)) $token
+	    set socketWrState($state(socketinfo)) $token
+	} else {
+	    # socketWrState is not used by this non-pipelined transaction.
+	    # We cannot leave it as "Wready" because the next call to
+	    # http::geturl with a pipelined transaction would conclude that the
+	    # socket is available for writing.
+	    #Log new, init for nonpipeline, GRANT r/w access to $token in geturl
+	    set socketRdState($state(socketinfo)) $token
+	    set socketWrState($state(socketinfo)) $token
+	}
+
+	set socketRdQueue($state(socketinfo)) {}
+	set socketWrQueue($state(socketinfo)) {}
+	set socketClosing($state(socketinfo)) 0
+	set socketPlayCmd($state(socketinfo)) {ReplayIfClose Wready {} {}}
     }
 
     if {![info exists phost]} {
 	set phost ""
     }
-    fileevent $sock writable [list http::Connect $token $proto $phost $srvurl]
+    if {$reusing} {
+	# For use by http::ReplayIfDead if the persistent connection has died.
+	# Also used by NextPipelinedWrite.
+	set state(tmpConnArgs) [list $proto $phost $srvurl]
+    }
+
+    # The element socketWrState($connId) has a value which is either the name of
+    # the token that is permitted to write to the socket, or "Wready" if no
+    # token is permitted to write.
+    #
+    # The code that sets the value to Wready immediately calls
+    # http::NextPipelinedWrite, which examines socketWrQueue($connId) and
+    # processes the next request in the queue, if there is one.  The value
+    # Wready is not found when the interpreter is in the event loop unless the
+    # socket is idle.
+    #
+    # The element socketRdState($connId) has a value which is either the name of
+    # the token that is permitted to read from the socket, or "Rready" if no
+    # token is permitted to read.
+    #
+    # The code that sets the value to Rready then examines
+    # socketRdQueue($connId) and processes the next request in the queue, if
+    # there is one.  The value Rready is not found when the interpreter is in
+    # the event loop unless the socket is idle.
+
+    if {$alreadyQueued} {
+	# A write may or may not be in progress.  There is no need to set
+	# socketWrState to prevent another call stealing write access - all
+	# subsequent calls on this socket will come here because the socket
+	# will close after the current read, and its
+	# socketClosing($connId) is 1.
+	##Log "HTTP request for token $token is queued"
+
+    } elseif {    $reusing
+	       && $state(-pipeline)
+	       && ($socketWrState($state(socketinfo)) ne "Wready")
+    } {
+	##Log "HTTP request for token $token is queued for pipelined use"
+	lappend socketWrQueue($state(socketinfo)) $token
+
+    } elseif {    $reusing
+	       && (!$state(-pipeline))
+	       && ($socketWrState($state(socketinfo)) ne "Wready")
+    } {
+	# A write is queued or in progress.  Lappend to the write queue.
+	##Log "HTTP request for token $token is queued for nonpipeline use"
+	lappend socketWrQueue($state(socketinfo)) $token
+
+    } elseif {    $reusing
+	       && (!$state(-pipeline))
+	       && ($socketWrState($state(socketinfo)) eq "Wready")
+	       && ($socketRdState($state(socketinfo)) ne "Rready")
+    } {
+	# A read is queued or in progress, but not a write.  Cannot start the
+	# nonpipeline transaction, but must set socketWrState to prevent a
+	# pipelined request jumping the queue.
+	##Log "HTTP request for token $token is queued for nonpipeline use"
+	#Log re-use nonpipeline, GRANT delayed write access to $token in geturl
+
+	set socketWrState($state(socketinfo)) peNding
+	lappend socketWrQueue($state(socketinfo)) $token
+
+    } else {
+	if {$reusing && $state(-pipeline)} {
+	    #Log re-use pipelined, GRANT write access to $token in geturl
+	    set socketWrState($state(socketinfo)) $token
+
+	} elseif {$reusing} {
+	    # Cf tests above - both are ready.
+	    #Log re-use nonpipeline, GRANT r/w access to $token in geturl
+	    set socketRdState($state(socketinfo)) $token
+	    set socketWrState($state(socketinfo)) $token
+	}
+
+	# All (!$reusing) cases come here, and also some $reusing cases if the
+	# connection is ready.
+	#Log ---- $state(socketinfo) << conn to $token for HTTP request (a)
+	# Connect does its own fconfigure.
+	fileevent $sock writable \
+		[list http::Connect $token $proto $phost $srvurl]
+    }
 
     # Wait for the connection to complete.
     if {![info exists state(-command)]} {
@@ -648,7 +1257,7 @@ proc http::geturl {url args} {
 	    return -code error $err
 	}
     }
-
+    ##Log Leaving http::geturl - token $token
     return $token
 }
 
@@ -658,8 +1267,8 @@ proc http::geturl {url args} {
 #	established.
 #
 # Arguments:
-#       token	State token.
-#       proto	What protocol (http, https, etc.) was used to connect.
+#	token	State token.
+#	proto	What protocol (http, https, etc.) was used to connect.
 #	phost	Are we using keep-alive? Non-empty if yes.
 #	srvurl	Service-local URL that we're requesting
 # Results:
@@ -668,11 +1277,24 @@ proc http::geturl {url args} {
 proc http::Connected {token proto phost srvurl} {
     variable http
     variable urlTypes
+    variable socketMapping
+    variable socketRdState
+    variable socketWrState
+    variable socketRdQueue
+    variable socketWrQueue
+    variable socketClosing
+    variable socketPlayCmd
 
     variable $token
     upvar 0 $token state
+    set tk [namespace tail $token]
+
+    if {$state(reusing) && (!$state(-pipeline)) && ($state(-timeout) > 0)} {
+	set state(after) [after $state(-timeout) \
+		[list http::reset $token timeout]]
+    }
 
-    # Set back the variables needed here
+    # Set back the variables needed here.
     set sock $state(sock)
     set isQueryChannel [info exists state(-querychannel)]
     set isQuery [info exists state(-query)]
@@ -682,9 +1304,12 @@ proc http::Connected {token proto phost srvurl} {
     set lower [string tolower $proto]
     set defport [lindex $urlTypes($lower) 0]
 
-    # Send data in cr-lf format, but accept any line terminators
-
-    fconfigure $sock -translation {auto crlf} -buffersize $state(-blocksize)
+    # Send data in cr-lf format, but accept any line terminators.
+    # Initialisation to {auto *} now done in geturl, KeepSocket and DoneRequest.
+    # We are concerned here with the request (write) not the response (read).
+    lassign [fconfigure $sock -translation] trRead trWrite
+    fconfigure $sock -translation [list $trRead crlf] \
+		     -buffersize $state(-blocksize)
 
     # The following is disallowed in safe interpreters, but the socket is
     # already in non-blocking mode in that case.
@@ -707,10 +1332,12 @@ proc http::Connected {token proto phost srvurl} {
 	set how POST
 	# The query channel must be blocking for the async Write to
 	# work properly.
-	fconfigure $state(-querychannel) -blocking 1 -translation binary
+	lassign [fconfigure $sock -translation] trRead trWrite
+	fconfigure $state(-querychannel) -blocking 1 \
+					 -translation [list $trRead binary]
 	set contDone 0
     }
-    if {[info exists state(-method)] && $state(-method) ne ""} {
+    if {[info exists state(-method)] && ($state(-method) ne "")} {
 	set how $state(-method)
     }
     # We cannot handle chunked encodings with -handler, so force HTTP/1.0
@@ -719,7 +1346,11 @@ proc http::Connected {token proto phost srvurl} {
 	set state(-protocol) 1.0
     }
     set accept_types_seen 0
+
+    Log ^B$tk begin sending request - token $token
+
     if {[catch {
+	set state(method) $how
 	puts $sock "$how $srvurl HTTP/$state(-protocol)"
 	if {[dict exists $state(-headers) Host]} {
 	    # Allow Host spoofing. [Bug 928154]
@@ -732,16 +1363,18 @@ proc http::Connected {token proto phost srvurl} {
 	    puts $sock "Host: $host:$port"
 	}
 	puts $sock "User-Agent: $http(-useragent)"
-        if {$state(-protocol) == 1.0 && $state(-keepalive)} {
+	if {($state(-protocol) >= 1.0) && $state(-keepalive)} {
+	    # Send this header, because a 1.1 server is not compelled to treat
+	    # this as the default.
 	    puts $sock "Connection: keep-alive"
-        }
-        if {$state(-protocol) > 1.0 && !$state(-keepalive)} {
+	}
+	if {($state(-protocol) > 1.0) && !$state(-keepalive)} {
 	    puts $sock "Connection: close" ;# RFC2616 sec 8.1.2.1
-        }
-        if {[info exists phost] && ($phost ne "") && $state(-keepalive)} {
+	}
+	if {[info exists phost] && ($phost ne "") && $state(-keepalive)} {
 	    puts $sock "Proxy-Connection: Keep-Alive"
-        }
-        set accept_encoding_seen 0
+	}
+	set accept_encoding_seen 0
 	set content_type_seen 0
 	dict for {key value} $state(-headers) {
 	    set value [string map [list \n "" \r ""] $value]
@@ -771,10 +1404,13 @@ proc http::Connected {token proto phost srvurl} {
 	if {!$accept_types_seen} {
 	    puts $sock "Accept: $state(accept-types)"
 	}
-        if {!$accept_encoding_seen && ![info exists state(-handler)]} {
+	if {    (!$accept_encoding_seen)
+	     && (![info exists state(-handler)])
+	     && $http(-zip)
+	} {
 	    puts $sock "Accept-Encoding: gzip,deflate,compress"
-        }
-	if {$isQueryChannel && $state(querylength) == 0} {
+	}
+	if {$isQueryChannel && ($state(querylength) == 0)} {
 	    # Try to determine size of data in channel. If we cannot seek, the
 	    # surrounding catch will trap us
 
@@ -803,6 +1439,7 @@ proc http::Connected {token proto phost srvurl} {
 	# response.
 
 	if {$isQuery || $isQueryChannel} {
+	    # POST method.
 	    if {!$content_type_seen} {
 		puts $sock "Content-Type: $state(-type)"
 	    }
@@ -810,29 +1447,753 @@ proc http::Connected {token proto phost srvurl} {
 		puts $sock "Content-Length: $state(querylength)"
 	    }
 	    puts $sock ""
-	    fconfigure $sock -translation {auto binary}
+	    flush $sock
+	    # Flush flushes the error in the https case with a bad handshake:
+	    # else the socket never becomes writable again, and hangs until
+	    # timeout (if any).
+
+	    lassign [fconfigure $sock -translation] trRead trWrite
+	    fconfigure $sock -translation [list $trRead binary]
 	    fileevent $sock writable [list http::Write $token]
+	    # The http::Write command decides when to make the socket readable,
+	    # using the same test as the GET/HEAD case below.
 	} else {
+	    # GET or HEAD method.
+	    if {    (![catch {fileevent $sock readable} binding])
+		 && ($binding eq [list http::CheckEof $sock])
+	    } {
+		# Remove the "fileevent readable" binding of an idle persistent
+		# socket to http::CheckEof.  We can no longer treat bytes
+		# received as junk. The server might still time out and
+		# half-close the socket if it has not yet received the first
+		# "puts".
+		fileevent $sock readable {}
+	    }
 	    puts $sock ""
 	    flush $sock
-	    fileevent $sock readable [list http::Event $sock $token]
+	    Log ^C$tk end sending request - token $token
+	    # End of writing (GET/HEAD methods).  The request has been sent.
+
+	    DoneRequest $token
 	}
 
     } err]} {
-	# The socket probably was never connected, or the connection dropped
-	# later.
+	# The socket probably was never connected, OR the connection dropped
+	# later, OR https handshake error, which may be discovered as late as
+	# the "flush" command above...
+	Log "WARNING - if testing, pay special attention to this\
+		case (GI) which is seldom executed - token $token"
+	if {[info exists state(reusing)] && $state(reusing)} {
+	    # The socket was closed at the server end, and closed at
+	    # this end by http::CheckEof.
+    	    if {[TestForReplay $token write $err a]} {
+		return
+	    } else {
+		Finish $token {failed to re-use socket}
+	    }
 
-	# if state(status) is error, it means someone's already called Finish
-	# to do the above-described clean up.
-	if {$state(status) ne "error"} {
+	    # else:
+	    # This is NOT a persistent socket that has been closed since its
+	    # last use.
+	    # If any other requests are in flight or pipelined/queued, they will
+	    # be discarded.
+	} elseif {$state(status) eq ""} {
+	    # ...https handshake errors come here.
+	    set msg [registerError $sock]
+	    registerError $sock {}
+	    if {$msg eq {}} {
+		set msg {failed to use socket}
+	    }
+	    Finish $token $msg
+	} elseif {$state(status) ne "error"} {
 	    Finish $token $err
 	}
     }
 }
 
+# http::registerError
+#
+#	Called (for example when processing TclTLS activity) to register
+#	an error for a connection on a specific socket.  This helps
+#	http::Connected to deliver meaningful error messages, e.g. when a TLS
+#	certificate fails verification.
+#
+#	Usage: http::registerError socket ?newValue?
+#
+#	"set" semantics, except that a "get" (a call without a new value) for a
+#	non-existent socket returns {}, not an error.
+
+proc http::registerError {sock args} {
+    variable registeredErrors
+
+    if {    ([llength $args] == 0)
+	 && (![info exists registeredErrors($sock)])
+    } {
+	return
+    } elseif {    ([llength $args] == 1)
+	       && ([lindex $args 0] eq {})
+    } {
+	unset -nocomplain registeredErrors($sock)
+	return
+    }
+    set registeredErrors($sock) {*}$args
+}
+
+# http::DoneRequest --
+#
+#	Command called when a request has been sent.  It will arrange the
+#	next request and/or response as appropriate.
+#
+#	If this command is called when $socketClosing(*), the request $token
+#	that calls it must be pipelined and destined to fail.
+
+proc http::DoneRequest {token} {
+    variable http
+    variable socketMapping
+    variable socketRdState
+    variable socketWrState
+    variable socketRdQueue
+    variable socketWrQueue
+    variable socketClosing
+    variable socketPlayCmd
+
+    variable $token
+    upvar 0 $token state
+    set tk [namespace tail $token]
+    set sock $state(sock)
+
+    # If pipelined, connect the next HTTP request to the socket.
+    if {$state(reusing) && $state(-pipeline)} {
+	# Enable next token (if any) to write.
+	# The value "Wready" is set only here, and
+	# in http::Event after reading the response-headers of a
+	# non-reusing transaction.
+	# Previous value is $token. It cannot be pending.
+	set socketWrState($state(socketinfo)) Wready
+
+	# Now ready to write the next pipelined request (if any).
+	http::NextPipelinedWrite $token
+    } else {
+	# If pipelined, this is the first transaction on this socket.  We wait
+	# for the response headers to discover whether the connection is
+	# persistent.  (If this is not done and the connection is not
+	# persistent, we SHOULD retry and then MUST NOT pipeline before knowing
+	# that we have a persistent connection
+	# (rfc2616 8.1.2.2)).
+    }
+
+    # Connect to receive the response, unless the socket is pipelined
+    # and another response is being sent.
+    # This code block is separate from the code below because there are
+    # cases where socketRdState already has the value $token.
+    if {    $state(-keepalive)
+	 && $state(-pipeline)
+	 && [info exists socketRdState($state(socketinfo))]
+	 && ($socketRdState($state(socketinfo)) eq "Rready")
+    } {
+	#Log pipelined, GRANT read access to $token in Connected
+	set socketRdState($state(socketinfo)) $token
+    }
+
+    if {    $state(-keepalive)
+	 && $state(-pipeline)
+	 && [info exists socketRdState($state(socketinfo))]
+	 && ($socketRdState($state(socketinfo)) ne $token)
+    } {
+	# Do not read from the socket until it is ready.
+	##Log "HTTP response for token $token is queued for pipelined use"
+	# If $socketClosing(*), then the caller will be a pipelined write and
+	# execution will come here.
+	# This token has already been recorded as "in flight" for writing.
+	# When the socket is closed, the read queue will be cleared in
+	# CloseQueuedQueries and so the "lappend" here has no effect.
+	lappend socketRdQueue($state(socketinfo)) $token
+    } else {
+	# In the pipelined case, connection for reading depends on the
+	# value of socketRdState.
+	# In the nonpipeline case, connection for reading always occurs.
+	ReceiveResponse $token
+    }
+}
+
+# http::ReceiveResponse
+#
+#	Connects token to its socket for reading.
+
+proc http::ReceiveResponse {token} {
+    variable $token
+    upvar 0 $token state
+    set tk [namespace tail $token]
+    set sock $state(sock)
+
+    #Log ---- $state(socketinfo) >> conn to $token for HTTP response
+    lassign [fconfigure $sock -translation] trRead trWrite
+    fconfigure $sock -translation [list auto $trWrite] \
+		     -buffersize $state(-blocksize)
+    Log ^D$tk begin receiving response - token $token
+
+    coroutine ${token}EventCoroutine http::Event $sock $token
+    fileevent $sock readable ${token}EventCoroutine
+}
+
+# http::NextPipelinedWrite
+#
+# - Connecting a socket to a token for writing is done by this command and by
+#   command KeepSocket.
+# - If another request has a pipelined write scheduled for $token's socket,
+#   and if the socket is ready to accept it, connect the write and update
+#   the queue accordingly.
+# - This command is called from http::DoneRequest and http::Event,
+#   IF $state(-pipeline) AND (the current transfer has reached the point at
+#   which the socket is ready for the next request to be written).
+# - This command is called when a token has write access and is pipelined and
+#   keep-alive, and sets socketWrState to Wready.
+# - The command need not consider the case where socketWrState is set to a token
+#   that does not yet have write access.  Such a token is waiting for Rready,
+#   and the assignment of the connection to the token will be done elsewhere (in
+#   http::KeepSocket).
+# - This command cannot be called after socketWrState has been set to a
+#   "pending" token value (that is then overwritten by the caller), because that
+#   value is set by this command when it is called by an earlier token when it
+#   relinquishes its write access, and the pending token is always the next in
+#   line to write.
+
+proc http::NextPipelinedWrite {token} {
+    variable http
+    variable socketRdState
+    variable socketWrState
+    variable socketWrQueue
+    variable socketClosing
+    variable $token
+    upvar 0 $token state
+    set connId $state(socketinfo)
+
+    if {    [info exists socketClosing($connId)]
+	 && $socketClosing($connId)
+    } {
+	# socketClosing(*) is set because the server has sent a
+	# "Connection: close" header.
+	# Behave as if the queues are empty - so do nothing.
+    } elseif {    $state(-pipeline)
+	 && [info exists socketWrState($connId)]
+	 && ($socketWrState($connId) eq "Wready")
+
+	 && [info exists socketWrQueue($connId)]
+	 && [llength $socketWrQueue($connId)]
+	 && ([set token2 [lindex $socketWrQueue($connId) 0]
+	      set ${token2}(-pipeline)
+	     ]
+	    )
+    } {
+	# - The usual case for a pipelined connection, ready for a new request.
+	#Log pipelined, GRANT write access to $token2 in NextPipelinedWrite
+	set conn [set ${token2}(tmpConnArgs)]
+	set socketWrState($connId) $token2
+	set socketWrQueue($connId) [lrange $socketWrQueue($connId) 1 end]
+	# Connect does its own fconfigure.
+	fileevent $state(sock) writable [list http::Connect $token2 {*}$conn]
+	#Log ---- $connId << conn to $token2 for HTTP request (b)
+
+	# In the tests below, the next request will be nonpipeline.
+    } elseif {    $state(-pipeline)
+	       && [info exists socketWrState($connId)]
+	       && ($socketWrState($connId) eq "Wready")
+
+	       && [info exists socketWrQueue($connId)]
+	       && [llength $socketWrQueue($connId)]
+	       && (![ set token3 [lindex $socketWrQueue($connId) 0]
+		      set ${token3}(-pipeline)
+		    ]
+		  )
+
+	       && [info exists socketRdState($connId)]
+	       && ($socketRdState($connId) eq "Rready")
+    } {
+	# The case in which the next request will be non-pipelined, and the read
+	# and write queues is ready: which is the condition for a non-pipelined
+	# write.
+	variable $token3
+	upvar 0 $token3 state3
+	set conn [set ${token3}(tmpConnArgs)]
+	#Log nonpipeline, GRANT r/w access to $token3 in NextPipelinedWrite
+	set socketRdState($connId) $token3
+	set socketWrState($connId) $token3
+	set socketWrQueue($connId) [lrange $socketWrQueue($connId) 1 end]
+	# Connect does its own fconfigure.
+	fileevent $state(sock) writable [list http::Connect $token3 {*}$conn]
+	#Log ---- $state(sock) << conn to $token3 for HTTP request (c)
+
+    } elseif {    $state(-pipeline)
+	 && [info exists socketWrState($connId)]
+	 && ($socketWrState($connId) eq "Wready")
+
+	 && [info exists socketWrQueue($connId)]
+	 && [llength $socketWrQueue($connId)]
+	 && (![set token2 [lindex $socketWrQueue($connId) 0]
+	      set ${token2}(-pipeline)
+	     ]
+	    )
+    } {
+	# - The case in which the next request will be non-pipelined, but the
+	#   read queue is NOT ready.
+	# - A read is queued or in progress, but not a write.  Cannot start the
+	#   nonpipeline transaction, but must set socketWrState to prevent a new
+	#   pipelined request (in http::geturl) jumping the queue.
+	# - Because socketWrState($connId) is not set to Wready, the assignment
+	#   of the connection to $token2 will be done elsewhere - by command
+	#   http::KeepSocket when $socketRdState($connId) is set to "Rready".
+
+	#Log re-use nonpipeline, GRANT delayed write access to $token in NextP..
+	set socketWrState($connId) peNding
+    }
+}
+
+# http::CancelReadPipeline
+#
+#	Cancel pipelined responses on a closing "Keep-Alive" socket.
+#
+#	- Called by a variable trace on "unset socketRdState($connId)".
+#	- The variable relates to a Keep-Alive socket, which has been closed.
+#	- Cancels all pipelined responses. The requests have been sent,
+#	  the responses have not yet been received.
+#	- This is a hard cancel that ends each transaction with error status,
+#	  and closes the connection. Do not use it if you want to replay failed
+#	  transactions.
+#	- N.B. Always delete ::http::socketRdState($connId) before deleting
+#	  ::http::socketRdQueue($connId), or this command will do nothing.
+#
+# Arguments
+#	As for a trace command on a variable.
+
+proc http::CancelReadPipeline {name1 connId op} {
+    variable socketRdQueue
+    ##Log CancelReadPipeline $name1 $connId $op
+    if {[info exists socketRdQueue($connId)]} {
+	set msg {the connection was closed by CancelReadPipeline}
+	foreach token $socketRdQueue($connId) {
+	    set tk [namespace tail $token]
+	    Log ^X$tk end of response "($msg)" - token $token
+	    set ${token}(status) eof
+	    Finish $token ;#$msg
+	}
+	set socketRdQueue($connId) {}
+    }
+}
+
+# http::CancelWritePipeline
+#
+#	Cancel queued events on a closing "Keep-Alive" socket.
+#
+#	- Called by a variable trace on "unset socketWrState($connId)".
+#	- The variable relates to a Keep-Alive socket, which has been closed.
+#	- In pipelined or nonpipeline case: cancels all queued requests.  The
+#	  requests have not yet been sent, the responses are not due.
+#	- This is a hard cancel that ends each transaction with error status,
+#	  and closes the connection. Do not use it if you want to replay failed
+#	  transactions.
+#	- N.B. Always delete ::http::socketWrState($connId) before deleting
+#	  ::http::socketWrQueue($connId), or this command will do nothing.
+#
+# Arguments
+#	As for a trace command on a variable.
+
+proc http::CancelWritePipeline {name1 connId op} {
+    variable socketWrQueue
+
+    ##Log CancelWritePipeline $name1 $connId $op
+    if {[info exists socketWrQueue($connId)]} {
+	set msg {the connection was closed by CancelWritePipeline}
+	foreach token $socketWrQueue($connId) {
+	    set tk [namespace tail $token]
+	    Log ^X$tk end of response "($msg)" - token $token
+	    set ${token}(status) eof
+	    Finish $token ;#$msg
+	}
+	set socketWrQueue($connId) {}
+    }
+}
+
+# http::ReplayIfDead --
+#
+# - A query on a re-used persistent socket failed at the earliest opportunity,
+#   because the socket had been closed by the server.  Keep the token, tidy up,
+#   and try to connect on a fresh socket.
+# - The connection is monitored for eof by the command http::CheckEof.  Thus
+#   http::ReplayIfDead is needed only when a server event (half-closing an
+#   apparently idle connection), and a client event (sending a request) occur at
+#   almost the same time, and neither client nor server detects the other's
+#   action before performing its own (an "asynchronous close event").
+# - To simplify testing of http::ReplayIfDead, set TEST_EOF 1 in
+#   http::KeepSocket, and then http::ReplayIfDead will be called if http::geturl
+#   is called at any time after the server timeout.
+#
+# Arguments:
+#	token	Connection token.
+#
+# Side Effects:
+#	Use the same token, but try to open a new socket.
+
+proc http::ReplayIfDead {tokenArg doing} {
+    variable socketMapping
+    variable socketRdState
+    variable socketWrState
+    variable socketRdQueue
+    variable socketWrQueue
+    variable socketClosing
+    variable socketPlayCmd
+
+    variable $tokenArg
+    upvar 0 $tokenArg stateArg
+
+    Log running http::ReplayIfDead for $tokenArg $doing
+
+    # 1. Merge the tokens for transactions in flight, the read (response) queue,
+    #    and the write (request) queue.
+
+    set InFlightR {}
+    set InFlightW {}
+
+    # Obtain the tokens for transactions in flight.
+    if {$stateArg(-pipeline)} {
+	# Two transactions may be in flight.  The "read" transaction was first.
+	# It is unlikely that the server would close the socket if a response
+	# was pending; however, an earlier request (as well as the present
+	# request) may have been sent and ignored if the socket was half-closed
+	# by the server.
+
+	if {    [info exists socketRdState($stateArg(socketinfo))]
+	     && ($socketRdState($stateArg(socketinfo)) ne "Rready")
+	} {
+	    lappend InFlightR $socketRdState($stateArg(socketinfo))
+	} elseif {($doing eq "read")} {
+	    lappend InFlightR $tokenArg
+	}
+
+	if {    [info exists socketWrState($stateArg(socketinfo))]
+	     && $socketWrState($stateArg(socketinfo)) ni {Wready peNding}
+	} {
+	    lappend InFlightW $socketWrState($stateArg(socketinfo))
+	} elseif {($doing eq "write")} {
+	    lappend InFlightW $tokenArg
+	}
+
+	# Report any inconsistency of $tokenArg with socket*state.
+	if {    ($doing eq "read")
+	     && [info exists socketRdState($stateArg(socketinfo))]
+	     && ($tokenArg ne $socketRdState($stateArg(socketinfo)))
+	} {
+	    Log WARNING - ReplayIfDead pipelined tokenArg $tokenArg $doing \
+		    ne socketRdState($stateArg(socketinfo)) \
+		      $socketRdState($stateArg(socketinfo))
+
+	} elseif {
+		($doing eq "write")
+	     && [info exists socketWrState($stateArg(socketinfo))]
+	     && ($tokenArg ne $socketWrState($stateArg(socketinfo)))
+	} {
+	    Log WARNING - ReplayIfDead pipelined tokenArg $tokenArg $doing \
+		    ne socketWrState($stateArg(socketinfo)) \
+		      $socketWrState($stateArg(socketinfo))
+	}
+    } else {
+	# One transaction should be in flight.
+	# socketRdState, socketWrQueue are used.
+	# socketRdQueue should be empty.
+
+	# Report any inconsistency of $tokenArg with socket*state.
+	if {$tokenArg ne $socketRdState($stateArg(socketinfo))} {
+	    Log WARNING - ReplayIfDead nonpipeline tokenArg $tokenArg $doing \
+		    ne socketRdState($stateArg(socketinfo)) \
+		      $socketRdState($stateArg(socketinfo))
+	}
+
+	# Report the inconsistency that socketRdQueue is non-empty.
+	if {    [info exists socketRdQueue($stateArg(socketinfo))]
+	     && ($socketRdQueue($stateArg(socketinfo)) ne {})
+	} {
+	    Log WARNING - ReplayIfDead nonpipeline tokenArg $tokenArg $doing \
+		    has read queue socketRdQueue($stateArg(socketinfo)) \
+		    $socketRdQueue($stateArg(socketinfo)) ne {}
+	}
+
+	lappend InFlightW $socketRdState($stateArg(socketinfo))
+	set socketRdQueue($stateArg(socketinfo)) {}
+    }
+
+    set newQueue {}
+    lappend newQueue {*}$InFlightR
+    lappend newQueue {*}$socketRdQueue($stateArg(socketinfo))
+    lappend newQueue {*}$InFlightW
+    lappend newQueue {*}$socketWrQueue($stateArg(socketinfo))
+
+
+    # 2. Tidy up tokenArg.  This is a cut-down form of Finish/CloseSocket.
+    #    Do not change state(status).
+    #    No need to after cancel stateArg(after) - either this is done in
+    #    ReplayCore/ReInit, or Finish is called.
+
+    catch {close $stateArg(sock)}
+
+    # 2a. Tidy the tokens in the queues - this is done in ReplayCore/ReInit.
+    # - Transactions, if any, that are awaiting responses cannot be completed.
+    #   They are listed for re-sending in newQueue.
+    # - All tokens are preserved for re-use by ReplayCore, and their variables
+    #   will be re-initialised by calls to ReInit.
+    # - The relevant element of socketMapping, socketRdState, socketWrState,
+    #   socketRdQueue, socketWrQueue, socketClosing, socketPlayCmd will be set
+    #   to new values in ReplayCore.
+
+    ReplayCore $newQueue
+}
+
+# http::ReplayIfClose --
+#
+#	A request on a socket that was previously "Connection: keep-alive" has
+#	received a "Connection: close" response header.  The server supplies
+#	that response correctly, but any later requests already queued on this
+#	connection will be lost when the socket closes.
+#
+#	This command takes arguments that represent the socketWrState,
+#	socketRdQueue and socketWrQueue for this connection.  The socketRdState
+#	is not needed because the server responds in full to the request that
+#	received the "Connection: close" response header.
+#
+#	Existing request tokens $token (::http::$n) are preserved.  The caller
+#	will be unaware that the request was processed this way.
+
+proc http::ReplayIfClose {Wstate Rqueue Wqueue} {
+    Log running http::ReplayIfClose for $Wstate $Rqueue $Wqueue
+
+    if {$Wstate in $Rqueue || $Wstate in $Wqueue} {
+	Log WARNING duplicate token in http::ReplayIfClose - token $Wstate
+	set Wstate Wready
+    }
+
+    # 1. Create newQueue
+    set InFlightW {}
+    if {$Wstate ni {Wready peNding}} {
+	lappend InFlightW $Wstate
+    }
+
+    set newQueue {}
+    lappend newQueue {*}$Rqueue
+    lappend newQueue {*}$InFlightW
+    lappend newQueue {*}$Wqueue
+
+    # 2. Cleanup - none needed, done by the caller.
+
+    ReplayCore $newQueue
+}
+
+# http::ReInit --
+#
+#	Command to restore a token's state to a condition that
+#	makes it ready to replay a request.
+#
+#	Command http::geturl stores extra state in state(tmp*) so
+#	we don't need to do the argument processing again.
+#
+#	The caller must:
+#	- Set state(reusing) and state(sock) to their new values after calling
+#	  this command.
+#	- Unset state(tmpState), state(tmpOpenCmd) if future calls to ReplayCore
+#	  or ReInit are inappropriate for this token. Typically only one retry
+#	  is allowed.
+#	The caller may also unset state(tmpConnArgs) if this value (and the
+#	token) will be used immediately.  The value is needed by tokens that
+#	will be stored in a queue.
+#
+# Arguments:
+#	token	Connection token.
+#
+# Return Value: (boolean) true iff the re-initialisation was successful.
+
+proc http::ReInit {token} {
+    variable $token
+    upvar 0 $token state
+
+    if {!(
+	      [info exists state(tmpState)]
+	   && [info exists state(tmpOpenCmd)]
+	   && [info exists state(tmpConnArgs)]
+	 )
+    } {
+	Log FAILED in http::ReInit via ReplayCore - NO tmp vars for $token
+	return 0
+    }
+
+    if {[info exists state(after)]} {
+	after cancel $state(after)
+	unset state(after)
+    }
+
+    # Don't alter state(status) - this would trigger http::wait if it is in use.
+    set tmpState    $state(tmpState)
+    set tmpOpenCmd  $state(tmpOpenCmd)
+    set tmpConnArgs $state(tmpConnArgs)
+    foreach name [array names state] {
+	if {$name ne "status"} {
+	    unset state($name)
+	}
+    }
+
+    # Don't alter state(status).
+    # Restore state(tmp*) - the caller may decide to unset them.
+    # Restore state(tmpConnArgs) which is needed for connection.
+    # state(tmpState), state(tmpOpenCmd) are needed only for retries.
+
+    dict unset tmpState status
+    array set state $tmpState
+    set state(tmpState)    $tmpState
+    set state(tmpOpenCmd)  $tmpOpenCmd
+    set state(tmpConnArgs) $tmpConnArgs
+
+    return 1
+}
+
+# http::ReplayCore --
+#
+#	Command to replay a list of requests, using existing connection tokens.
+#
+#	Abstracted from http::geturl which stores extra state in state(tmp*) so
+#	we don't need to do the argument processing again.
+#
+# Arguments:
+#	newQueue	List of connection tokens.
+#
+# Side Effects:
+#	Use existing tokens, but try to open a new socket.
+
+proc http::ReplayCore {newQueue} {
+    variable socketMapping
+    variable socketRdState
+    variable socketWrState
+    variable socketRdQueue
+    variable socketWrQueue
+    variable socketClosing
+    variable socketPlayCmd
+
+    if {[llength $newQueue] == 0} {
+	# Nothing to do.
+	return
+    }
+
+    ##Log running ReplayCore for {*}$newQueue
+    set newToken [lindex $newQueue 0]
+    set newQueue [lrange $newQueue 1 end]
+
+    # 3. Use newToken, and restore its values of state(*).  Do not restore
+    #    elements tmp* - we try again only once.
+
+    set token $newToken
+    variable $token
+    upvar 0 $token state
+
+    if {![ReInit $token]} {
+	Log FAILED in http::ReplayCore - NO tmp vars
+	Finish $token {cannot send this request again}
+	return
+    }
+
+    set tmpState    $state(tmpState)
+    set tmpOpenCmd  $state(tmpOpenCmd)
+    set tmpConnArgs $state(tmpConnArgs)
+    unset state(tmpState)
+    unset state(tmpOpenCmd)
+    unset state(tmpConnArgs)
+
+    set state(reusing) 0
+
+    if {$state(-timeout) > 0} {
+	set resetCmd [list http::reset $token timeout]
+	set state(after) [after $state(-timeout) $resetCmd]
+    }
+
+    set pre [clock milliseconds]
+    ##Log pre socket opened, - token $token
+    ##Log $tmpOpenCmd - token $token
+    # 4. Open a socket.
+    if {[catch {eval $tmpOpenCmd} sock]} {
+	# Something went wrong while trying to establish the connection.
+	Log FAILED - $sock
+	set state(sock) NONE
+	Finish $token $sock
+	return
+    }
+    ##Log post socket opened, - token $token
+    set delay [expr {[clock milliseconds] - $pre}]
+    if {$delay > 3000} {
+	Log socket delay $delay - token $token
+    }
+    # Command [socket] is called with -async, but takes 5s to 5.1s to return,
+    # with probability of order 1 in 10,000.  This may be a bizarre scheduling
+    # issue with my (KJN's) system (Fedora Linux).
+    # This does not cause a problem (unless the request times out when this
+    # command returns).
+
+    # 5. Configure the persistent socket data.
+    if {$state(-keepalive)} {
+	set socketMapping($state(socketinfo)) $sock
+
+	if {![info exists socketRdState($state(socketinfo))]} {
+	    set socketRdState($state(socketinfo)) {}
+	    set varName ::http::socketRdState($state(socketinfo))
+	    trace add variable $varName unset ::http::CancelReadPipeline
+	}
+
+	if {![info exists socketWrState($state(socketinfo))]} {
+	    set socketWrState($state(socketinfo)) {}
+	    set varName ::http::socketWrState($state(socketinfo))
+	    trace add variable $varName unset ::http::CancelWritePipeline
+	}
+
+	if {$state(-pipeline)} {
+	    #Log new, init for pipelined, GRANT write acc to $token ReplayCore
+	    set socketRdState($state(socketinfo)) $token
+	    set socketWrState($state(socketinfo)) $token
+	} else {
+	    #Log new, init for nonpipeline, GRANT r/w acc to $token ReplayCore
+	    set socketRdState($state(socketinfo)) $token
+	    set socketWrState($state(socketinfo)) $token
+	}
+
+	set socketRdQueue($state(socketinfo)) {}
+	set socketWrQueue($state(socketinfo)) $newQueue
+	set socketClosing($state(socketinfo)) 0
+	set socketPlayCmd($state(socketinfo)) {ReplayIfClose Wready {} {}}
+    }
+
+    ##Log pre newQueue ReInit, - token $token
+    # 6. Configure sockets in the queue.
+    foreach tok $newQueue {
+	if {[ReInit $tok]} {
+	    set ${tok}(reusing) 1
+	    set ${tok}(sock) $sock
+	} else {
+	    set ${tok}(reusing) 1
+	    set ${tok}(sock) NONE
+	    Finish $token {cannot send this request again}
+	}
+    }
+
+    # 7. Configure the socket for newToken to send a request.
+    set state(sock) $sock
+    Log "Using $sock for $state(socketinfo) - token $token" \
+	[expr {$state(-keepalive)?"keepalive":""}]
+
+    # Initialisation of a new socket.
+    ##Log socket opened, now fconfigure - token $token
+    fconfigure $sock -translation {auto crlf} -buffersize $state(-blocksize)
+    ##Log socket opened, DONE fconfigure - token $token
+
+    # Connect does its own fconfigure.
+    fileevent $sock writable [list http::Connect $token {*}$tmpConnArgs]
+    #Log ---- $sock << conn to $token for HTTP request (e)
+}
+
 # Data access functions:
 # Data - the URL data
-# Status - the transaction status: ok, reset, eof, timeout
+# Status - the transaction status: ok, reset, eof, timeout, error
 # Code - the HTTP transaction code, e.g., 200
 # Size - the size of the URL data
 
@@ -895,6 +2256,13 @@ proc http::error {token} {
 proc http::cleanup {token} {
     variable $token
     upvar 0 $token state
+    if {[info commands ${token}EventCoroutine] ne {}} {
+	rename ${token}EventCoroutine {}
+    }
+    if {[info exists state(after)]} {
+	after cancel $state(after)
+	unset state(after)
+    }
     if {[info exists state]} {
 	unset state
     }
@@ -914,17 +2282,33 @@ proc http::cleanup {token} {
 proc http::Connect {token proto phost srvurl} {
     variable $token
     upvar 0 $token state
+    set tk [namespace tail $token]
     set err "due to unexpected EOF"
     if {
 	[eof $state(sock)] ||
 	[set err [fconfigure $state(sock) -error]] ne ""
     } {
+	Log "WARNING - if testing, pay special attention to this\
+		case (GJ) which is seldom executed - token $token"
+	if {[info exists state(reusing)] && $state(reusing)} {
+	    # The socket was closed at the server end, and closed at
+	    # this end by http::CheckEof.
+	    if {[TestForReplay $token write $err b]} {
+		return
+	    }
+
+	    # else:
+	    # This is NOT a persistent socket that has been closed since its
+	    # last use.
+	    # If any other requests are in flight or pipelined/queued, they will
+	    # be discarded.
+	}
 	Finish $token "connect failed $err"
     } else {
+	set state(state) connecting
 	fileevent $state(sock) writable {}
 	::http::Connected $token $proto $phost $srvurl
     }
-    return
 }
 
 # http::Write
@@ -938,8 +2322,18 @@ proc http::Connect {token proto phost srvurl} {
 #	Write the socket and handle callbacks.
 
 proc http::Write {token} {
+    variable http
+    variable socketMapping
+    variable socketRdState
+    variable socketWrState
+    variable socketRdQueue
+    variable socketWrQueue
+    variable socketClosing
+    variable socketPlayCmd
+
     variable $token
     upvar 0 $token state
+    set tk [namespace tail $token]
     set sock $state(sock)
 
     # Output a block.  Tcl will buffer this if the socket blocks
@@ -950,7 +2344,21 @@ proc http::Write {token} {
 	if {[info exists state(-query)]} {
 	    # Chop up large query strings so queryprogress callback can give
 	    # smooth feedback.
-
+	    if {    $state(queryoffset) + $state(-queryblocksize)
+		 >= $state(querylength)
+	    } {
+		# This will be the last puts for the request-body.
+		if {    (![catch {fileevent $sock readable} binding])
+		     && ($binding eq [list http::CheckEof $sock])
+		} {
+		    # Remove the "fileevent readable" binding of an idle
+		    # persistent socket to http::CheckEof.  We can no longer
+		    # treat bytes received as junk. The server might still time
+		    # out and half-close the socket if it has not yet received
+		    # the first "puts".
+		    fileevent $sock readable {}
+		}
+	    }
 	    puts -nonewline $sock \
 		[string range $state(-query) $state(queryoffset) \
 		     [expr {$state(queryoffset) + $state(-queryblocksize) - 1}]]
@@ -963,6 +2371,19 @@ proc http::Write {token} {
 	    # Copy blocks from the query channel
 
 	    set outStr [read $state(-querychannel) $state(-queryblocksize)]
+	    if {[eof $state(-querychannel)]} {
+		# This will be the last puts for the request-body.
+		if {    (![catch {fileevent $sock readable} binding])
+		     && ($binding eq [list http::CheckEof $sock])
+		} {
+		    # Remove the "fileevent readable" binding of an idle
+		    # persistent socket to http::CheckEof.  We can no longer
+		    # treat bytes received as junk. The server might still time
+		    # out and half-close the socket if it has not yet received
+		    # the first "puts".
+		    fileevent $sock readable {}
+		}
+	    }
 	    puts -nonewline $sock $outStr
 	    incr state(queryoffset) [string length $outStr]
 	    if {[eof $state(-querychannel)]} {
@@ -976,10 +2397,14 @@ proc http::Write {token} {
 	set state(posterror) $err
 	set done 1
     }
+
     if {$done} {
 	catch {flush $sock}
 	fileevent $sock writable {}
-	fileevent $sock readable [list http::Event $sock $token]
+	Log ^C$tk end sending request - token $token
+	# End of writing (POST method).  The request has been sent.
+
+	DoneRequest $token
     }
 
     # Callback to the client after we've completely handled everything.
@@ -992,7 +2417,9 @@ proc http::Write {token} {
 
 # http::Event
 #
-#	Handle input on the socket
+#	Handle input on the socket. This command is the core of
+#	the coroutine commands ${token}EventCoroutine that are
+#	bound to "fileevent $sock readable" and process input.
 #
 # Arguments
 #	sock	The socket receiving input.
@@ -1002,196 +2429,532 @@ proc http::Write {token} {
 #	Read the socket and handle callbacks.
 
 proc http::Event {sock token} {
+    variable http
+    variable socketMapping
+    variable socketRdState
+    variable socketWrState
+    variable socketRdQueue
+    variable socketWrQueue
+    variable socketClosing
+    variable socketPlayCmd
+
     variable $token
     upvar 0 $token state
+    set tk [namespace tail $token]
+    while 1 {
+	yield
+	##Log Event call - token $token
 
-    if {![info exists state]} {
-	Log "Event $sock with invalid token '$token' - remote close?"
-	if {![eof $sock]} {
-	    if {[set d [read $sock]] ne ""} {
-		Log "WARNING: additional data left on closed socket"
+	if {![info exists state]} {
+	    Log "Event $sock with invalid token '$token' - remote close?"
+	    if {![eof $sock]} {
+		if {[set d [read $sock]] ne ""} {
+		    Log "WARNING: additional data left on closed socket\
+			    - token $token"
+		}
 	    }
+	    Log ^X$tk end of response (token error) - token $token
+	    CloseSocket $sock
+	    return
 	}
-	CloseSocket $sock
-	return
-    }
-    if {$state(state) eq "connecting"} {
-	if {[catch {gets $sock state(http)} n]} {
-	    return [Finish $token $n]
-	} elseif {$n >= 0} {
-	    set state(state) "header"
-	}
-    } elseif {$state(state) eq "header"} {
-	if {[catch {gets $sock line} n]} {
-	    return [Finish $token $n]
-	} elseif {$n == 0} {
-	    # We have now read all headers
-	    # We ignore HTTP/1.1 100 Continue returns. RFC2616 sec 8.2.3
-	    if {$state(http) == "" || ([regexp {^\S+\s(\d+)} $state(http) {} x] && $x == 100)} {
-		set state(state) "connecting"
-		return
+	if {$state(state) eq "connecting"} {
+	    ##Log - connecting - token $token
+	    if {    $state(reusing)
+		 && $state(-pipeline)
+		 && ($state(-timeout) > 0)
+		 && (![info exists state(after)])
+	    } {
+		set state(after) [after $state(-timeout) \
+			[list http::reset $token timeout]]
 	    }
 
-	    set state(state) body
+	    if {[catch {gets $sock state(http)} nsl]} {
+		Log "WARNING - if testing, pay special attention to this\
+			case (GK) which is seldom executed - token $token"
+		if {[info exists state(reusing)] && $state(reusing)} {
+		    # The socket was closed at the server end, and closed at
+		    # this end by http::CheckEof.
 
-	    # If doing a HEAD, then we won't get any body
-	    if {$state(-validate)} {
-		Eof $token
-		return
-	    }
+		    if {[TestForReplay $token read $nsl c]} {
+			return
+		    }
 
-	    # For non-chunked transfer we may have no body - in this case we
-	    # may get no further file event if the connection doesn't close
-	    # and no more data is sent. We can tell and must finish up now -
-	    # not later.
-	    if {
-		!(([info exists state(connection)]
-			&& ($state(connection) eq "close"))
-		    || [info exists state(transfer)])
-		&& ($state(totalsize) == 0)
+		    # else:
+		    # This is NOT a persistent socket that has been closed since
+		    # its last use.
+		    # If any other requests are in flight or pipelined/queued,
+		    # they will be discarded.
+		} else {
+		    Log ^X$tk end of response (error) - token $token
+		    Finish $token $nsl
+		    return
+		}
+	    } elseif {$nsl >= 0} {
+		##Log - connecting 1 - token $token
+		set state(state) "header"
+	    } elseif {    [eof $sock]
+		       && [info exists state(reusing)]
+		       && $state(reusing)
 	    } {
-		Log "body size is 0 and no events likely - complete."
-		Eof $token
-		return
-	    }
+		# The socket was closed at the server end, and we didn't notice.
+		# This is the first read - where the closure is usually first
+		# detected.
 
-	    # We have to use binary translation to count bytes properly.
-	    fconfigure $sock -translation binary
+		if {[TestForReplay $token read {} d]} {
+		    return
+		}
 
-	    if {
-		$state(-binary) || [IsBinaryContentType $state(type)]
-	    } {
-		# Turn off conversions for non-text data
-		set state(binary) 1
+		# else:
+		# This is NOT a persistent socket that has been closed since its
+		# last use.
+		# If any other requests are in flight or pipelined/queued, they
+		# will be discarded.
 	    }
-	    if {[info exists state(-channel)]} {
-		if {$state(binary) || [llength [ContentEncoding $token]]} {
-		    fconfigure $state(-channel) -translation binary
+	} elseif {$state(state) eq "header"} {
+	    if {[catch {gets $sock line} nhl]} {
+		##Log header failed - token $token
+		Log ^X$tk end of response (error) - token $token
+		Finish $token $nhl
+		return
+	    } elseif {$nhl == 0} {
+		##Log header done - token $token
+		Log ^E$tk end of response headers - token $token
+		# We have now read all headers
+		# We ignore HTTP/1.1 100 Continue returns. RFC2616 sec 8.2.3
+		if {    ($state(http) == "")
+		     || ([regexp {^\S+\s(\d+)} $state(http) {} x] && $x == 100)
+		} {
+		    set state(state) "connecting"
+		    continue
+		    # This was a "return" in the pre-coroutine code.
 		}
-		if {![info exists state(-handler)]} {
-		    # Initiate a sequence of background fcopies
-		    fileevent $sock readable {}
-		    CopyStart $sock $token
-		    return
+
+		if {    ([info exists state(connection)])
+		     && ([info exists socketMapping($state(socketinfo))])
+		     && ($state(connection) eq "keep-alive")
+		     && ($state(-keepalive))
+		     && (!$state(reusing))
+		     && ($state(-pipeline))
+		} {
+		    # Response headers received for first request on a
+		    # persistent socket.  Now ready for pipelined writes (if
+		    # any).
+		    # Previous value is $token. It cannot be "pending".
+		    set socketWrState($state(socketinfo)) Wready
+		    http::NextPipelinedWrite $token
 		}
-	    }
-	} elseif {$n > 0} {
-	    # Process header lines
-	    if {[regexp -nocase {^([^:]+):(.+)$} $line x key value]} {
-		switch -- [string tolower $key] {
-		    content-type {
-			set state(type) [string trim [string tolower $value]]
-			# grab the optional charset information
-			if {[regexp -nocase \
-				 {charset\s*=\s*\"((?:[^""]|\\\")*)\"} \
-				 $state(type) -> cs]} {
-			    set state(charset) [string map {{\"} \"} $cs]
+
+		# Once a "close" has been signaled, the client MUST NOT send any
+		# more requests on that connection.
+		#
+		# If either the client or the server sends the "close" token in
+		# the Connection header, that request becomes the last one for
+		# the connection.
+
+		if {    ([info exists state(connection)])
+		     && ([info exists socketMapping($state(socketinfo))])
+		     && ($state(connection) eq "close")
+		     && ($state(-keepalive))
+		} {
+		    # The server warns that it will close the socket after this
+		    # response.
+		    ##Log WARNING - socket will close after response for $token
+		    # Prepare data for a call to ReplayIfClose.
+		    if {    ($socketRdQueue($state(socketinfo)) ne {})
+			 || ($socketWrQueue($state(socketinfo)) ne {})
+			 || ($socketWrState($state(socketinfo)) ni
+						[list Wready peNding $token])
+		    } {
+			set InFlightW $socketWrState($state(socketinfo))
+			if {$InFlightW in [list Wready peNding $token]} {
+			    set InFlightW Wready
 			} else {
-			    regexp -nocase {charset\s*=\s*(\S+?);?} \
-				$state(type) -> state(charset)
+			    set msg "token ${InFlightW} is InFlightW"
+			    ##Log $msg - token $token
 			}
+
+			set socketPlayCmd($state(socketinfo)) \
+				[list ReplayIfClose $InFlightW \
+				$socketRdQueue($state(socketinfo)) \
+				$socketWrQueue($state(socketinfo))]
+
+			# - All tokens are preserved for re-use by ReplayCore.
+			# - Queues are preserved in case of Finish with error,
+			#   but are not used for anything else because
+			#   socketClosing(*) is set below.
+			# - Cancel the state(after) timeout events.
+			foreach tokenVal $socketRdQueue($state(socketinfo)) {
+			    if {[info exists ${tokenVal}(after)]} {
+				after cancel [set ${tokenVal}(after)]
+				unset ${tokenVal}(after)
+			    }
+			}
+
+		    } else {
+			set socketPlayCmd($state(socketinfo)) \
+				{ReplayIfClose Wready {} {}}
 		    }
-		    content-length {
-			set state(totalsize) [string trim $value]
-		    }
-		    content-encoding {
-			set state(coding) [string trim $value]
+
+		    # Do not allow further connections on this socket.
+		    set socketClosing($state(socketinfo)) 1
+		}
+
+		set state(state) body
+
+		# If doing a HEAD, then we won't get any body
+		if {$state(-validate)} {
+		    Log ^F$tk end of response for HEAD request - token $token
+		    set state(state) complete
+		    Eot $token
+		    return
+		}
+
+		# - For non-chunked transfer we may have no body - in this case
+		#   we may get no further file event if the connection doesn't
+		#   close and no more data is sent. We can tell and must finish
+		#   up now - not later - the alternative would be to wait until
+		#   the server times out.
+		# - In this case, the server has NOT told the client it will
+		#   close the connection, AND it has NOT indicated the resource
+		#   length EITHER by setting the Content-Length (totalsize) OR
+		#   by using chunked Transfer-Encoding.
+		# - Do not worry here about the case (Connection: close) because
+		#   the server should close the connection.
+		# - IF (NOT Connection: close) AND (NOT chunked encoding) AND
+		#      (totalsize == 0).
+
+		if {    (!(    [info exists state(connection)]
+			    && ($state(connection) eq "close")
+			  )
+			)
+		     && (![info exists state(transfer)])
+		     && ($state(totalsize) == 0)
+		} {
+		    set msg {body size is 0 and no events likely - complete}
+		    Log "$msg - token $token"
+		    set msg {(length unknown, set to 0)}
+		    Log ^F$tk end of response body {*}$msg - token $token
+		    set state(state) complete
+		    Eot $token
+		    return
+		}
+
+		# We have to use binary translation to count bytes properly.
+		lassign [fconfigure $sock -translation] trRead trWrite
+		fconfigure $sock -translation [list binary $trWrite]
+
+		if {
+		    $state(-binary) || [IsBinaryContentType $state(type)]
+		} {
+		    # Turn off conversions for non-text data.
+		    set state(binary) 1
+		}
+		if {[info exists state(-channel)]} {
+		    if {$state(binary) || [llength [ContentEncoding $token]]} {
+			fconfigure $state(-channel) -translation binary
 		    }
-		    transfer-encoding {
-			set state(transfer) \
-			    [string trim [string tolower $value]]
+		    if {![info exists state(-handler)]} {
+			# Initiate a sequence of background fcopies.
+			fileevent $sock readable {}
+			rename ${token}EventCoroutine {}
+			CopyStart $sock $token
+			return
 		    }
-		    proxy-connection -
-		    connection {
-			set state(connection) \
-			    [string trim [string tolower $value]]
+		}
+	    } elseif {$nhl > 0} {
+		# Process header lines.
+		##Log header - token $token - $line
+		if {[regexp -nocase {^([^:]+):(.+)$} $line x key value]} {
+		    switch -- [string tolower $key] {
+			content-type {
+			    set state(type) [string trim [string tolower $value]]
+			    # Grab the optional charset information.
+			    if {[regexp -nocase \
+				    {charset\s*=\s*\"((?:[^""]|\\\")*)\"} \
+				    $state(type) -> cs]} {
+				set state(charset) [string map {{\"} \"} $cs]
+			    } else {
+				regexp -nocase {charset\s*=\s*(\S+?);?} \
+					$state(type) -> state(charset)
+			    }
+			}
+			content-length {
+			    set state(totalsize) [string trim $value]
+			}
+			content-encoding {
+			    set state(coding) [string trim $value]
+			}
+			transfer-encoding {
+			    set state(transfer) \
+				    [string trim [string tolower $value]]
+			}
+			proxy-connection -
+			connection {
+			    set state(connection) \
+				    [string trim [string tolower $value]]
+			}
 		    }
+		    lappend state(meta) $key [string trim $value]
 		}
-		lappend state(meta) $key [string trim $value]
 	    }
-	}
-    } else {
-	# Now reading body
-	if {[catch {
-	    if {[info exists state(-handler)]} {
-		set n [eval $state(-handler) [list $sock $token]]
-	    } elseif {[info exists state(transfer_final)]} {
-		set line [getTextLine $sock]
-		set n [string length $line]
-		if {$n > 0} {
-		    Log "found $n bytes following final chunk"
-		    append state(transfer_final) $line
-		} else {
-		    Log "final chunk part"
-		    Eof $token
-		}
-	    } elseif {
-		[info exists state(transfer)]
-		&& $state(transfer) eq "chunked"
-	    } {
-		set size 0
-		set chunk [getTextLine $sock]
-		set n [string length $chunk]
-		if {[string trim $chunk] ne ""} {
-		    scan $chunk %x size
-		    if {$size != 0} {
-			set bl [fconfigure $sock -blocking]
-			fconfigure $sock -blocking 1
-			set chunk [read $sock $size]
-			fconfigure $sock -blocking $bl
-			set n [string length $chunk]
-			if {$n >= 0} {
-			    append state(body) $chunk
+	} else {
+	    # Now reading body
+	    ##Log body - token $token
+	    if {[catch {
+		if {[info exists state(-handler)]} {
+		    set n [eval $state(-handler) [list $sock $token]]
+		    ##Log handler $n - token $token
+		    # N.B. the protocol has been set to 1.0 because the -handler
+		    # logic is not expected to handle chunked encoding.
+		    # FIXME Allow -handler with 1.1 on dechunked stacked chan.
+		    if {$state(totalsize) == 0} {
+			# We know the transfer is complete only when the server
+			# closes the connection - i.e. eof is not an error.
+			set state(state) complete
+		    }
+		    if {![string is integer -strict $n]} {
+			if 1 {
+			    # Do not tolerate bad -handler - fail with error
+			    # status.
+			    set msg {the -handler command for http::geturl must\
+				    return an integer (the number of bytes\
+				    read)}
+			    Log ^X$tk end of response (handler error) -\
+				    token $token
+			    Eot $token $msg
+			} else {
+			    # Tolerate the bad -handler, and continue.  The
+			    # penalty:
+			    # (a) Because the handler returns nonsense, we know
+			    #     the transfer is complete only when the server
+			    #     closes the connection - i.e. eof is not an
+			    #     error.
+			    # (b) http::size will not be accurate.
+			    # (c) The transaction is already downgraded to 1.0
+			    #     to avoid chunked transfer encoding.  It MUST
+			    #     also be forced to "Connection: close" or the
+			    #     HTTP/1.0 equivalent; or it MUST fail (as
+			    #     above) if the server sends
+			    #     "Connection: keep-alive" or the HTTP/1.0
+			    #     equivalent.
+			    set n 0
+			    set state(state) complete
 			}
-			if {$size != [string length $chunk]} {
-			    Log "WARNING: mis-sized chunk:\
-				was [string length $chunk], should be $size"
+		    }
+		} elseif {[info exists state(transfer_final)]} {
+		    # This code forgives EOF in place of the final CRLF.
+		    set line [getTextLine $sock]
+		    set n [string length $line]
+		    set state(state) complete
+		    if {$n > 0} {
+			# - HTTP trailers (late response headers) are permitted
+			#   by Chunked Transfer-Encoding, and can be safely
+			#   ignored.
+			# - Do not count these bytes in the total received for
+			#   the response body.
+			Log "trailer of $n bytes after final chunk -\
+				token $token"
+			append state(transfer_final) $line
+			set n 0
+		    } else {
+			Log ^F$tk end of response body (chunked) - token $token
+			Log "final chunk part - token $token"
+			Eot $token
+		    }
+		} elseif {    [info exists state(transfer)]
+			   && ($state(transfer) eq "chunked")
+		} {
+		    ##Log chunked - token $token
+		    set size 0
+		    set hexLenChunk [getTextLine $sock]
+		    #set ntl [string length $hexLenChunk]
+		    if {[string trim $hexLenChunk] ne ""} {
+			scan $hexLenChunk %x size
+			if {$size != 0} {
+			    ##Log chunk-measure $size - token $token
+			    set chunk [BlockingRead $sock $size]
+			    set n [string length $chunk]
+			    if {$n >= 0} {
+				append state(body) $chunk
+				incr state(log_size) [string length $chunk]
+				##Log chunk $n cumul $state(log_size) -\
+					token $token
+			    }
+			    if {$size != [string length $chunk]} {
+				Log "WARNING: mis-sized chunk:\
+				    was [string length $chunk], should be\
+				    $size - token $token"
+				set n 0
+				set state(connection) close
+				Log ^X$tk end of response (chunk error) \
+					- token $token
+				set msg {error in chunked encoding - fetch\
+					terminated}
+				Eot $token $msg
+			    }
+			    # CRLF that follows chunk.
+			    # If eof, this is handled at the end of this proc.
+			    getTextLine $sock
+			} else {
+			    set n 0
+			    set state(transfer_final) {}
 			}
-			getTextLine $sock
 		    } else {
-			set state(transfer_final) {}
+			# Line expected to hold chunk length is empty, or eof.
+			##Log bad-chunk-measure - token $token
+			set n 0
+			set state(connection) close
+			Log ^X$tk end of response (chunk error) - token $token
+			Eot $token {error in chunked encoding -\
+				fetch terminated}
+		    }
+		} else {
+		    ##Log unchunked - token $token
+		    if {$state(totalsize) == 0} {
+			# We know the transfer is complete only when the server
+			# closes the connection.
+			set state(state) complete
+			set reqSize $state(-blocksize)
+		    } else {
+			# Ask for the whole of the unserved response-body.
+			# This works around a problem with a tls::socket - for
+			# https in keep-alive mode, and a request for
+			# $state(-blocksize) bytes, the last part of the
+			# resource does not get read until the server times out.
+			set reqSize [expr {  $state(totalsize)
+					   - $state(currentsize)}]
+
+			# The workaround fails if reqSize is
+			# capped at $state(-blocksize).
+			# set reqSize [expr {min($reqSize, $state(-blocksize))}]
+		    }
+		    set c $state(currentsize)
+		    set t $state(totalsize)
+		    ##Log non-chunk currentsize $c of totalsize $t -\
+			    token $token
+		    set block [read $sock $reqSize]
+		    set n [string length $block]
+		    if {$n >= 0} {
+			append state(body) $block
+			##Log non-chunk [string length $state(body)] -\
+				token $token
 		    }
 		}
+		# This calculation uses n from the -handler, chunked, or
+		# unchunked case as appropriate.
+		if {[info exists state]} {
+		    if {$n >= 0} {
+			incr state(currentsize) $n
+			set c $state(currentsize)
+			set t $state(totalsize)
+			##Log another $n currentsize $c totalsize $t -\
+				token $token
+		    }
+		    # If Content-Length - check for end of data.
+		    if {
+			   ($state(totalsize) > 0)
+			&& ($state(currentsize) >= $state(totalsize))
+		    } {
+			Log ^F$tk end of response body (unchunked) -\
+				token $token
+			set state(state) complete
+			Eot $token
+		    }
+		}
+	    } err]} {
+		Log ^X$tk end of response (error ${err}) - token $token
+		Finish $token $err
+		return
 	    } else {
-		#Log "read non-chunk $state(currentsize) of $state(totalsize)"
-		set block [read $sock $state(-blocksize)]
-		set n [string length $block]
-		if {$n >= 0} {
-		    append state(body) $block
+		if {[info exists state(-progress)]} {
+		    eval $state(-progress) \
+			[list $token $state(totalsize) $state(currentsize)]
 		}
 	    }
-	    if {[info exists state]} {
-		if {$n >= 0} {
-		    incr state(currentsize) $n
-		}
-		# If Content-Length - check for end of data.
-		if {
-		    ($state(totalsize) > 0)
-		    && ($state(currentsize) >= $state(totalsize))
-		} {
-		    Eof $token
+	}
+
+	# catch as an Eot above may have closed the socket already
+	# $state(state) may be connecting, header, body, or complete
+	if {![set cc [catch {eof $sock} eof]] && $eof} {
+	    ##Log eof - token $token
+	    if {[info exists $token]} {
+		set state(connection) close
+		if {$state(state) eq "complete"} {
+		    # This includes all cases in which the transaction
+		    # can be completed by eof.
+		    # The value "complete" is set only in http::Event, and it is
+		    # used only in the test above.
+		    Log ^F$tk end of response body (unchunked, eof) -\
+			    token $token
+		    Eot $token
+		} else {
+		    # Premature eof.
+		    Log ^X$tk end of response (unexpected eof) - token $token
+		    Eot $token eof
 		}
+	    } else {
+		# open connection closed on a token that has been cleaned up.
+		Log ^X$tk end of response (token error) - token $token
+		CloseSocket $sock
 	    }
-	} err]} {
-	    return [Finish $token $err]
-	} else {
-	    if {[info exists state(-progress)]} {
-		eval $state(-progress) \
-		    [list $token $state(totalsize) $state(currentsize)]
-	    }
+	} elseif {$cc} {
+	    return
 	}
     }
+}
 
-    # catch as an Eof above may have closed the socket already
-    if {![catch {eof $sock} eof] && $eof} {
-	if {[info exists $token]} {
-	    set state(connection) close
-	    Eof $token
-	} else {
-	    # open connection closed on a token that has been cleaned up.
-	    CloseSocket $sock
-	}
-	return
+# http::TestForReplay
+#
+#	Command called if eof is discovered when a socket is first used for a
+#	new transaction.  Typically this occurs if a persistent socket is used
+#	after a period of idleness and the server has half-closed the socket.
+#
+# token  - the connection token returned by http::geturl
+# doing  - "read" or "write"
+# err    - error message, if any
+# caller - code to identify the caller - used only in logging
+#
+# Return Value: boolean, true iff the command calls http::ReplayIfDead.
+
+proc http::TestForReplay {token doing err caller} {
+    variable http
+    variable $token
+    upvar 0 $token state
+    set tk [namespace tail $token]
+    if {$doing eq "read"} {
+	set code Q
+	set action response
+	set ing reading
+    } else {
+	set code P
+	set action request
+	set ing writing
+    }
+
+    if {$err eq {}} {
+	set err "detect eof when $ing (server timed out?)"
+    }
+
+    if {$state(method) eq "POST" && !$http(-repost)} {
+	# No Replay.
+	# The present transaction will end when Finish is called.
+	# That call to Finish will abort any other transactions
+	# currently in the write queue.
+	# For calls from http::Event this occurs when execution
+	# reaches the code block at the end of that proc.
+	set msg {no retry for POST with http::config -repost 0}
+	Log reusing socket failed "($caller)" - $msg - token $token
+	Log error - $err - token $token
+	Log ^X$tk end of $action (error) - token $token
+	return 0
+    } else {
+	# Replay.
+	set msg {try a new socket}
+	Log reusing socket failed "($caller)" - $msg - token $token
+	Log error - $err - token $token
+	Log ^$code$tk Any unfinished (incl this one) failed - token $token
+	ReplayIfDead $token $doing
+	return 1
     }
 }
 
@@ -1229,7 +2992,10 @@ proc http::IsBinaryContentType {type} {
 
 # http::getTextLine --
 #
-#	Get one line with the stream in blocking crlf mode
+#	Get one line with the stream in crlf mode.
+#	Used if Transfer-Encoding is chunked.
+#	Empty line is not distinguished from eof.  The caller must
+#	be able to handle this.
 #
 # Arguments
 #	sock	The socket receiving input.
@@ -1239,13 +3005,55 @@ proc http::IsBinaryContentType {type} {
 
 proc http::getTextLine {sock} {
     set tr [fconfigure $sock -translation]
-    set bl [fconfigure $sock -blocking]
-    fconfigure $sock -translation crlf -blocking 1
-    set r [gets $sock]
-    fconfigure $sock -translation $tr -blocking $bl
+    lassign $tr trRead trWrite
+    fconfigure $sock -translation [list crlf $trWrite]
+    set r [BlockingGets $sock]
+    fconfigure $sock -translation $tr
     return $r
 }
 
+# http::BlockingRead
+#
+#	Replacement for a blocking read.
+#	The caller must be a coroutine.
+
+proc http::BlockingRead {sock size} {
+    if {$size < 1} {
+	return
+    }
+    set result {}
+    while 1 {
+	set need [expr {$size - [string length $result]}]
+	set block [read $sock $need]
+	set eof [eof $sock]
+	append result $block
+	if {[string length $result] >= $size || $eof} {
+	    return $result
+	} else {
+	    yield
+	}
+    }
+}
+
+# http::BlockingGets
+#
+#	Replacement for a blocking gets.
+#	The caller must be a coroutine.
+#	Empty line is not distinguished from eof.  The caller must
+#	be able to handle this.
+
+proc http::BlockingGets {sock} {
+    while 1 {
+	set count [gets $sock line]
+	set eof [eof $sock]
+	if {$count > -1 || $eof} {
+	    return $line
+	} else {
+	    yield
+	}
+    }
+}
+
 # http::CopyStart
 #
 #	Error handling wrapper around fcopy
@@ -1271,6 +3079,10 @@ proc http::CopyStart {sock token {initial 1}} {
 	    }
 	}
 	if {[catch {
+	    # FIXME Keep-Alive on https tls::socket with unchunked transfer
+	    # hangs until the server times out. A workaround is possible, as for
+	    # the case without -channel, but it does not use the neat "fcopy"
+	    # solution.
 	    fcopy $sock $state(-channel) -size $state(-blocksize) -command \
 		[list http::CopyDone $token]
 	} err]} {
@@ -1294,7 +3106,7 @@ proc http::CopyChunk {token chunk} {
 		      $token $state(totalsize) $state(currentsize)]
 	}
     } else {
-	Log "CopyChunk Finish $token"
+	Log "CopyChunk Finish - token $token"
 	if {[info exists state(zlib)]} {
 	    set excess ""
 	    foreach stream $state(zlib) {
@@ -1304,7 +3116,7 @@ proc http::CopyChunk {token chunk} {
 	    foreach stream $state(zlib) { $stream close }
 	    unset state(zlib)
 	}
-	Eof $token ;# FIX ME: pipelining.
+	Eot $token ;# FIX ME: pipelining.
     }
 }
 
@@ -1328,33 +3140,53 @@ proc http::CopyDone {token count {error {}}} {
 	eval $state(-progress) \
 	    [list $token $state(totalsize) $state(currentsize)]
     }
-    # At this point the token may have been reset
+    # At this point the token may have been reset.
     if {[string length $error]} {
 	Finish $token $error
     } elseif {[catch {eof $sock} iseof] || $iseof} {
-	Eof $token
+	Eot $token
     } else {
 	CopyStart $sock $token 0
     }
 }
 
-# http::Eof
+# http::Eot
 #
-#	Handle eof on the socket
+#	Called when either:
+#	a. An eof condition is detected on the socket.
+#	b. The client decides that the response is complete.
+#	c. The client detects an inconsistency and aborts the transaction.
+#
+#	Does:
+#	1. Set state(status)
+#	2. Reverse any Content-Encoding
+#	3. Convert charset encoding and line ends if necessary
+#	4. Call http::Finish
 #
 # Arguments
 #	token	The token returned from http::geturl
+#	force	(previously) optional, has no effect
+#	reason	- "eof" means premature EOF (not EOF as the natural end of
+#		  the response)
+#		- "" means completion of response, with or without EOF
+#		- anything else describes an error confition other than
+#		  premature EOF.
 #
 # Side Effects
 #	Clean up the socket
 
-proc http::Eof {token {force 0}} {
+proc http::Eot {token {reason {}}} {
     variable $token
     upvar 0 $token state
-    if {$state(state) eq "header"} {
-	# Premature eof
+    if {$reason eq "eof"} {
+	# Premature eof.
 	set state(status) eof
+	set reason {}
+    } elseif {$reason ne ""} {
+	# Abort the transaction.
+	set state(status) $reason
     } else {
+	# The response is complete.
 	set state(status) ok
     }
 
@@ -1364,14 +3196,15 @@ proc http::Eof {token {force 0}} {
 		set state(body) [zlib $coding $state(body)]
 	    }
 	} err]} {
-	    Log "error doing decompression: $err"
-	    return [Finish $token $err]
+	    Log "error doing decompression for token $token: $err"
+	    Finish $token $err
+	    return
 	}
 
 	if {!$state(binary)} {
 	    # If we are getting text, set the incoming channel's encoding
-	    # correctly.  iso8859-1 is the RFC default, but this could be any IANA
-	    # charset.  However, we only know how to convert what we have
+	    # correctly.  iso8859-1 is the RFC default, but this could be any
+	    # IANA charset.  However, we only know how to convert what we have
 	    # encodings for.
 
 	    set enc [CharsetToEncoding $state(charset)]
@@ -1383,7 +3216,7 @@ proc http::Eof {token {force 0}} {
 	    set state(body) [string map {\r\n \n \r \n} $state(body)]
 	}
     }
-    Finish $token
+    Finish $token $reason
 }
 
 # http::wait --
@@ -1394,7 +3227,7 @@ proc http::Eof {token {force 0}} {
 #	token	Connection token.
 #
 # Results:
-#        The status after the wait.
+#	The status after the wait.
 
 proc http::wait {token} {
     variable $token
@@ -1421,6 +3254,12 @@ proc http::wait {token} {
 #	TODO
 
 proc http::formatQuery {args} {
+    if {[llength $args] % 2} {
+        return \
+            -code error \
+            -errorcode [list HTTP BADARGCNT $args] \
+            {Incorrect number of arguments, must be an even number.}
+    }
     set result ""
     set sep ""
     foreach i $args {
@@ -1465,6 +3304,7 @@ proc http::mapReply {string} {
     }
     return $converted
 }
+interp alias {} http::quoteString {} http::mapReply
 
 # http::ProxyRequired --
 #	Default proxy filter.
@@ -1547,37 +3387,39 @@ proc http::ContentEncoding {token} {
     return $r
 }
 
+proc http::ReceiveChunked {chan command} {
+    set data ""
+    set size -1
+    yield
+    while {1} {
+	chan configure $chan -translation {crlf binary}
+	while {[gets $chan line] < 1} { yield }
+	chan configure $chan -translation {binary binary}
+	if {[scan $line %x size] != 1} {
+	    return -code error "invalid size: \"$line\""
+	}
+	set chunk ""
+	while {$size && ![chan eof $chan]} {
+	    set part [chan read $chan $size]
+	    incr size -[string length $part]
+	    append chunk $part
+	}
+	if {[catch {
+	    uplevel #0 [linsert $command end $chunk]
+	}]} {
+	    http::Log "Error in callback: $::errorInfo"
+	}
+	if {[string length $chunk] == 0} {
+	    # channel might have been closed in the callback
+	    catch {chan event $chan readable {}}
+	    return
+	}
+    }
+}
+
 proc http::make-transformation-chunked {chan command} {
-    set lambda {{chan command} {
-        set data ""
-        set size -1
-        yield
-        while {1} {
-            chan configure $chan -translation {crlf binary}
-            while {[gets $chan line] < 1} { yield }
-            chan configure $chan -translation {binary binary}
-            if {[scan $line %x size] != 1} { return -code error "invalid size: \"$line\"" }
-            set chunk ""
-            while {$size && ![chan eof $chan]} {
-                set part [chan read $chan $size]
-                incr size -[string length $part]
-                append chunk $part
-            }
-            if {[catch {
-		uplevel #0 [linsert $command end $chunk]
-	    }]} {
-		http::Log "Error in callback: $::errorInfo"
-	    }
-            if {[string length $chunk] == 0} {
-		# channel might have been closed in the callback
-                catch {chan event $chan readable {}}
-                return
-            }
-        }
-    }}
-    coroutine dechunk$chan ::apply $lambda $chan $command
-    chan event $chan readable [namespace origin dechunk$chan]
-    return
+    coroutine [namespace current]::dechunk$chan ::http::ReceiveChunked $chan $command
+    chan event $chan readable [namespace current]::dechunk$chan
 }
 
 # Local variables:
diff --git a/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl
index 3324af9..4f74635 100644
--- a/library/http/pkgIndex.tcl
+++ b/library/http/pkgIndex.tcl
@@ -1,2 +1,2 @@
 if {![package vsatisfies [package provide Tcl] 8.6-]} {return}
-package ifneeded http 2.8.13 [list tclPkgSetup $dir http 2.8.13 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
+package ifneeded http 2.9.0 [list tclPkgSetup $dir http 2.9.0 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]
diff --git a/library/init.tcl b/library/init.tcl
index 530ce58..51339d0 100644
--- a/library/init.tcl
+++ b/library/init.tcl
@@ -6,7 +6,10 @@
 # Copyright (c) 1991-1993 The Regents of the University of California.
 # Copyright (c) 1994-1996 Sun Microsystems, Inc.
 # Copyright (c) 1998-1999 Scriptics Corporation.
-# Copyright (c) 2004 by Kevin B. Kenny.  All rights reserved.
+# Copyright (c) 2004 by Kevin B. Kenny.
+# Copyright (c) 2018 by Sean Woods
+#
+# All rights reserved.
 #
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -795,3 +798,20 @@ proc tcl::CopyDirectory {action src dest} {
     }
     return
 }
+set isafe [interp issafe]
+###
+# Package manifest for all Tcl packages included in the /library file system
+###
+set isafe [interp issafe]
+set dir [file dirname [info script]]
+foreach {safe package version file} {
+  0 http            2.9.0 {http http.tcl}
+  1 msgcat          1.7.0  {msgcat msgcat.tcl}
+  1 opt             0.4.7  {opt optparse.tcl}
+  0 platform        1.0.14 {platform platform.tcl}
+  0 platform::shell 1.1.4  {platform shell.tcl}
+  1 tcltest         2.4.1  {tcltest tcltest.tcl}
+} {
+  if {$isafe && !$safe} continue
+  package ifneeded $package $version  [list source [file join $dir {*}$file]]
+}
diff --git a/library/install.tcl b/library/install.tcl
new file mode 100644
index 0000000..e62226e
--- /dev/null
+++ b/library/install.tcl
@@ -0,0 +1,244 @@
+###
+# Installer actions built into tclsh and invoked
+# if the first command line argument is "install"
+###
+if {[llength $argv] < 2} {
+  exit 0
+}
+namespace eval ::practcl {}
+###
+# Installer tools
+###
+proc ::practcl::_isdirectory name {
+  return [file isdirectory $name]
+}
+###
+# Return true if the pkgindex file contains
+# any statement other than "package ifneeded"
+# and/or if any package ifneeded loads a DLL
+###
+proc ::practcl::_pkgindex_directory {path} {
+  set buffer {}
+  set pkgidxfile [file join $path pkgIndex.tcl]
+  if {![file exists $pkgidxfile]} {
+    # No pkgIndex file, read the source
+    foreach file [glob -nocomplain $path/*.tm] {
+      set file [file normalize $file]
+      set fname [file rootname [file tail $file]]
+      ###
+      # We used to be able to ... Assume the package is correct in the filename
+      # No hunt for a "package provides"
+      ###
+      set package [lindex [split $fname -] 0]
+      set version [lindex [split $fname -] 1]
+      ###
+      # Read the file, and override assumptions as needed
+      ###
+      set fin [open $file r]
+      set dat [read $fin]
+      close $fin
+      # Look for a teapot style Package statement
+      foreach line [split $dat \n] {
+        set line [string trim $line]
+        if { [string range $line 0 9] != "# Package " } continue
+        set package [lindex $line 2]
+        set version [lindex $line 3]
+        break
+      }
+      # Look for a package provide statement
+      foreach line [split $dat \n] {
+        set line [string trim $line]
+        if { [string range $line 0 14] != "package provide" } continue
+        set package [lindex $line 2]
+        set version [lindex $line 3]
+        break
+      }
+      append buffer "package ifneeded $package $version \[list source \[file join \$dir [file tail $file]\]\]" \n
+    }
+    foreach file [glob -nocomplain $path/*.tcl] {
+      if { [file tail $file] == "version_info.tcl" } continue
+      set fin [open $file r]
+      set dat [read $fin]
+      close $fin
+      if {![regexp "package provide" $dat]} continue
+      set fname [file rootname [file tail $file]]
+      # Look for a package provide statement
+      foreach line [split $dat \n] {
+        set line [string trim $line]
+        if { [string range $line 0 14] != "package provide" } continue
+        set package [lindex $line 2]
+        set version [lindex $line 3]
+        if {[string index $package 0] in "\$ \[ @"} continue
+        if {[string index $version 0] in "\$ \[ @"} continue
+        append buffer "package ifneeded $package $version \[list source \[file join \$dir [file tail $file]\]\]" \n
+        break
+      }
+    }
+    return $buffer
+  }
+  set fin [open $pkgidxfile r]
+  set dat [read $fin]
+  close $fin
+  set trace 0
+  #if {[file tail $path] eq "tool"} {
+  #  set trace 1
+  #}
+  set thisline {}
+  foreach line [split $dat \n] {
+    append thisline $line \n
+    if {![info complete $thisline]} continue
+    set line [string trim $line]
+    if {[string length $line]==0} {
+      set thisline {} ; continue
+    }
+    if {[string index $line 0] eq "#"} {
+      set thisline {} ; continue
+    }
+    if {[regexp "if.*catch.*package.*Tcl.*return" $thisline]} {
+      if {$trace} {puts "[file dirname $pkgidxfile] Ignoring $thisline"}
+      set thisline {} ; continue
+    }
+    if {[regexp "if.*package.*vsatisfies.*package.*provide.*return" $thisline]} {
+      if {$trace} { puts "[file dirname $pkgidxfile] Ignoring $thisline" }
+      set thisline {} ; continue
+    }
+    if {![regexp "package.*ifneeded" $thisline]} {
+      # This package index contains arbitrary code
+      # source instead of trying to add it to the master
+      # package index
+      if {$trace} { puts "[file dirname $pkgidxfile] Arbitrary code $thisline" }
+      return {source [file join $dir pkgIndex.tcl]}
+    }
+    append buffer $thisline \n
+    set thisline {}
+  }
+  if {$trace} {puts [list [file dirname $pkgidxfile] $buffer]}
+  return $buffer
+}
+
+
+proc ::practcl::_pkgindex_path_subdir {path} {
+  set result {}
+  foreach subpath [glob -nocomplain [file join $path *]] {
+    if {[file isdirectory $subpath]} {
+      lappend result $subpath {*}[_pkgindex_path_subdir $subpath]
+    }
+  }
+  return $result
+}
+###
+# Index all paths given as though they will end up in the same
+# virtual file system
+###
+proc ::practcl::pkgindex_path args {
+  set stack {}
+  set buffer {
+lappend ::PATHSTACK $dir
+  }
+  foreach base $args {
+    set base [file normalize $base]
+    set paths {}
+    foreach dir [glob -nocomplain [file join $base *]] {
+      if {[file tail $dir] eq "teapot"} continue
+      lappend paths $dir {*}[::practcl::_pkgindex_path_subdir $dir]
+    }
+    set i    [string length  $base]
+    # Build a list of all of the paths
+    if {[llength $paths]} {
+      foreach path $paths {
+        if {$path eq $base} continue
+        set path_indexed($path) 0
+      }
+    } else {
+      puts [list WARNING: NO PATHS FOUND IN $base]
+    }
+    set path_indexed($base) 1
+    set path_indexed([file join $base boot tcl]) 1
+    foreach teapath [glob -nocomplain [file join $base teapot *]] {
+      set pkg [file tail $teapath]
+      append buffer [list set pkg $pkg]
+      append buffer {
+set pkginstall [file join $::g(HOME) teapot $pkg]
+if {![file exists $pkginstall]} {
+  installDir [file join $dir teapot $pkg] $pkginstall
+}
+}
+    }
+    foreach path $paths {
+      if {$path_indexed($path)} continue
+      set thisdir [file_relative $base $path]
+      set idxbuf [::practcl::_pkgindex_directory $path]
+      if {[string length $idxbuf]} {
+        incr path_indexed($path)
+        append buffer "set dir \[set PKGDIR \[file join \[lindex \$::PATHSTACK end\] $thisdir\]\]" \n
+        append buffer [string map {$dir $PKGDIR} [string trimright $idxbuf]] \n
+      }
+    }
+  }
+  append buffer {
+set dir [lindex $::PATHSTACK end]
+set ::PATHSTACK [lrange $::PATHSTACK 0 end-1]
+}
+  return $buffer
+}
+
+###
+# topic: 64319f4600fb63c82b2258d908f9d066
+# description: Script to build the VFS file system
+###
+proc ::practcl::installDir {d1 d2} {
+
+  puts [format {%*sCreating %s} [expr {4 * [info level]}] {} [file tail $d2]]
+  file delete -force -- $d2
+  file mkdir $d2
+
+  foreach ftail [glob -directory $d1 -nocomplain -tails *] {
+    set f [file join $d1 $ftail]
+    if {[file isdirectory $f] && [string compare CVS $ftail]} {
+      installDir $f [file join $d2 $ftail]
+    } elseif {[file isfile $f]} {
+	    file copy -force $f [file join $d2 $ftail]
+	    if {$::tcl_platform(platform) eq {unix}} {
+        file attributes [file join $d2 $ftail] -permissions 0644
+	    } else {
+        file attributes [file join $d2 $ftail] -readonly 1
+	    }
+    }
+  }
+
+  if {$::tcl_platform(platform) eq {unix}} {
+    file attributes $d2 -permissions 0755
+  } else {
+    file attributes $d2 -readonly 1
+  }
+}
+
+proc ::practcl::copyDir {d1 d2 {toplevel 1}} {
+  #if {$toplevel} {
+  #  puts [list ::practcl::copyDir $d1 -> $d2]
+  #}
+  #file delete -force -- $d2
+  file mkdir $d2
+
+  foreach ftail [glob -directory $d1 -nocomplain -tails *] {
+    set f [file join $d1 $ftail]
+    if {[file isdirectory $f] && [string compare CVS $ftail]} {
+      copyDir $f [file join $d2 $ftail] 0
+    } elseif {[file isfile $f]} {
+      file copy -force $f [file join $d2 $ftail]
+    }
+  }
+}
+
+switch [lindex $argv 1] {
+  mkzip {
+    zipfs mkzip {*}[lrange $argv 2 end]
+  }
+  mkzip {
+    zipfs mkimg {*}[lrange $argv 2 end]
+  }
+  default {
+    ::practcl::[lindex $argv 1] {*}[lrange $argv 2 end]
+  }
+}
+exit 0
diff --git a/library/msgcat/msgcat.tcl b/library/msgcat/msgcat.tcl
index 598330d..129cd9c 100644
--- a/library/msgcat/msgcat.tcl
+++ b/library/msgcat/msgcat.tcl
@@ -49,7 +49,7 @@ namespace eval msgcat {
 namespace eval msgcat::mcutil {
     namespace export getsystemlocale getpreferences
     namespace ensemble create -prefix 0
-    
+
     # Map of language codes used in Windows registry to those of ISO-639
     if {[info sharedlibextension] eq ".dll"} {
 	variable WinRegToISO639 [dict create  {*}{
@@ -292,7 +292,7 @@ proc msgcat::mcexists {args} {
 	}
     }
     set src [lindex $args 0]
-    
+
     if {![info exists ns]} { set ns [PackageNamespaceGet] }
 
     set loclist [PackagePreferences $ns]
@@ -537,7 +537,7 @@ proc msgcat::mcpackagelocale {subcommand args} {
 	set - preferences {
 	    # set a package locale or add a package locale
 	    set fSet [expr {$subcommand eq "set"}]
-	    
+
 	    # Check parameter
 	    if {$fSet && 1 < [llength $args] } {
 		return -code error "wrong # args: should be\
@@ -1241,7 +1241,7 @@ proc ::msgcat::PackageNamespaceGet {} {
 	}
     }
 }
-  
+
 # Initialize the default locale
 proc msgcat::mcutil::getsystemlocale {} {
     global env
diff --git a/library/tcltest/tcltest.tcl b/library/tcltest/tcltest.tcl
index f1b6082..eb42ff1 100644
--- a/library/tcltest/tcltest.tcl
+++ b/library/tcltest/tcltest.tcl
@@ -1254,6 +1254,10 @@ proc tcltest::DefineConstraintInitializers {} {
     ConstraintInitializer interactive \
 	    {expr {[info exists ::tcl_interactive] && $::tcl_interactive}}
 
+    # Skip slow tests (to enable slow tests add parameter `-constraints slowTest`)
+
+    ConstraintInitializer slowTest {format 0}
+
     # Some tests can only be run if the installation came from a CD
     # image instead of a web image.  Some tests must be skipped if you
     # are running as root on Unix.  Other tests can only be run if you
diff --git a/tests/all.tcl b/tests/all.tcl
index 69a16ba..e14bd9c 100644
--- a/tests/all.tcl
+++ b/tests/all.tcl
@@ -13,10 +13,14 @@
 package prefer latest
 package require Tcl 8.5-
 package require tcltest 2.2
-namespace import tcltest::*
-configure {*}$argv -testdir [file dir [info script]]
+namespace import ::tcltest::*
+
+configure {*}$argv -testdir [file dirname [file dirname [file normalize [
+    info script]/...]]]
+
 if {[singleProcess]} {
     interp debug {} -frame 1
 }
+
 runAllTests
 proc exit args {}
diff --git a/tests/async.test b/tests/async.test
index fa3aae1..34c2fdc 100644
--- a/tests/async.test
+++ b/tests/async.test
@@ -156,19 +156,24 @@ test async-4.1 {async interrupting bytecode sequence} -constraints {
     }
 } -body {
     apply {{handle} {
-	global aresult
-	set aresult {Async event not delivered}
-	testasync marklater $handle
-	# allow plenty of time to pass in case valgrind is running
-	set start [clock seconds]
-	while {
-		[clock seconds] - $start < 180 && $aresult eq "Async event not delivered"
-	} { 
-		nothing
-	}
+    global aresult
+    set aresult {Async event not delivered}
+    testasync marklater $handle
+    # allow plenty of time to pass in case valgrind is running
+    set start [clock seconds]
+    while {
+	[clock seconds] - $start < 180 && $aresult eq "Async event not delivered"
+    } {
+	# be less busy
+	after 100
+	nothing
+    }
 	return $aresult
     }} $hm
 } -result {test pattern} -cleanup {
+    # give other threads some time to go way so that valgrind doesn't pick up
+    # "still reachable" cases from early thread termination
+    after 100
     testasync delete $hm
 }
 test async-4.2 {async interrupting straight bytecode sequence} -constraints {
@@ -185,10 +190,15 @@ test async-4.2 {async interrupting straight bytecode sequence} -constraints {
 	while {
 		[clock seconds] - $start < 180 && $aresult eq "Async event not delivered"
 	} {
+		# be less busy
+	    after 100
 	}
 	return $aresult
     }} $hm
 } -result {test pattern} -cleanup {
+    # give other threads some time to go way so that valgrind doesn't pick up
+    # "still reachable" cases from early thread termination
+    after 100
     testasync delete $hm
 }
 test async-4.3 {async interrupting loop-less bytecode sequence} -constraints {
@@ -205,6 +215,9 @@ test async-4.3 {async interrupting loop-less bytecode sequence} -constraints {
 	return $aresult
     }]] $hm
 } -result {test pattern} -cleanup {
+    # give other threads some time to go way so that valgrind doesn't pick up
+    # "still reachable" cases from early thread termination
+    after 100
     testasync delete $hm
 }
 
diff --git a/tests/binary.test b/tests/binary.test
index 1ee815b..54e8e94 100644
--- a/tests/binary.test
+++ b/tests/binary.test
@@ -1647,22 +1647,6 @@ test binary-43.2 {Tcl_BinaryObjCmd: format wide int} {} {
     binary format W 7810179016327718216
 } lcTolleH
 
-test binary-44.1 {Tcl_BinaryObjCmd: scan wide int} {} {
-    binary scan HelloTcl W x
-    set x
-} 5216694956358656876
-test binary-44.2 {Tcl_BinaryObjCmd: scan wide int} {} {
-    binary scan lcTolleH w x
-    set x
-} 5216694956358656876
-test binary-44.3 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} {} {
-    binary scan [binary format w [expr {wide(3) << 31}]] w x
-    set x
-} 6442450944
-test binary-44.4 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} {} {
-    binary scan [binary format W [expr {wide(3) << 31}]] W x
-    set x
-} 6442450944
 test binary-43.5 {Tcl_BinaryObjCmd: scan wide int} {} {
     unset -nocomplain arg1
     list [binary scan \x80[string repeat \x00 7] W arg1] $arg1
@@ -1684,6 +1668,31 @@ test binary-43.9 {Tcl_BinaryObjCmd: scan unsigned wide int} {} {
     list [binary scan [string repeat \x00 7]\x80[string repeat \x00 7]\x80 wuw arg1 arg2] $arg1 $arg2
 } {2 9223372036854775808 -9223372036854775808}
 
+test binary-44.1 {Tcl_BinaryObjCmd: scan wide int} {} {
+    binary scan HelloTcl W x
+    set x
+} 5216694956358656876
+test binary-44.2 {Tcl_BinaryObjCmd: scan wide int} {} {
+    binary scan lcTolleH w x
+    set x
+} 5216694956358656876
+test binary-44.3 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} {} {
+    binary scan [binary format w [expr {wide(3) << 31}]] w x
+    set x
+} 6442450944
+test binary-44.4 {Tcl_BinaryObjCmd: scan wide int with bit 31 set} {} {
+    binary scan [binary format W [expr {wide(3) << 31}]] W x
+    set x
+} 6442450944
+test binary-44.5 {Tcl_BinaryObjCmd: scan wide int with bit 31 and 64 set} {} {
+    binary scan [binary format w [expr {(wide(3) << 31) + (wide(3) << 64)}]] w x
+    set x
+} 6442450944
+test binary-44.6 {Tcl_BinaryObjCmd: scan wide int with bit 31 and 64 set} {} {
+    binary scan [binary format W [expr {(wide(3) << 31) + (wide(3) << 64)}]] W x
+    set x
+} 6442450944
+
 test binary-45.1 {Tcl_BinaryObjCmd: combined wide int handling} {
     binary scan [binary format sws 16450 -1 19521] c* x
     set x
diff --git a/tests/chanio.test b/tests/chanio.test
index 97e7e70..300c54a 100644
--- a/tests/chanio.test
+++ b/tests/chanio.test
@@ -13,16 +13,11 @@
 # See the file "license.terms" for information on usage and redistribution of
 # this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
+# TODO: This test is likely worthless. Confirm and remove
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
-    namespace import -force ::tcltest::*
 }
 
-::tcltest::loadTestedCommands
-catch [list package require -exact Tcltest [info patchlevel]]
-
-testConstraint testbytestring [llength [info commands testbytestring]]
-
 namespace eval ::tcl::test::io {
     namespace import ::tcltest::*
 
@@ -35,18 +30,16 @@ namespace eval ::tcl::test::io {
     variable msg
     variable expected
 
-    ::tcltest::loadTestedCommands
+    loadTestedCommands
     catch [list package require -exact Tcltest [info patchlevel]]
+    package require tcltests
 
+    testConstraint testbytestring   [llength [info commands testbytestring]]
     testConstraint testchannel      [llength [info commands testchannel]]
-    testConstraint exec             [llength [info commands exec]]
     testConstraint openpipe         1
-    testConstraint fileevent        [llength [info commands fileevent]]
-    testConstraint fcopy            [llength [info commands fcopy]]
     testConstraint testfevent       [llength [info commands testfevent]]
     testConstraint testchannelevent [llength [info commands testchannelevent]]
     testConstraint testmainthread   [llength [info commands testmainthread]]
-    testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]
 
     # You need a *very* special environment to do some tests.  In particular,
     # many file systems do not support large-files...
@@ -5964,7 +5957,7 @@ test chan-io-48.3 {testing readability conditions} -setup {
     chan close $f
 } -result {done {0 1 0 1 0 1 0 1 0 1 0 1 0 0}}
 unset path(bar)
-removeFile bar 
+removeFile bar
 
 test chan-io-48.4 {lf write, testing readability, ^Z termination, auto read mode} -setup {
     file delete $path(test1)
diff --git a/tests/cmdAH.test b/tests/cmdAH.test
index e334dff..0377064 100644
--- a/tests/cmdAH.test
+++ b/tests/cmdAH.test
@@ -1040,7 +1040,7 @@ test cmdAH-20.7.1 {
     Tcl_FileObjCmd: atime (built-in Windows names with dir path and extension)
 } -constraints {win} -body {
     file atime [file join [temporaryDirectory] CON.txt]
-} -result "could not get access time for file \"[file join [temporaryDirectory] CON.txt]\"" -returnCodes error
+} -match regexp -result {could not (?:get access time|read)} -returnCodes error
 
 if {[testConstraint unix] && [file exists /tmp]} {
     removeFile touch.me /tmp
@@ -1281,7 +1281,7 @@ test cmdAH-24.14.1 {
     Tcl_FileObjCmd: mtime (built-in Windows names with dir path and extension)
 } -constraints {win} -body {
     file mtime [file join [temporaryDirectory] CON.txt]
-} -result "could not get modification time for file \"[file join [temporaryDirectory] CON.txt]\"" -returnCodes error
+} -match regexp -result {could not (?:get modification time|read)} -returnCodes error
 
 # owned
 test cmdAH-25.1 {Tcl_FileObjCmd: owned} -returnCodes error -body {
@@ -1345,7 +1345,12 @@ test cmdAH-27.4 {
 test cmdAH-27.4.1 {
     Tcl_FileObjCmd: size (built-in Windows names with dir path and extension)
 } -constraints {win} -body {
-    file size [file join [temporaryDirectory] con.txt]
+    try {
+	set res [file size [file join [temporaryDirectory] con.txt]]
+    } trap {POSIX ENOENT} {} {
+	set res 0
+    }
+    set res
 } -result 0
 
 catch {testsetplatform $platform}
@@ -1447,8 +1452,13 @@ test cmdAH-28.13 {Tcl_FileObjCmd: stat (built-in Windows names)} -constraints {w
 test cmdAH-28.13.1 {Tcl_FileObjCmd: stat (built-in Windows names)} -constraints {win} -setup {
     unset -nocomplain stat
 } -body {
-    file stat [file join [temporaryDirectory] CON.txt] stat
-    lmap elem {atime ctime dev gid ino mode mtime nlink size type uid} {set stat($elem)}
+    try {
+	file stat [file join [temporaryDirectory] CON.txt] stat
+	set res [lmap elem {atime ctime dev gid ino mode mtime nlink size type uid} {set stat($elem)}]
+    } trap {POSIX ENOENT} {} {
+	set res {0 0 -1 0 0 8630 0 0 0 characterSpecial 0}
+    }
+    set res
 } -result {0 0 -1 0 0 8630 0 0 0 characterSpecial 0}
 unset -nocomplain stat
 
@@ -1498,7 +1508,12 @@ test cmdAH-29.6 {
 test cmdAH-29.6.1 {
     Tcl_FileObjCmd: type (built-in Windows names, with dir path and extension)
 } -constraints {win} -body {
-    file type [file join [temporaryDirectory] CON.txt]
+    try {
+	set res [file type [file join [temporaryDirectory] CON.txt]]
+    } trap {POSIX ENOENT} {} {
+	set res {characterSpecial}
+    }
+    set res
 } -result "characterSpecial"
 
 # Error conditions
diff --git a/tests/compExpr-old.test b/tests/compExpr-old.test
index 0136ccd..798c92a 100644
--- a/tests/compExpr-old.test
+++ b/tests/compExpr-old.test
@@ -78,8 +78,8 @@ proc testIEEE {} {
 }
 testConstraint ieeeFloatingPoint [testIEEE]
 
-testConstraint longIs32bit [expr {int(0x80000000) < 0}]
-testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}]
+testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
+testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}]
 
 # procedures used below
 
diff --git a/tests/config.test b/tests/config.test
index d14837e..468a1df 100644
--- a/tests/config.test
+++ b/tests/config.test
@@ -19,7 +19,7 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
 
 test pkgconfig-1.1 {query keys} {
     lsort [::tcl::pkgconfig list]
-} {64bit bindir,install bindir,runtime compile_debug compile_stats debug docdir,install docdir,runtime includedir,install includedir,runtime libdir,install libdir,runtime mem_debug optimized profiled scriptdir,install scriptdir,runtime threaded}
+} {64bit bindir,install bindir,runtime compile_debug compile_stats debug dllfile,runtime docdir,install docdir,runtime includedir,install includedir,runtime libdir,install libdir,runtime mem_debug optimized profiled scriptdir,install scriptdir,runtime threaded zipfile,runtime}
 test pkgconfig-1.2 {query keys multiple times} {
     string compare [::tcl::pkgconfig list] [::tcl::pkgconfig list]
 } 0
diff --git a/tests/env.test b/tests/env.test
index 0dd4f98..79a353a 100644
--- a/tests/env.test
+++ b/tests/env.test
@@ -16,49 +16,98 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
     namespace import -force ::tcltest::*
 }
 
-# Some tests require the "exec" command.
-# Skip them if exec is not defined.
-testConstraint exec [llength [info commands exec]]
+loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+package require tcltests
+
+# [exec] is required here to see the actual environment received by child
+# processes.
+proc getenv {} {
+    global printenvScript
+    catch {exec [interpreter] $printenvScript} out
+    if {$out eq "child process exited abnormally"} {
+	set out {}
+    }
+    return $out
+}
+
+
+proc envrestore {} {
+    # Restore the environment variables at the end of the test.
+    global env
+    variable env2
+
+    foreach name [array names env] {
+	unset env($name)
+    }
+    array set env $env2
+    return
+}
+
+
+proc envprep {} {
+    # Save the current environment variables at the start of the test.
+    global env
+    variable keep
+    variable env2
+
+    set env2 [array get env]
+    foreach name [array names env] {
+	# Keep some environment variables that support operation of the tcltest
+	# package.
+	if {[string toupper $name] ni [string toupper $keep]} {
+	    unset env($name)
+	}
+    }
+    return
+}
+
+
+proc encodingrestore {} {
+    variable sysenc
+    encoding system $sysenc
+    return
+}
+
+
+proc encodingswitch encoding {
+    variable sysenc
+    # Need to run [getenv] in known encoding, so save the current one here...
+    set sysenc [encoding system]
+    encoding system $encoding
+    return
+}
+
+
+proc setup1 {} {
+    global env
+    envprep
+    encodingswitch iso8859-1
+}
+
+proc setup2 {} {
+    global env
+    setup1
+    set env(NAME1) {test string}
+    set env(NAME2) {new value}
+    set env(XYZZY) {garbage}
+}
+
+
+proc cleanup1 {} {
+    encodingrestore
+    envrestore
+}
 
-#
-# These tests will run on any platform (and indeed crashed on the Mac). So put
-# them before you test for the existance of exec.
-#
-test env-1.1 {propagation of env values to child interpreters} -setup {
-    catch {interp delete child}
-    catch {unset env(test)}
-} -body {
-    interp create child
-    set env(test) garbage
-    child eval {set env(test)}
-} -cleanup {
-    interp delete child
-    unset env(test)
-} -result {garbage}
-#
-# This one crashed on Solaris under Tcl8.0, so we only want to make sure it
-# runs.
-#
-test env-1.2 {lappend to env value} -setup {
-    catch {unset env(test)}
-} -body {
-    set env(test) aaaaaaaaaaaaaaaa
-    append env(test) bbbbbbbbbbbbbb
-    unset env(test)
+variable keep {
+    TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH PURE_PROG_NAME DISPLAY
+    SHLIB_PATH SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH
+    DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING
+    __CF_USER_TEXT_ENCODING SECURITYSESSIONID LANG WINDIR TERM
+    CommonProgramFiles ProgramFiles CommonProgramW6432 ProgramW6432
 }
-test env-1.3 {reflection of env by "array names"} -setup {
-    catch {interp delete child}
-    catch {unset env(test)}
-} -body {
-    interp create child
-    child eval {set env(test) garbage}
-    expr {"test" in [array names env]}
-} -cleanup {
-    interp delete child
-    catch {unset env(test)}
-} -result {1}
 
-set printenvScript [makeFile {
+variable printenvScript [makeFile [string map [list @keep@ [list $keep]] {
     encoding system iso8859-1
     proc lrem {listname name} {
 	upvar $listname list
@@ -70,7 +119,7 @@ set printenvScript [makeFile {
     }
     proc mangle s {
 	regsub -all {\[|\\|\]} $s {\\&} s
-	regsub -all "\[\u0000-\u001f\u007f-\uffff\]" $s {[manglechar &]} s
+	regsub -all "\[\u0000-\u001f\u007f-\uffff\]" $s {[manglechar {&}]} s
 	return [subst -novariables $s]
     }
     proc manglechar c {
@@ -84,161 +133,154 @@ set printenvScript [makeFile {
 	lrem names ComSpec
 	lrem names ""
     }
-    foreach name {
-	TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH PURE_PROG_NAME DISPLAY
-	SHLIB_PATH SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH
-	DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING
-	__CF_USER_TEXT_ENCODING SECURITYSESSIONID LANG WINDIR TERM
-	CommonProgramFiles ProgramFiles CommonProgramW6432 ProgramW6432
-    } {
+    foreach name @keep@ {
 	lrem names $name
     }
     foreach p $names {
-	puts "[mangle $p]=[mangle $env($p)]"
+	puts [mangle $p]=[mangle $env($p)]
     }
     exit
-} printenv]
+}] printenv]
 
-# [exec] is required here to see the actual environment received by child
-# processes.
-proc getenv {} {
-    global printenvScript tcltest
-    catch {exec [interpreter] $printenvScript} out
-    if {$out eq "child process exited abnormally"} {
-	set out {}
-    }
-    return $out
-}
 
-# Save the current environment variables at the start of the test.
-
-set env2 [array get env]
-foreach name [array names env] {
-    # Keep some environment variables that support operation of the tcltest
-    # package.
-    if {[string toupper $name] ni {
-	TCL_LIBRARY PATH LD_LIBRARY_PATH LIBPATH DISPLAY SHLIB_PATH
-	SYSTEMDRIVE SYSTEMROOT DYLD_LIBRARY_PATH DYLD_FRAMEWORK_PATH
-	DYLD_NEW_LOCAL_SHARED_REGIONS DYLD_NO_FIX_PREBINDING
-	SECURITYSESSIONID LANG WINDIR TERM
-	CONNOMPROGRAMFILES PROGRAMFILES COMMONPROGRAMW6432 PROGRAMW6432
-    }} {
-	unset env($name)
-    }
+test env-1.1 {propagation of env values to child interpreters} -setup {
+    catch {interp delete child}
+    catch {unset env(test)}
+} -body {
+    interp create child
+    set env(test) garbage
+    child eval {set env(test)}
+} -cleanup {
+    interp delete child
+    unset env(test)
+} -result {garbage}
+
+
+# This one crashed on Solaris under Tcl8.0, so we only want to make sure it
+# runs.
+test env-1.2 {lappend to env value} -setup {
+    catch {unset env(test)}
+} -body {
+    set env(test) aaaaaaaaaaaaaaaa
+    append env(test) bbbbbbbbbbbbbb
+    unset env(test)
 }
 
-# Need to run 'getenv' in known encoding, so save the current one here...
-set sysenc [encoding system]
 
-test env-2.1 {adding environment variables} -setup {
-    encoding system iso8859-1
-} -constraints {exec} -body {
-    getenv
+test env-1.3 {reflection of env by "array names"} -setup {
+    catch {interp delete child}
+    catch {unset env(test)}
+} -body {
+    interp create child
+    child eval {set env(test) garbage}
+    expr {"test" in [array names env]}
 } -cleanup {
-    encoding system $sysenc
-} -result {}
-test env-2.2 {adding environment variables} -setup {
-    encoding system iso8859-1
-} -constraints {exec} -body {
+    interp delete child
+    catch {unset env(test)}
+} -result 1
+
+
+test env-2.1 {
+    adding environment variables
+} -constraints exec -setup setup1 -body {
+    getenv
+} -cleanup cleanup1 -result {}
+
+
+test env-2.2 {
+    adding environment variables
+} -constraints exec -setup setup1 -body {
     set env(NAME1) "test string"
     getenv
-} -cleanup {
-    encoding system $sysenc
-} -result {NAME1=test string}
-test env-2.3 {adding environment variables} -setup {
-    encoding system iso8859-1
+} -cleanup cleanup1 -result {NAME1=test string}
+
+
+test env-2.3 {adding environment variables} -constraints exec -setup {
+    setup1
     set env(NAME1) "test string"
-} -constraints {exec} -body {
+} -body {
     set env(NAME2) "more"
     getenv
-} -cleanup {
-    encoding system $sysenc
-} -result {NAME1=test string
+} -cleanup cleanup1 -result {NAME1=test string
 NAME2=more}
-test env-2.4 {adding environment variables} -setup {
-    encoding system iso8859-1
+
+
+test env-2.4 {
+    adding environment variables
+} -constraints exec -setup {
+    setup1
     set env(NAME1) "test string"
     set env(NAME2) "more"
-} -constraints {exec} -body {
+} -body {
     set env(XYZZY) "garbage"
     getenv
-} -cleanup {
-    encoding system $sysenc
+} -cleanup { cleanup1
 } -result {NAME1=test string
 NAME2=more
 XYZZY=garbage}
 
-set env(NAME1) "test string"
-set env(NAME2) "new value"
-set env(XYZZY) "garbage"
-test env-3.1 {changing environment variables} -setup {
-    encoding system iso8859-1
-} -constraints {exec} -body {
+
+test env-3.1 {
+    changing environment variables
+} -constraints exec -setup setup2 -body {
     set result [getenv]
     unset env(NAME2)
     set result
 } -cleanup {
-    encoding system $sysenc
+    cleanup1
 } -result {NAME1=test string
 NAME2=new value
 XYZZY=garbage}
-unset -nocomplain env(NAME2)
 
-test env-4.1 {unsetting environment variables: default} -setup {
-    encoding system iso8859-1
-} -constraints {exec} -body {
+
+test env-4.1 {
+    unsetting environment variables
+} -constraints exec -setup setup2 -body {
+    unset -nocomplain env(NAME2)
     getenv
-} -cleanup {
-    encoding system $sysenc
-} -result {NAME1=test string
+} -cleanup cleanup1 -result {NAME1=test string
 XYZZY=garbage}
-test env-4.2 {unsetting environment variables} -setup {
-    encoding system iso8859-1
-} -constraints {exec} -body {
-    unset env(NAME1)
-    getenv
-} -cleanup {
-    unset env(XYZZY)
-    encoding system $sysenc
-} -result {XYZZY=garbage}
-unset -nocomplain env(NAME1) env(XYZZY)
-test env-4.3 {setting international environment variables} -setup {
-    encoding system iso8859-1
-} -constraints {exec} -body {
+
+# env-4.2 is deleted
+
+test env-4.3 {
+    setting international environment variables
+} -constraints exec -setup setup1 -body {
     set env(\ua7) \ub6
     getenv
-} -cleanup {
-    encoding system $sysenc
-} -result {\u00a7=\u00b6}
-test env-4.4 {changing international environment variables} -setup {
-    encoding system iso8859-1
-} -constraints {exec} -body {
+} -cleanup cleanup1 -result {\u00a7=\u00b6}
+
+
+test env-4.4 {
+    changing international environment variables
+} -constraints exec -setup setup1 -body {
     set env(\ua7) \ua7
     getenv
-} -cleanup {
-    encoding system $sysenc
-} -result {\u00a7=\u00a7}
-test env-4.5 {unsetting international environment variables} -setup {
-    encoding system iso8859-1
+} -cleanup cleanup1 -result {\u00a7=\u00a7}
+
+
+test env-4.5 {
+    unsetting international environment variables
+} -constraints exec -setup {
+    setup1
     set env(\ua7) \ua7
 } -body {
     set env(\ub6) \ua7
     unset env(\ua7)
     getenv
-} -constraints {exec} -cleanup {
-    unset env(\ub6)
-    encoding system $sysenc
-} -result {\u00b6=\u00a7}
+} -cleanup cleanup1 -result {\u00b6=\u00a7}
 
-test env-5.0 {corner cases - set a value, it should exist} -body {
+test env-5.0 {
+    corner cases - set a value, it should exist
+} -setup setup1 -body {
     set env(temp) a
     set env(temp)
-} -cleanup {
-    unset env(temp)
-} -result {a}
-test env-5.1 {corner cases - remove one elem at a time} -setup {
-    set x [array get env]
-} -body {
+} -cleanup cleanup1 -result a
+
+
+test env-5.1 {
+    corner cases - remove one elem at a time
+} -setup setup1 -body {
     # When no environment variables exist, the env var will contain no
     # entries. The "array names" call synchs up the C-level environ array with
     # the Tcl level env array. Make sure an empty Tcl array is created.
@@ -246,9 +288,9 @@ test env-5.1 {corner cases - remove one elem at a time} -setup {
 	unset env($e)
     }
     array size env
-} -cleanup {
-    array set env $x
-} -result {0}
+} -cleanup cleanup1 -result 0
+
+
 test env-5.2 {corner cases - unset the env array} -setup {
     interp create i
 } -body {
@@ -262,42 +304,54 @@ test env-5.2 {corner cases - unset the env array} -setup {
 } -cleanup {
     interp delete i
 } -result {0}
+
+
 test env-5.3 {corner cases: unset the env in master should unset child} -setup {
+    setup1
     interp create i
 } -body {
     # Variables deleted in a master interp should be deleted in child interp
     # too.
-    i eval { set env(THIS_SHOULD_EXIST) a}
+    i eval {set env(THIS_SHOULD_EXIST) a}
     set result [set env(THIS_SHOULD_EXIST)]
     unset env(THIS_SHOULD_EXIST)
     lappend result [i eval {catch {set env(THIS_SHOULD_EXIST)}}]
 } -cleanup {
+    cleanup1
     interp delete i
 } -result {a 1}
+
+
 test env-5.4 {corner cases - unset the env array} -setup {
+    setup1
     interp create i
 } -body {
     # The info exists command should be in synch with the env array.
     # Know Bug: 1737
-    i eval { set env(THIS_SHOULD_EXIST) a}
+    i eval {set env(THIS_SHOULD_EXIST) a}
     set     result [info exists env(THIS_SHOULD_EXIST)]
     lappend result [set env(THIS_SHOULD_EXIST)]
     lappend result [info exists env(THIS_SHOULD_EXIST)]
 } -cleanup {
+    cleanup1
     interp delete i
 } -result {1 a 1}
-test env-5.5 {corner cases - cannot have null entries on Windows} -constraints win -body {
+
+
+test env-5.5 {
+    corner cases - cannot have null entries on Windows
+} -constraints win -body {
     set env() a
     catch {set env()}
-} -result 1
+} -cleanup cleanup1 -result 1
 
-test env-6.1 {corner cases - add lots of env variables} -body {
+test env-6.1 {corner cases - add lots of env variables} -setup setup1 -body {
     set size [array size env]
     for {set i 0} {$i < 100} {incr i} {
 	set env(BOGUS$i) $i
     }
     expr {[array size env] - $size}
-} -result 100
+} -cleanup cleanup1 -result 100
 
 test env-7.1 {[219226]: whole env array should not be unset by read} -body {
     set n [array size env]
@@ -310,16 +364,20 @@ test env-7.1 {[219226]: whole env array should not be unset by read} -body {
     return $n
 } -result 0
 
-test env-7.2 {[219226]: links to env elements should not be removed by read} -body {
+test env-7.2 {
+    [219226]: links to env elements should not be removed by read
+} -setup setup1 -body {
     apply {{} {
 	set ::env(test7_2) ok
 	upvar env(test7_2) elem
 	set ::env(PATH)
 	return $elem
     }}
-} -result ok
+} -cleanup cleanup1 -result ok
 
-test env-7.3 {[9b4702]: testing existence of env(some_thing) should not destroy trace} -body {
+test env-7.3 {
+    [9b4702]: testing existence of env(some_thing) should not destroy trace
+} -setup setup1 -body {
     apply {{} {
       catch {unset ::env(test7_3)}
       proc foo args {
@@ -330,16 +388,25 @@ test env-7.3 {[9b4702]: testing existence of env(some_thing) should not destroy
       set ::env(not_yet_existent) "Now I'm here";
       return [info exists ::env(test7_3)]
     }}
-} -result 1
+} -cleanup cleanup1 -result 1
 
-# Restore the environment variables at the end of the test.
+test env-8.0 {
+    memory usage - valgrind does not report reachable memory
+} -body {
+    set res [set env(__DUMMY__) {i'm with dummy}]
+    unset env(__DUMMY__)
+    return $res
+} -result {i'm with dummy}
+
 
-foreach name [array names env] {
-    unset env($name)
-}
-array set env $env2
 
 # cleanup
+rename getenv {}
+rename envrestore {}
+rename envprep {}
+rename encodingrestore {}
+rename encodingswitch {}
+
 removeFile $printenvScript
 ::tcltest::cleanupTests
 return
diff --git a/tests/exec.test b/tests/exec.test
index 3d1cd56..4fd8b8d 100644
--- a/tests/exec.test
+++ b/tests/exec.test
@@ -11,9 +11,16 @@
 # See the file "license.terms" for information on usage and redistribution of
 # this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
+# There is no point in running Valgrind on cases where [exec] forks but then
+# fails and the child process doesn't go through full cleanup.
+
 package require tcltest 2
 namespace import -force ::tcltest::*
 
+loadTestedCommands
+catch [list package require -exact Tcltest [info patchlevel]]
+package require tcltests
+
 # All tests require the "exec" command.
 # Skip them if exec is not defined.
 testConstraint exec [llength [info commands exec]]
@@ -325,11 +332,11 @@ test exec-8.2 {long input and output} {exec} {
 
 # Commands that return errors.
 
-test exec-9.1 {commands returning errors} {exec} {
+test exec-9.1 {commands returning errors} {exec notValgrind} {
     set x [catch {exec gorp456} msg]
     list $x [string tolower $msg] [string tolower $errorCode]
 } {1 {couldn't execute "gorp456": no such file or directory} {posix enoent {no such file or directory}}}
-test exec-9.2 {commands returning errors} {exec} {
+test exec-9.2 {commands returning errors} {exec notValgrind} {
     string tolower [list [catch {exec [interpreter] echo foo | foo123} msg] $msg $errorCode]
 } {1 {couldn't execute "foo123": no such file or directory} {posix enoent {no such file or directory}}}
 test exec-9.3 {commands returning errors} -constraints {exec stdio} -body {
@@ -339,7 +346,7 @@ test exec-9.4 {commands returning errors} -constraints {exec stdio} -body {
     exec [interpreter] $path(exit) 43 | [interpreter] $path(echo) "foo bar"
 } -returnCodes error -result {foo bar
 child process exited abnormally}
-test exec-9.5 {commands returning errors} -constraints {exec stdio} -body {
+test exec-9.5 {commands returning errors} -constraints {exec stdio notValgrind} -body {
     exec gorp456 | [interpreter] echo a b c
 } -returnCodes error -result {couldn't execute "gorp456": no such file or directory}
 test exec-9.6 {commands returning errors} -constraints {exec} -body {
@@ -428,13 +435,13 @@ test exec-10.19 {errors in exec invocation} -constraints {exec} -body {
     exec cat >@ $f
 } -returnCodes error -result "channel \"$f\" wasn't opened for writing"
 close $f
-test exec-10.20 {errors in exec invocation} -constraints {exec} -body {
+test exec-10.20 {errors in exec invocation} -constraints {exec notValgrind} -body {
     exec ~non_existent_user/foo/bar
 } -returnCodes error -result {user "non_existent_user" doesn't exist}
-test exec-10.21 {errors in exec invocation} -constraints {exec} -body {
+test exec-10.21 {errors in exec invocation} -constraints {exec notValgrind} -body {
     exec [interpreter] true | ~xyzzy_bad_user/x | false
 } -returnCodes error -result {user "xyzzy_bad_user" doesn't exist}
-test exec-10.22 {errors in exec invocation} -constraints exec -body {
+test exec-10.22 {errors in exec invocation} -constraints {exec notValgrind} -body {
     exec echo test > ~non_existent_user/foo/bar
 } -returnCodes error -result {user "non_existent_user" doesn't exist}
 # Commands in background.
@@ -510,7 +517,7 @@ test exec-13.1 {setting errorCode variable} {exec} {
 test exec-13.2 {setting errorCode variable} {exec} {
     list [catch {exec [interpreter] $path(cat) > a/b/c} msg] [string tolower $errorCode]
 } {1 {posix enoent {no such file or directory}}}
-test exec-13.3 {setting errorCode variable} {exec} {
+test exec-13.3 {setting errorCode variable} {exec notValgrind} {
     set x [catch {exec _weird_cmd_} msg]
     list $x [string tolower $msg] [lindex $errorCode 0] \
 	    [string tolower [lrange $errorCode 2 end]]
@@ -548,7 +555,7 @@ test exec-14.2 {-keepnewline switch} -constraints {exec} -body {
 test exec-14.3 {unknown switch} -constraints {exec} -body {
     exec -gorp
 } -returnCodes error -result {bad option "-gorp": must be -ignorestderr, -keepnewline, or --}
-test exec-14.4 {-- switch} -constraints {exec} -body {
+test exec-14.4 {-- switch} -constraints {exec notValgrind} -body {
     exec -- -gorp
 } -returnCodes error -result {couldn't execute "-gorp": no such file or directory}
 test exec-14.5 {-ignorestderr switch} {exec} {
@@ -662,7 +669,7 @@ test exec-18.2 {exec cat deals with weird file names} -body {
 # Note that this test cannot be adapted to work on Windows; that platform has
 # no kernel support for an analog of O_APPEND. OTOH, that means we can assume
 # that there is a POSIX shell...
-test exec-19.1 {exec >> uses O_APPEND} -constraints {exec unix} -setup {
+test exec-19.1 {exec >> uses O_APPEND} -constraints {exec unix notValgrind} -setup {
     set tmpfile [makeFile {0} tmpfile.exec-19.1]
 } -body {
     # Note that we have to allow for the current contents of the temporary
@@ -675,7 +682,7 @@ test exec-19.1 {exec >> uses O_APPEND} -constraints {exec unix} -setup {
 	    {for a in a b c; do sleep 1; echo $a; done} >>$tmpfile &
     exec /bin/sh -c \
 	    {for a in d e f; do sleep 1; echo $a >&2; done} 2>>$tmpfile &
-    # The above four shell invokations take about 3 seconds to finish, so allow
+    # The above four shell invocations take about 3 seconds to finish, so allow
     # 5s (in case the machine is busy)
     after 5000
     # Check that no bytes have got lost through mixups with overlapping
diff --git a/tests/execute.test b/tests/execute.test
index 6c277f8..2c54a71 100644
--- a/tests/execute.test
+++ b/tests/execute.test
@@ -34,7 +34,7 @@ testConstraint testobj [expr {
     && [llength [info commands teststringobj]]
 }]
 
-testConstraint longIs32bit [expr {int(0x80000000) < 0}]
+testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
 testConstraint testexprlongobj [llength [info commands testexprlongobj]]
 
 # Tests for the omnibus TclExecuteByteCode function:
diff --git a/tests/expr-old.test b/tests/expr-old.test
index a73b77a..3192c74 100644
--- a/tests/expr-old.test
+++ b/tests/expr-old.test
@@ -22,7 +22,8 @@ catch [list package require -exact Tcltest [info patchlevel]]
 testConstraint testexprlong   [llength [info commands testexprlong]]
 testConstraint testexprdouble [llength [info commands testexprdouble]]
 testConstraint testexprstring [llength [info commands testexprstring]]
-testConstraint longIs32bit    [expr {int(0x80000000) < 0}]
+testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
+testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}]
 
 # Big test for correct ordering of data in [expr]
 
diff --git a/tests/expr.test b/tests/expr.test
index de6eb4a..0762cf2 100644
--- a/tests/expr.test
+++ b/tests/expr.test
@@ -21,10 +21,9 @@ catch [list package require -exact Tcltest [info patchlevel]]
 # Determine if "long int" type is a 32 bit number and if the wide
 # type is a 64 bit number on this machine.
 
-testConstraint longIs32bit [expr {int(0x80000000) < 0}]
-testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}]
-testConstraint wideIs64bit \
-	[expr {(wide(0x80000000) > 0) && (wide(0x8000000000000000) < 0)}]
+testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
+testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}]
+testConstraint wideIs64bit [expr {wide(0x8000000000000000) < 0}]
 
 # Big test for correct ordering of data in [expr]
 
@@ -7157,6 +7156,15 @@ test expr-51.1 {test round-to-even on input} {
     expr 6.9294956446009195e15
 } 6929495644600920.0
 
+test expr-52.1 {
+	comparison with empty string does not generate string representation
+} {
+	set a [list one two three]
+	list [expr {$a eq {}}] [expr {$a < {}}] [expr {$a > {}}] [
+		string match {*no string representation*} [
+		::tcl::unsupported::representation $a]]
+} {0 0 1 1}
+
 
 
 # cleanup
diff --git a/tests/format.test b/tests/format.test
index ed8676a..1bf46a1 100644
--- a/tests/format.test
+++ b/tests/format.test
@@ -16,11 +16,9 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
 }
 
 # %u output depends on word length, so this test is not portable.
-testConstraint longIs32bit [expr {int(0x80000000) < 0}]
-testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}]
-testConstraint wideIs64bit \
-	[expr {(wide(0x80000000) > 0) && (wide(0x8000000000000000) < 0)}]
-testConstraint wideBiggerThanInt [expr {wide(0x80000000) != int(0x80000000)}]
+testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
+testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}]
+testConstraint wideIs64bit [expr {wide(0x8000000000000000) < 0}]
 testConstraint pointerIs64bit [expr {$tcl_platform(pointerSize) >= 8}]
 
 test format-1.1 {integer formatting} {
@@ -547,7 +545,7 @@ for {set i 290} {$i < 400} {incr i} {
     append b "x"
 }
 
-test format-17.1 {testing %d with wide} {wideIs64bit wideBiggerThanInt} {
+test format-17.1 {testing %d with wide} {longIs32bit wideIs64bit} {
     format %d 7810179016327718216
 } 1819043144
 test format-17.2 {testing %ld with wide} {wideIs64bit} {
@@ -580,7 +578,7 @@ test format-18.1 {do not demote existing numeric values} {
     format %08x $b
     lappend result [expr {$a == $b}]
 } {1 1 1 1}
-test format-18.2 {do not demote existing numeric values} {wideBiggerThanInt} {
+test format-18.2 {do not demote existing numeric values} {longIs32bit wideIs64bit} {
     set a [expr {0xaaaaaaaaaa + 1}]
     set b 0xaaaaaaaaab
     list [format %08x $a] [expr {$a == $b}]
@@ -597,6 +595,20 @@ test format-19.3 {Bug 2830354} {
     string length [format %340f 0]
 } 340
 
+test format-19.4.1 {Bug d498578df4: width overflow should cause limit exceeded} \
+-constraints {longIs32bit} -body {
+    # in case of overflow into negative, it produces width -2 (and limit exceeded),
+    # in case of width will be unsigned, it will be outside limit (2GB for 32bit)...
+    # and it don't throw an error in case the bug is not fixed (and probably no segfault).
+    format %[expr {0xffffffff - 1}]g 0
+} -returnCodes error -result "max size for a Tcl value exceeded"
+
+test format-19.4.2 {Bug d498578df4: width overflow should cause limit exceeded} -body {
+    # limit should exceeds in any case,
+    # and it don't throw an error in case the bug is not fixed (and probably no segfault).
+    format %[expr {0xffffffffffffffff - 1}]g 0
+} -returnCodes error -result "max size for a Tcl value exceeded"
+
 # Note that this test may fail in future versions
 test format-20.1 {Bug 2932421: plain %s caused intrep change of args} -body {
     set x [dict create a b c d]
diff --git a/tests/get.test b/tests/get.test
index d6a7206..c381098 100644
--- a/tests/get.test
+++ b/tests/get.test
@@ -20,8 +20,8 @@ catch [list package require -exact Tcltest [info patchlevel]]
 
 testConstraint testgetint [llength [info commands testgetint]]
 testConstraint testdoubleobj [llength [info commands testdoubleobj]]
-testConstraint longIs32bit [expr {int(0x80000000) < 0}]
-testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}]
+testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
+testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}]
 
 test get-1.1 {Tcl_GetInt procedure} testgetint {
     testgetint 44 { 	  22}
diff --git a/tests/http.test b/tests/http.test
index e165804..b6a7251 100644
--- a/tests/http.test
+++ b/tests/http.test
@@ -82,7 +82,7 @@ if {[catch {package present Thread}] == 0 && [file exists $httpdFile]} {
 test http-1.1 {http::config} {
     http::config -useragent UserAgent
     http::config
-} [list -accept */* -proxyfilter http::ProxyRequired -proxyhost {} -proxyport {} -urlencoding utf-8 -useragent "UserAgent"]
+} [list -accept */* -pipeline 1 -postfresh 0 -proxyfilter http::ProxyRequired -proxyhost {} -proxyport {} -repost 0 -urlencoding utf-8 -useragent UserAgent -zip 1]
 test http-1.2 {http::config} {
     http::config -proxyfilter
 } http::ProxyRequired
@@ -97,10 +97,10 @@ test http-1.4 {http::config} {
     set x [http::config]
     http::config {*}$savedconf
     set x
-} {-accept */* -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -urlencoding iso8859-1 -useragent {Tcl Test Suite}}
+} {-accept */* -pipeline 1 -postfresh 0 -proxyfilter myFilter -proxyhost nowhere.come -proxyport 8080 -repost 0 -urlencoding iso8859-1 -useragent {Tcl Test Suite} -zip 1}
 test http-1.5 {http::config} -returnCodes error -body {
     http::config -proxyhost {} -junk 8080
-} -result {Unknown option -junk, must be: -accept, -proxyfilter, -proxyhost, -proxyport, -urlencoding, -useragent}
+} -result {Unknown option -junk, must be: -accept, -pipeline, -postfresh, -proxyfilter, -proxyhost, -proxyport, -repost, -urlencoding, -useragent, -zip}
 test http-1.6 {http::config} -setup {
     set oldenc [http::config -urlencoding]
 } -body {
diff --git a/tests/http11.test b/tests/http11.test
index c9ded0b..1e30802 100644
--- a/tests/http11.test
+++ b/tests/http11.test
@@ -515,10 +515,7 @@ proc handler {var sock token} {
     set chunk [read $sock]
     append data $chunk
     #::http::Log "handler read [string length $chunk] ([chan configure $sock -buffersize])"
-    if {[eof $sock]} {
-        #::http::Log "handler eof $sock"
-	chan event $sock readable {}
-    }
+    return [string length $chunk]
 }
 
 test http11-3.0 "-handler,close,identity" -setup {
@@ -666,6 +663,13 @@ test http11-4.3 "normal post request, check channel query length" -setup {
 
 # -------------------------------------------------------------------------
 
+# Eliminate valgrind "still reachable" reports on outstanding "Detached"
+# structures in the detached list which stem from PipeClose2Proc not waiting
+# around for background processes to complete, meaning that previous calls to
+# Tcl_ReapDetachedProcs might not have had a chance to reap all processes.
+after 10
+exec [info nameofexecutable] << {}
+
 foreach p {create_httpd httpd_read halt_httpd meta check_crc} {
     if {[llength [info proc $p]]} {rename $p {}}
 }
diff --git a/tests/httpPipeline.test b/tests/httpPipeline.test
new file mode 100644
index 0000000..8de79b9
--- /dev/null
+++ b/tests/httpPipeline.test
@@ -0,0 +1,866 @@
+# httpPipeline.test
+#
+#	Test HTTP/1.1 concurrent requests including
+#	queueing, pipelining and retries.
+#
+# Copyright (C) 2018 Keith Nash <kjnash@users.sourceforge.net>
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+package require tcltest 2
+namespace import -force ::tcltest::*
+
+package require http 2.8
+
+set sourcedir [file normalize [file dirname [info script]]]
+source [file join $sourcedir httpTest.tcl]
+source [file join $sourcedir httpTestScript.tcl]
+
+# ------------------------------------------------------------------------------
+# (1) Define the test scripts that will be used to generate logs for analysis -
+#     and also define the "correct" results.
+# ------------------------------------------------------------------------------
+
+proc ReturnTestScriptAndResult {ca cb delay te} {
+
+    switch -- $ca {
+	1     {set start {
+	    START
+	    KEEPALIVE 0
+	    PIPELINE  0
+	}}
+
+	2     {set start {
+	    START
+	    KEEPALIVE 0
+	    PIPELINE  1
+	}}
+
+	3     {set start {
+	    START
+	    KEEPALIVE 1
+	    PIPELINE  0
+	}}
+
+	4     {set start {
+	    START
+	    KEEPALIVE 1
+	    PIPELINE  1
+	}}
+
+	default {
+	    return -code error {no matching script}
+	}
+    }
+
+    set middle "
+	    [list DELAY $delay]
+    "
+
+    switch -- $cb {
+	1     {set end {
+	    GET a
+	    GET b
+	    GET c
+	    GET a
+	    STOP
+	    }
+	    set resShort {1 ? ? ?}
+	    set resLong  {1 2 3 4}
+	}
+
+	2     {set end {
+	    GET a
+	    HEAD b
+	    GET c
+	    HEAD a
+	    HEAD c
+	    STOP
+	    }
+	    set resShort {1 ? ? ? ?}
+	    set resLong  {1 2 3 4 5}
+	}
+
+	3     {set end {
+	    HEAD a
+	    GET b
+	    HEAD c
+	    HEAD b
+	    GET a
+	    GET b
+	    STOP
+	    }
+	    set resShort {1 ? ? ? ? ?}
+	    set resLong  {1 2 3 4 5 6}
+	}
+
+	4     {set end {
+	    GET a
+	    GET b
+	    GET c
+	    GET a
+	    POST b address=home code=brief paid=yes
+	    GET c
+	    GET a
+	    GET b
+	    GET c
+	    STOP
+	    }
+	    set resShort {1 ? ? ? 5 ? ? ? ?}
+	    set resLong  {1 2 3 4 5 6 7 8 9}
+	}
+
+	5     {set end {
+	    POST a address=home code=brief paid=yes
+	    POST b address=home code=brief paid=yes
+	    POST c address=home code=brief paid=yes
+	    POST a address=home code=brief paid=yes
+	    POST b address=home code=brief paid=yes
+	    POST c address=home code=brief paid=yes
+	    POST a address=home code=brief paid=yes
+	    POST b address=home code=brief paid=yes
+	    POST c address=home code=brief paid=yes
+	    STOP
+	    }
+	    set resShort {1 2 3 4 5 6 7 8 9}
+	    set resLong  {1 2 3 4 5 6 7 8 9}
+	}
+
+	6     {set end {
+	    POST a address=home code=brief paid=yes
+	    GET b address=home code=brief paid=yes
+	    POST c address=home code=brief paid=yes
+	    GET a address=home code=brief paid=yes
+	    GET b address=home code=brief paid=yes
+	    POST c address=home code=brief paid=yes
+	    POST a address=home code=brief paid=yes
+	    HEAD b address=home code=brief paid=yes
+	    GET c address=home code=brief paid=yes
+	    STOP
+	    }
+	    set resShort {1 ? 3 ? ? 6 7 ? ?}
+	    set resLong  {1 2 3 4 5 6 7 8 9}
+	}
+
+	7     {set end {
+	    GET b address=home code=brief paid=yes
+	    POST a address=home code=brief paid=yes
+	    GET a address=home code=brief paid=yes
+	    POST c address=home code=brief paid=yes
+	    GET b address=home code=brief paid=yes
+	    HEAD b address=home code=brief paid=yes
+	    POST c address=home code=brief paid=yes
+	    POST a address=home code=brief paid=yes
+	    GET c address=home code=brief paid=yes
+	    STOP
+	    }
+	    set resShort {1 2 ? 4 ? ? 7 8 ?}
+	    set resLong  {1 2 3 4 5 6 7 8 9}
+	}
+
+	8     {set end {
+	    # Telling the server to close the connection.
+	    GET a
+	    GET b close=y
+	    GET c
+	    GET a
+	    GET b
+	    GET c
+	    GET a
+	    GET b
+	    GET c
+	    STOP
+	    }
+	    set resShort {1 ? 3 ? ? ? ? ? ?}
+	    set resLong  {1 2 3 4 5 6 7 8 9}
+	}
+
+	9     {set end {
+	    # Telling the server to close the connection.
+	    GET a
+	    POST b close=y address=home code=brief paid=yes
+	    GET c
+	    GET a
+	    GET b
+	    GET c
+	    GET a
+	    GET b
+	    GET c
+	    STOP
+	    }
+	    set resShort {1 2 3 ? ? ? ? ? ?}
+	    set resLong  {1 2 3 4 5 6 7 8 9}
+	}
+
+	10     {set end {
+	    # Telling the server to close the connection.
+	    GET a
+	    GET b close=y
+	    POST c address=home code=brief paid=yes
+	    GET a
+	    GET b
+	    GET c
+	    GET a
+	    GET b
+	    GET c
+	    STOP
+	    }
+	    set resShort {1 ? 3 ? ? ? ? ? ?}
+	    set resLong  {1 2 3 4 5 6 7 8 9}
+	}
+
+	11    {set end {
+	    # Telling the server to close the connection twice.
+	    GET a
+	    GET b close=y
+	    GET c
+	    GET a
+	    GET b close=y
+	    GET c
+	    GET a
+	    GET b
+	    GET c
+	    STOP
+	    }
+	    set resShort {1 ? 3 ? ? 6 ? ? ?}
+	    set resLong  {1 2 3 4 5 6 7 8 9}
+	}
+
+	12    {set end {
+	    # Telling the server to delay before sending the response.
+	    GET a
+	    GET b delay=1
+	    GET c
+	    GET a
+	    GET b
+	    STOP
+	    }
+	    set resShort {1 ? ? ? ?}
+	    set resLong  {1 2 3 4 5}
+	}
+
+	13    {set end {
+	    # Making the server close the connection (time out).
+	    GET a
+	    WAIT 2000
+	    GET b
+	    GET c
+	    GET a
+	    GET b
+	    STOP
+	    }
+	    set resShort {1 2 ? ? ?}
+	    set resLong  {1 2 3 4 5}
+	}
+
+	14    {set end {
+	    # Making the server close the connection (time out) twice.
+	    GET a
+	    WAIT 2000
+	    GET b
+	    GET c
+	    GET a
+	    WAIT 2000
+	    GET b
+	    GET c
+	    GET a
+	    GET b
+	    GET c
+	    STOP
+	    }
+	    set resShort {1 2 ? ? 5 ? ? ? ?}
+	    set resLong  {1 2 3 4 5 6 7 8 9}
+	}
+
+	15    {set end {
+	    POST a address=home code=brief paid=yes
+	    POST b address=home code=brief paid=yes close=y delay=1
+	    POST c address=home code=brief paid=yes delay=1
+	    POST a address=home code=brief paid=yes close=y
+	    WAIT 2000
+	    POST b address=home code=brief paid=yes delay=1
+	    POST c address=home code=brief paid=yes close=y
+	    POST a address=home code=brief paid=yes
+	    POST b address=home code=brief paid=yes close=y
+	    POST c address=home code=brief paid=yes
+	    STOP
+	    }
+	    set resShort {1 2 3 4 5 6 7 8 9}
+	    set resLong  {1 2 3 4 5 6 7 8 9}
+	}
+
+	16    {set end {
+	    POST a address=home code=brief paid=yes
+	    GET b address=home code=brief paid=yes
+	    POST c address=home code=brief paid=yes close=y
+	    GET a address=home code=brief paid=yes
+	    GET b address=home code=brief paid=yes close=y
+	    POST c address=home code=brief paid=yes
+	    WAIT 2000
+	    POST a address=home code=brief paid=yes
+	    HEAD b address=home code=brief paid=yes close=y
+	    GET c address=home code=brief paid=yes
+	    STOP
+	    }
+	    set resShort {1 ? 3 4 ? 6 7 ? 9}
+	    set resLong  {1 2 3 4 5 6 7 8 9}
+	}
+
+	17    {set end {
+	    GET b address=home code=brief paid=yes
+	    POST a address=home code=brief paid=yes
+	    GET a address=home code=brief paid=yes
+	    POST c address=home code=brief paid=yes close=y
+	    GET b address=home code=brief paid=yes
+	    HEAD b address=home code=brief paid=yes close=y
+	    POST c address=home code=brief paid=yes
+	    WAIT 2000
+	    POST a address=home code=brief paid=yes
+	    WAIT 2000
+	    GET c address=home code=brief paid=yes
+	    STOP
+	    }
+	    set resShort {1 2 3 4 5 ? 7 8 9}
+	    set resLong  {1 2 3 4 5 6 7 8 9}
+	}
+
+
+	18    {set end {
+	    REPOST 0
+	    GET a
+	    WAIT 2000
+	    POST b address=home code=brief paid=yes
+	    GET c
+	    GET a
+	    STOP
+	    }
+	    set resShort {1 2 ? ?}
+	    set resLong  {1 2 3 4}
+	    # resShort is overwritten below for the case ($te == 1).
+	}
+
+
+	19    {set end {
+	    REPOST 0
+	    GET a
+	    WAIT 2000
+	    GET b address=home code=brief paid=yes
+	    GET c
+	    GET a
+	    STOP
+	    }
+	    set resShort {1 2 ? ?}
+	    set resLong  {1 2 3 4}
+	}
+
+
+	20    {set end {
+	    POSTFRESH 1
+	    GET a
+	    WAIT 2000
+	    POST b address=home code=brief paid=yes
+	    GET c
+	    GET a
+	    STOP
+	    }
+	    set resShort {1 3 ?}
+	    set resLong  {1 3 4}
+	}
+
+
+	21    {set end {
+	    POSTFRESH 1
+	    GET a
+	    WAIT 2000
+	    GET b address=home code=brief paid=yes
+	    GET c
+	    GET a
+	    STOP
+	    }
+	    set resShort {1 2 ? ?}
+	    set resLong  {1 2 3 4}
+	}
+
+	22    {set end {
+	    GET a
+	    WAIT 2000
+	    KEEPALIVE 0
+	    POST b address=home code=brief paid=yes
+	    KEEPALIVE 1
+	    GET c
+	    GET a
+	    STOP
+	    }
+	    set resShort {1 3 ?}
+	    set resLong  {1 3 4}
+	}
+
+
+	23    {set end {
+	    GET a
+	    WAIT 2000
+	    KEEPALIVE 0
+	    GET b address=home code=brief paid=yes
+	    KEEPALIVE 1
+	    GET c
+	    GET a
+	    STOP
+	    }
+	    set resShort {1 3 ?}
+	    set resLong  {1 3 4}
+	}
+
+	24    {set end {
+	    GET a
+	    KEEPALIVE 0
+	    POST b address=home code=brief paid=yes
+	    KEEPALIVE 1
+	    GET c
+	    GET a
+	    STOP
+	    }
+	    set resShort {1 ? ?}
+	    set resLong  {1 3 4}
+	}
+
+
+	25    {set end {
+	    GET a
+	    KEEPALIVE 0
+	    GET b address=home code=brief paid=yes
+	    KEEPALIVE 1
+	    GET c
+	    GET a
+	    STOP
+	    }
+	    set resShort {1 ? ?}
+	    set resLong  {1 3 4}
+	}
+
+	default {
+	    return -code error {no matching script}
+	}
+    }
+
+
+    if {$ca < 3} {
+	# Not Keep-Alive.
+        set result "Passed all sanity checks."
+
+    } elseif {$ca == 3} {
+        # Keep-Alive, not pipelined.
+        set result {}
+        append result "Passed all sanity checks.\n"
+        append result "Have overlaps including response body:\n"
+
+    } else {
+        # Keep-Alive, pipelined: ($ca == 4)
+        set result {}
+        append result "Passed all sanity checks.\n"
+        append result "Overlap-free without response body:\n"
+        append result "$resShort"
+    }
+
+    # - The special case of test *.18*-testEof needs test results to be
+    #   individually written.
+    # - These test -repost 0 when there is a POST to apply it to, and the server
+    #   timeout has not been detected.
+    if {($cb == 18) && ($te == 1)} {
+        if {$ca < 3} {
+	    # Not Keep-Alive.
+	    set result "Passed all sanity checks."
+
+	} elseif {$ca == 3 && $delay == 0} {
+	    # Keep-Alive, not pipelined.
+            set result [MakeMessage {
+		|Problems with sanity checks:
+		|Wrong sequence for token ::http::2 - {A B C D X X X}
+		|- and error(s) X
+		|Wrong sequence for token ::http::3 - {A X X}
+		|- and error(s) X
+		|Wrong sequence for token ::http::4 - {A X X X}
+		|- and error(s) X
+		|
+		|Have overlaps including response body:
+		|
+	    }]
+
+	} elseif {$ca == 3} {
+	    # Keep-Alive, not pipelined.
+            set result [MakeMessage {
+		|Problems with sanity checks:
+		|Wrong sequence for token ::http::2 - {A B C D X X X}
+		|- and error(s) X
+		|
+		|Have overlaps including response body:
+		|
+	    }]
+
+	} elseif {$delay == 0} {
+	    # Keep-Alive, pipelined: ($ca == 4)
+            set result [MakeMessage {
+		|Problems with sanity checks:
+		|Wrong sequence for token ::http::2 - {A B C D X X X}
+		|- and error(s) X
+		|Wrong sequence for token ::http::3 - {A X X}
+		|- and error(s) X
+		|Wrong sequence for token ::http::4 - {A X X X}
+		|- and error(s) X
+		|
+		|Overlap-free without response body:
+		|
+	    }]
+
+	} else {
+            set result [MakeMessage {
+		|Problems with sanity checks:
+		|Wrong sequence for token ::http::2 - {A B C D X X X}
+		|- and error(s) X
+		|
+		|Overlap-free without response body:
+		|
+	    }]
+
+        }
+    }
+
+    return [list "$start$middle$end" $result]
+}
+
+# ------------------------------------------------------------------------------
+#  Proc MakeMessage
+# ------------------------------------------------------------------------------
+# WHD's one-line command to generate multi-line strings from readable code.
+#
+# Example:
+#   set blurb [MakeMessage {
+#            |This command allows multi-line strings to be created with readable
+#            |code, and without breaking the rules for indentation.
+#            |
+#            |The command shifts the entire block of text to the left, omitting
+#            |the pipe character and the spaces to its left.
+#   }]
+# ------------------------------------------------------------------------------
+
+proc MakeMessage {in} {
+    regsub -all -line {^\s*\|} [string trim $in] {}
+    # N.B. Implicit Return.
+}
+
+
+proc ReturnTestScript {ca cb delay te} {
+    lassign [ReturnTestScriptAndResult $ca $cb $delay $te] script result
+    return $script
+}
+
+proc ReturnTestResult {ca cb delay te} {
+    lassign [ReturnTestScriptAndResult $ca $cb $delay $te] script result
+    return $result
+}
+
+
+# ------------------------------------------------------------------------------
+# (2) Command to run a test script and use httpTest to analyse the logs.
+# ------------------------------------------------------------------------------
+
+namespace import httpTestScript::runHttpTestScript
+namespace import httpTestScript::cleanupHttpTestScript
+namespace import httpTest::cleanupHttpTest
+namespace import httpTest::logAnalyse
+namespace import httpTest::setHttpTestOptions
+
+proc RunTest {header footer delay te} {
+    set num [runHttpTestScript [ReturnTestScript $header $footer $delay $te]]
+    set skipOverlaps 0
+    set notPiped    {}
+    set notIncluded {}
+
+    # --------------------------------------------------------------------------
+    # Custom code for specific tests
+    # --------------------------------------------------------------------------
+    if {$header < 3} {
+        set skipOverlaps 1
+        for {set i 1} {$i <= $num} {incr i} {
+	    lappend notPiped $i
+        }
+    } elseif {$header > 2 && $footer == 18 && $te == 1} {
+        set skipOverlaps 1
+        if {$delay == 0} {
+	    # Transaction 1 is conventional.
+	    # Check that transactions 2,3,4 are cancelled.
+	    set notPiped {1}
+	    set notIncluded $notPiped
+        } else {
+	    # Transaction 1 is conventional.
+	    # Check that transaction 2 is cancelled.
+	    # The timing of transactions 3 and 4 is uncertain.
+	    set notPiped {1 3 4}
+	    set notIncluded $notPiped
+	}
+    } elseif {$footer in {20 22 23 24 25}} {
+	# Transaction 2 uses its own socket.
+	set notPiped    2
+	set notIncluded $notPiped
+    } else {
+    }
+    # --------------------------------------------------------------------------
+    # End of custom code for specific tests
+    # --------------------------------------------------------------------------
+
+
+    set Results [logAnalyse $num $skipOverlaps $notIncluded $notPiped]
+    lassign $Results msg cleanE cleanF dirtyE dirtyF
+    if {$msg eq {}} {
+        set msg "Passed all sanity checks."
+    } else {
+        set msg "Problems with sanity checks:\n$msg"
+    }
+
+    if 0 {
+        puts $msg
+        puts "Overlap-free including response body:\n$cleanF"
+        puts "Have overlaps including response body:\n$dirtyF"
+        puts "Overlap-free without response body:\n$cleanE"
+        puts "Have overlaps without response body:\n$dirtyE"
+    }
+
+    if {$header < 3} {
+        # No ordering, just check that transactions all finish
+        set result $msg
+    } elseif {$header == 3} {
+        # Not pipelined - check overlaps with response body.
+        set result "$msg\nHave overlaps including response body:\n$dirtyF"
+    } else {
+        # Pipelined - check overlaps without response body.  Check that the
+        # first request, the first requests after replay, and POSTs are clean.
+        set result "$msg\nOverlap-free without response body:\n$cleanE"
+    }
+    set ::nTokens $num
+    return $result
+}
+
+
+# ------------------------------------------------------------------------------
+# (3) VERBOSITY CONTROL
+# ------------------------------------------------------------------------------
+# If tests fail, run an individual test with -verbose 1 or 2 for diagnosis.
+# If still obscure, uncomment #Log and ##Log lines in the http package.
+# ------------------------------------------------------------------------------
+
+setHttpTestOptions -verbose 0
+
+# ------------------------------------------------------------------------------
+# (4) Define the base URLs used for testing.  Each must have a query string.
+# ------------------------------------------------------------------------------
+# - A HTTP/1.1 server is required.  It should be configured to provide
+#   persistent connections when requested to do so, and to close these
+#   connections if they are idle for one second.
+# - The resource must be served with status 200 in response to a valid GET or
+#   POST.
+# - The value of "page" is always specified in the query-string. Different
+#   resources for the three values of "page" allow testing of both chunked and
+#   unchunked transfer encoding.
+# - The variables "close" and "delay" may be specified in the query-string (for
+#   a GET) or the request body (for a POST).
+#   - "delay" is a numerical value in seconds, and causes the server to delay
+#     the response, including headers.
+#   - "close", if it has the value "y", instructs the server to close the
+#     connection ater the current request.
+# - Any other variables should be ignored.
+# ------------------------------------------------------------------------------
+
+namespace eval ::httpTestScript {
+    variable URL
+    array set URL {
+        a  http://test-tcl-http.kerlin.org/index.html?page=privacy
+        b  http://test-tcl-http.kerlin.org/index.html?page=conditions
+        c  http://test-tcl-http.kerlin.org/index.html?page=welcome
+    }
+}
+
+
+# ------------------------------------------------------------------------------
+# (5) Define the tests
+# ------------------------------------------------------------------------------
+# Constraints:
+# - serverNeeded - the URLs defined at (4) must be available, and must have the
+#                  properties specified there.
+# - duplicate    - the value of -pipeline does not matter if -keepalive 0
+# - timeout1s    - tests that work correctly only if the server closes
+#                  persistent connections after one second.
+#
+# Server timeout of persistent connections should be 1s.  Delays of 2s are
+# intended to cause timeout.
+# Servers are usually configured to use a longer timeout: this will cause the
+# tests to fail.  The "2000" could be replaced with a larger number, but the
+# tests will then be inconveniently slow.
+# ------------------------------------------------------------------------------
+
+#testConstraint serverNeeded 1
+#testConstraint timeout1s 1
+#testConstraint duplicate 1
+
+# ------------------------------------------------------------------------------
+#  Proc SetTestEof - to edit the command ::http::KeepSocket
+# ------------------------------------------------------------------------------
+# The usual line in command ::http::KeepSocket is "    set TEST_EOF 0".
+# Whether the value set in the file is 0 or 1, change it here to the value
+# specified by the argument.
+#
+# It is worth doing all tests for both values of the argument.
+#
+# test 0  - ::http::KeepSocket is unchanged, detects server eof where possible
+#           and closes the connection.
+# test 1  - ::http::KeepSocket is edited, does not detect server eof, so the
+#           reaction to finding server eof can be tested without the difficulty
+#           of testing in the few milliseconds of an asynchronous close event.
+# ------------------------------------------------------------------------------
+
+proc SetTestEof {test} {
+    set body [info body ::http::KeepSocket]
+    set subs "    set TEST_EOF $test"
+    set count [regsub -line -all -- {^\s*set TEST_EOF .*$} $body $subs newBody]
+    if {$count != 1} {
+        return -code error {proc ::http::KeepSocket has unexpected form}
+    }
+    proc ::http::KeepSocket {token} $newBody
+    return
+}
+
+for {set header 1} {$header <= 4} {incr header} {
+    if {$header == 4} {
+	setHttpTestOptions -dotted 1
+	set match glob
+    } else {
+	setHttpTestOptions -dotted 0
+	set match exact
+    }
+
+    if {$header == 2} {
+        set cons0 {serverNeeded duplicate}
+    } else {
+        set cons0 serverNeeded
+    }
+
+    for {set footer 1} {$footer <= 25} {incr footer} {
+        foreach {delay label} {
+	       0 a
+	       1 b
+	       2 c
+	       3 d
+	       5 e
+	       8 f
+	      12 g
+	     100 h
+	     500 i
+	    2000 j
+	} {
+	  foreach te {0 1} {
+	    if {$te} {
+	        set tag testEof
+	    } else {
+	        set tag normal
+	    }
+	    set suffix {}
+	    set cons $cons0
+
+	    # ------------------------------------------------------------------
+	    # Custom code for individual tests
+	    # ------------------------------------------------------------------
+	    if {$footer in {18}} {
+		# Custom code:
+		if {($label eq "j") && ($te == 1)} {
+		    continue
+		}
+		if {$te == 1} {
+		    # The test (of REPOST 0) is useful if tag is "testEof"
+		    # (server timeout without client reaction).  The same test
+		    # has a different result if tag is "normal".
+
+		    set suffix " - extra test for -repost 0 - ::http::2 must be"
+		    append suffix " cancelled"
+		    if {($delay == 0)} {
+			append suffix ", along with  ::http::3  ::http::4 if"
+			append suffix " the test creates these before ::http::2"
+			append suffix " is cancelled"
+		    }
+		} else {
+		}
+	    } elseif {$footer in {19}} {
+		set suffix " - extra test for -repost 0"
+	    } elseif {$footer in {20 21}} {
+		set suffix " - extra test for -postfresh 1"
+		if {($footer == 20)} {
+		    append suffix " - ::http::2 uses a separate socket"
+		    append suffix ", other requests use a persistent connection"
+		}
+	    } elseif {$footer in {22 23 24 25}} {
+		append suffix " - ::http::2 uses a separate socket"
+		append suffix ", other requests use a persistent connection"
+	    } else {
+	    }
+
+	    if {($footer >= 13 && $footer <= 23)} {
+		# Test use WAIT and depend on server timeout before this time.
+		lappend cons timeout1s
+	    }
+	    # ------------------------------------------------------------------
+	    # End of custom code.
+	    # ------------------------------------------------------------------
+
+            set name "pipeline test header $header footer $footer delay $delay $tag$suffix"
+
+
+	    # Here's the test:
+            test httpPipeline-${header}.${footer}${label}-${tag} $name \
+            -constraints $cons \
+            -setup [string map [list TE $te] {
+		# Restore default values for tests:
+		http::config -pipeline 1 -postfresh 0 -repost 1
+                http::init
+                set http::http(uid) 0
+		SetTestEof {TE}
+	    }] -body [list RunTest $header $footer $delay $te] -cleanup {
+		# Restore default values for tests:
+		http::config -pipeline 1 -postfresh 0 -repost 1
+		cleanupHttpTestScript
+		SetTestEof 0
+		cleanupHttpTest
+		after 2000
+		# Wait for persistent sockets on the server to time out.
+	    } -result [ReturnTestResult $header $footer $delay $te] -match $match
+
+
+	  }
+
+	}
+    }
+}
+
+# ------------------------------------------------------------------------------
+# (*) Notes on tests *.18*-testEof, *.19*-testEof - these test -repost 0
+# ------------------------------------------------------------------------------
+# These tests are a bit awkward because the main test kit analyses whether all
+# requests are satisfied, with retries if necessary, and it has result analysis
+# for processing retry logs.
+# - *.18*-testEof tests that certain requests are NOT satisfied, so the analysis
+#   is a one-off.
+# - Tests *.18a-testEof depend on client/server timing - the test needs to call
+#   http::geturl for all requests before the POST (request 2) is cancelled.
+#   We test that requests 2, 3, 4 are all cancelled.
+# - Other tests *.18*-testEof may not request 3 and 4 in time for the to be
+#   added to the write queue before request 2 is completed. We simply check that
+#   request 2 is cancelled.
+# - The behaviour is different if all connections are allowed to time out
+#   (label "j").  This case is not needed to test -repost 0, and is omitted.
+# - Tests *.18*-normal and *.19* are conventional (-repost 0 should have no
+#   effect).
+# ------------------------------------------------------------------------------
+
+
+unset header footer delay label suffix match cons name te
+namespace delete ::httpTest
+namespace delete ::httpTestScript
+
+::tcltest::cleanupTests
diff --git a/tests/httpTest.tcl b/tests/httpTest.tcl
new file mode 100644
index 0000000..326b361
--- /dev/null
+++ b/tests/httpTest.tcl
@@ -0,0 +1,505 @@
+# httpTest.tcl
+#
+#	Test HTTP/1.1 concurrent requests including
+#	queueing, pipelining and retries.
+#
+# Copyright (C) 2018 Keith Nash <kjnash@users.sourceforge.net>
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+# ------------------------------------------------------------------------------
+# "Package" httpTest for analysis of Log output of http requests.
+# ------------------------------------------------------------------------------
+# This is a specialised test kit for examining the presence, ordering, and
+# overlap of multiple HTTP transactions over a persistent ("Keep-Alive")
+# connection; and also for testing reconnection in accordance with RFC 7230 when
+# the connection is lost.
+#
+# This kit is probably not useful for other purposes.  It depends on the
+# presence of specific Log commands in the http library, and it interprets the
+# logs that these commands create.
+# ------------------------------------------------------------------------------
+
+package require http
+
+namespace eval ::http {
+    variable TestStartTimeInMs [clock milliseconds]
+#    catch {puts stdout "Start time (zero ms) is $TestStartTimeInMs"}
+}
+
+namespace eval ::httpTest {
+    variable testResults {}
+    variable testOptions
+    array set testOptions {
+        -verbose 0
+        -dotted  1
+    }
+    # -verbose - 0 quiet 1 write to stdout 2 write more
+    # -dotted  - (boolean) use dots for absences in lists of transactions
+}
+
+proc httpTest::Puts {txt} {
+    variable testOptions
+    if {$testOptions(-verbose) > 0} {
+        puts stdout $txt
+        flush stdout
+    }
+    return
+}
+
+# http::Log
+#
+# A special-purpose logger used for running tests.
+# - Processes Log calls that have "^" in their arguments, and records them in
+#   variable ::httpTest::testResults.
+# - Also writes them to stdout (using Puts) if ($testOptions(-verbose) > 0).
+# - Also writes Log calls that do not have "^", if ($testOptions(-verbose) > 1).
+
+proc http::Log {args} {
+    variable TestStartTimeInMs
+    set time [expr {[clock milliseconds] - $TestStartTimeInMs}]
+    set txt [list $time {*}$args]
+    if {[string first ^ $txt] != -1} {
+        ::httpTest::LogRecord $txt
+        ::httpTest::Puts $txt
+    } elseif {$::httpTest::testOptions(-verbose) > 1} {
+        ::httpTest::Puts $txt
+    }
+    return
+}
+
+
+# Called by http::Log (the "testing" version) to record logs for later analysis.
+
+proc httpTest::LogRecord {txt} {
+    variable testResults
+
+    set pos [string first ^ $txt]
+    set len [string length  $txt]
+    if {$pos > $len - 3} {
+        puts stdout "Logging Error: $txt"
+        puts stdout "Fix this call to Log in http-*.tm so it has ^ then\
+		a letter then a numeral."
+        flush stdout
+    } elseif {$pos == -1} {
+        # Called by mistake.
+    } else {
+        set letter [string index $txt [incr pos]]
+        set number [string index $txt [incr pos]]
+        # Max 9 requests!
+        lappend testResults [list $letter $number]
+    }
+
+    return
+}
+
+
+# ------------------------------------------------------------------------------
+# Commands for analysing the logs recorded when calling http::geturl.
+# ------------------------------------------------------------------------------
+
+# httpTest::TestOverlaps --
+#
+# The main test for correct behaviour of pipelined and sequential
+# (non-pipelined) transactions.  Other tests should be run first to detect
+# any inconsistencies in the data (e.g. absence of the elements that are
+# examined here).
+#
+# Examine the sequence $someResults for each transaction from 1 to $n,
+# ignoring any that are listed in $badTrans.
+# Determine whether the elements "B" to $term for one transaction overlap
+# elements "B" to $term for the previous and following transactions.
+#
+# Transactions in the list $badTrans are not included in "clean" or
+# "dirty", but their possible overlap with other transactions is noted.
+# Transactions in the list $notPiped are a subset of $badTrans, and
+# their possible overlap with other transactions is NOT noted.
+#
+# Arguments:
+# someResults - list of results, each of the form {letter numeral}
+# n           - number of HTTP transactions
+# term        - letter that indicated end of search range. "E" for testing
+#               overlaps from start of request to end of response headers.
+#               "F" to extend to the end of the response body.
+# msg         - the cumulative message from sanity checks.  Append to it only
+#               to report a test failure.
+# badTrans    - list of transaction numbers not to be assessed as "clean" or
+#               "dirty"
+# notPiped    - subset of badTrans.  List of transaction numbers that cannot
+#               taint another transaction by overlapping with it, because it
+#               used a different socket.
+#
+# Return value: [list $msg $clean $dirty]
+# msg   - warning messages: nothing will be appended to argument $msg if there
+#         is an error with the test.
+# clean - list of transactions that have no overlap with other transactions
+# dirty - list of transactions that have YES overlap with other transactions
+
+proc httpTest::TestOverlaps {someResults n term msg badTrans notPiped} {
+    variable testOptions
+
+    # Check whether transactions overlap:
+    set clean {}
+    set dirty {}
+    for {set i 1} {$i <= $n} {incr i} {
+        if {$i in $badTrans} {
+            continue
+        }
+        set myStart   [lsearch -exact $someResults [list B $i]]
+        set myEnd     [lsearch -exact $someResults [list $term $i]]
+
+        if {($myStart == -1 || $myEnd == -1)} {
+            set res "Cannot find positions of transaction $i"
+	    append msg $res \n
+	    Puts $res
+        }
+
+	set overlaps {}
+	for {set j $myStart} {$j <= $myEnd} {incr j} {
+	    lassign [lindex $someResults $j] letter number
+	    if {$number != $i && $letter ne "A" && $number ni $notPiped} {
+		lappend overlaps $number
+	    }
+	}
+
+        if {[llength $overlaps] == 0} {
+	    set res "Transaction $i has no overlaps"
+	    Puts $res
+	    lappend clean $i
+	    if {$testOptions(-dotted)} {
+		# N.B. results from different segments are concatenated.
+		lappend dirty .
+	    } else {
+	    }
+        } else {
+	    set res "Transaction $i overlaps with [join $overlaps { }]"
+	    Puts $res
+	    lappend dirty $i
+	    if {$testOptions(-dotted)} {
+		# N.B. results from different segments are concatenated.
+		lappend clean .
+	    } else {
+	    }
+        }
+    }
+    return [list $msg $clean $dirty]
+}
+
+# httpTest::PipelineNext --
+#
+# Test whether prevPair, pair are valid as consecutive elements of a pipelined
+# sequence (Start 1), (End 1), (Start 2), (End 2) ...
+# Numbers are integers increasing (by 1 if argument "any" is false), and need
+# not begin with 1.
+# The first element of the sequence has prevPair {} and is always passed as
+# valid.
+#
+# Arguments;
+# Start        - string that labels the start of a segment
+# End          - string that labels the end of a segment
+# prevPair     - previous "pair" (list of string and number) element of a
+#                sequence, or {} if argument "pair" is the first in the
+#                sequence.
+# pair         - current "pair" (list of string and number) element of a
+#                sequence
+# any          - (boolean) iff true, accept any increasing sequence of integers.
+#                If false, integers must increase by 1.
+#
+# Return value - boolean, true iff the two pairs are valid consecutive elements.
+
+proc httpTest::PipelineNext {Start End prevPair pair any} {
+    if {$prevPair eq {}} {
+        return 1
+    }
+
+    lassign $prevPair letter number
+    lassign $pair newLetter newNumber
+    if {$letter eq $Start} {
+	return [expr {($newLetter eq $End) && ($newNumber == $number)}]
+    } elseif {$any} {
+        set nxt [list $Start [expr {$number + 1}]]
+	return [expr {($newLetter eq $Start) && ($newNumber > $number)}]
+    } else {
+        set nxt [list $Start [expr {$number + 1}]]
+	return [expr {($newLetter eq $Start) && ($newNumber == $number + 1)}]
+    }
+}
+
+# httpTest::TestPipeline --
+#
+# Given a sequence of "pair" elements, check that the elements whose string is
+# $Start or $End form a valid pipeline. Ignore other elements.
+#
+# Return value: {} if valid pipeline, otherwise a non-empty error message.
+
+proc httpTest::TestPipeline {someResults n Start End msg desc badTrans} {
+    set sequence {}
+    set prevPair {}
+    set ok 1
+    set any [llength $badTrans]
+    foreach pair $someResults {
+        lassign $pair letter number
+        if {($letter in [list $Start $End]) && ($number ni $badTrans)} {
+            lappend sequence $pair
+            if {![PipelineNext $Start $End $prevPair $pair $any]} {
+		set ok 0
+		break
+            }
+            set prevPair $pair
+        }
+    }
+
+    if {!$ok} {
+        set res "$desc are not pipelined: {$sequence}"
+        append msg $res \n
+        Puts $res
+    }
+    return $msg
+}
+
+# httpTest::TestSequence --
+#
+# Examine each transaction from 1 to $n, ignoring any that are listed
+# in $badTrans.
+# Check that each transaction has elements A to F, in alphabetical order.
+
+proc httpTest::TestSequence {someResults n msg badTrans} {
+    variable testOptions
+
+    for {set i 1} {$i <= $n} {incr i} {
+        if {$i in $badTrans} {
+	    continue
+        }
+        set sequence {}
+        foreach pair $someResults {
+            lassign $pair letter number
+            if {$number == $i} {
+                lappend sequence $letter
+            }
+        }
+        if {$sequence eq {A B C D E F}} {
+        } else {
+            set res "Wrong sequence for token ::http::$i - {$sequence}"
+	    append msg $res \n
+	    Puts $res
+            if {"X" in $sequence} {
+                set res "- and error(s) X"
+		append msg $res \n
+		Puts $res
+            }
+            if {"Y" in $sequence} {
+                set res "- and warnings(s) Y"
+		append msg $res \n
+		Puts $res
+            }
+        }
+    }
+    return $msg
+}
+
+#
+# Arguments:
+# someResults  - list of elements, each a list of a letter and a number
+# n            - (positive integer) the number of HTTP requests
+# msg          - accumulated warning messages
+# skipOverlaps - (boolean) whether to skip testing of transaction overlaps
+# badTrans     - list of transaction numbers not to be assessed as "clean" or
+#                "dirty" by their overlaps
+#   for 1/2 includes all transactions
+#   for 3/4 includes an increasing (with recursion) set that will not be included in the list because they are already handled.
+# notPiped     - subset of badTrans.  List of transaction numbers that cannot
+#                taint another transaction by overlapping with it, because it
+#                used a different socket.
+#
+# Return value: [list $msg $cleanE $cleanF $dirtyE $dirtyF]
+# msg    - warning messages: nothing will be appended to argument $msg if there
+#          is no error with the test.
+# cleanE - list of transactions that have no overlap with other transactions
+#          (not considering response body)
+# dirtyE - list of transactions that have YES overlap with other transactions
+#          (not considering response body)
+# cleanF - list of transactions that have no overlap with other transactions
+#          (including response body)
+# dirtyF - list of transactions that have YES overlap with other transactions
+#          (including response body)
+
+proc httpTest::MostAnalysis {someResults n msg skipOverlaps badTrans notPiped} {
+    variable testOptions
+
+    # Check that stages for "good" transactions are all present and correct:
+    set msg [TestSequence $someResults $n $msg $badTrans]
+
+    # Check that requests are pipelined:
+    set msg [TestPipeline $someResults $n B C $msg Requests $notPiped]
+
+    # Check that responses are pipelined:
+    set msg [TestPipeline $someResults $n D F $msg Responses $notPiped]
+
+    if {$skipOverlaps} {
+	set cleanE {}
+	set dirtyE {}
+	set cleanF {}
+	set dirtyF {}
+    } else {
+	Puts "Overlaps including response body (test for non-pipelined case)"
+	lassign [TestOverlaps $someResults $n F $msg $badTrans $notPiped] msg cleanF dirtyF
+
+	Puts "Overlaps without response body (test for pipelined case)"
+	lassign [TestOverlaps $someResults $n E $msg $badTrans $notPiped] msg cleanE dirtyE
+    }
+
+    return [list $msg $cleanE $cleanF $dirtyE $dirtyF]
+}
+
+# httpTest::ProcessRetries --
+#
+# Command to examine results for socket-changing records [PQR],
+# divide the results into segments for each connection, and analyse each segment
+# individually.
+# (Could add $sock to the logging to simplify this, but never mind.)
+#
+# In each segment, identify any transactions that are not included, and
+# any that are aborted, to assist subsequent testing.
+#
+# Prepend A records (socket-independent) to each segment for transactions that
+# were scheduled (by A) but not completed (by F).  Pass each segment to
+# MostAnalysis for processing.
+
+proc httpTest::ProcessRetries {someResults n msg skipOverlaps notIncluded notPiped} {
+    variable testOptions
+
+    set nextRetry [lsearch -glob -index 0 $someResults {[PQR]}]
+    if {$nextRetry == -1} {
+        return [MostAnalysis $someResults $n $msg $skipOverlaps $notIncluded $notPiped]
+    }
+    set badTrans $notIncluded
+    set tryCount 0
+    set try $nextRetry
+    incr tryCount
+    lassign [lindex $someResults $try] letter number
+    Puts "Processing retry [lindex $someResults $try]"
+    set beforeTry [lrange $someResults 0 $try-1]
+    Puts [join $beforeTry \n]
+    set afterTry [lrange $someResults $try+1 end]
+
+    set dummyTry   {}
+    for {set i 1} {$i <= $n} {incr i} {
+        set first [lsearch -exact $beforeTry [list A $i]]
+        set last  [lsearch -exact $beforeTry [list F $i]]
+        if {$first == -1} {
+	    set res "Transaction $i was not started in connection number $tryCount"
+	    # So lappend it to badTrans and don't include it in the call below of MostAnalysis.
+	    # append msg $res \n
+	    Puts $res
+	    if {$i ni $badTrans} {
+		lappend badTrans $i
+	    } else {
+	    }
+        } elseif {$last == -1} {
+	    set res "Transaction $i was started but unfinished in connection number $tryCount"
+	    # So lappend it to badTrans and don't include it in the call below of MostAnalysis.
+	    # append msg $res \n
+	    Puts $res
+	    lappend badTrans $i
+	    lappend dummyTry [list A $i]
+        } else {
+	    set res "Transaction $i was started and finished in connection number $tryCount"
+	    # So include it in the call below of MostAnalysis.
+	    # So lappend it to notIncluded and don't include it in the recursive call of
+	    # ProcessRetries which handles the later connections.
+	    # append msg $res \n
+	    Puts $res
+	    lappend notIncluded $i
+        }
+    }
+
+    # Analyse the part of the results before the first replay:
+    set HeadResults [MostAnalysis $beforeTry $n $msg $skipOverlaps $badTrans $notPiped]
+    lassign $HeadResults msg cleanE1 cleanF1 dirtyE1 dirtyF1
+
+    # Pass the rest of the results to be processed recursively.
+    set afterTry [concat $dummyTry $afterTry]
+    set TailResults [ProcessRetries $afterTry $n $msg $skipOverlaps $notIncluded $notPiped]
+    lassign $TailResults msg cleanE2 cleanF2 dirtyE2 dirtyF2
+
+    set cleanE [concat $cleanE1 $cleanE2]
+    set cleanF [concat $cleanF1 $cleanF2]
+    set dirtyE [concat $dirtyE1 $dirtyE2]
+    set dirtyF [concat $dirtyF1 $dirtyF2]
+    return [list $msg $cleanE $cleanF $dirtyE $dirtyF]
+}
+
+# httpTest::logAnalyse --
+#
+#	The main command called to analyse logs for a single test.
+#
+# Arguments:
+# n            - (positive integer) the number of HTTP requests
+# skipOverlaps - (boolean) whether to skip testing of transaction overlaps
+# notIncluded  - list of transaction numbers not to be assessed as "clean" or
+#                "dirty" by their overlaps
+# notPiped     - subset of notIncluded.  List of transaction numbers that cannot
+#                taint another transaction by overlapping with it, because it
+#                used a different socket.
+#
+# Return value: [list $msg $cleanE $cleanF $dirtyE $dirtyF]
+# msg    - warning messages: {} if there is no error with the test.
+# cleanE - list of transactions that have no overlap with other transactions
+#          (not considering response body)
+# dirtyE - list of transactions that have YES overlap with other transactions
+#          (not considering response body)
+# cleanF - list of transactions that have no overlap with other transactions
+#          (including response body)
+# dirtyF - list of transactions that have YES overlap with other transactions
+#          (including response body)
+
+proc httpTest::logAnalyse {n skipOverlaps notIncluded notPiped} {
+    variable testResults
+    variable testOptions
+
+    # Check that each data item has the correct form {letter numeral}.
+    set ii 0
+    set ok 1
+    foreach pair $testResults {
+	lassign $pair letter number
+	if {    [string match {[A-Z]} $letter]
+	     && [string match {[0-9]} $number]
+	} {
+	    # OK
+	} else {
+	    set ok 0
+	    set res "Error: testResults has bad element {$pair} at position $ii"
+	    append msg $res \n
+	    Puts $res
+	}
+	incr ii
+    }
+
+    if {!$ok} {
+	return $msg
+    }
+    set msg {}
+
+    Puts [join $testResults \n]
+    ProcessRetries $testResults $n $msg $skipOverlaps $notIncluded $notPiped
+    # N.B. Implicit Return.
+}
+
+proc httpTest::cleanupHttpTest {} {
+    variable testResults
+    set testResults {}
+    return
+}
+
+proc httpTest::setHttpTestOptions {key args} {
+    variable testOptions
+    if {$key ni {-dotted -verbose}} {
+        return -code error {valid options are -dotted, -verbose}
+    }
+    set testOptions($key) {*}$args
+}
+
+namespace eval httpTest {
+    namespace export cleanupHttpTest logAnalyse setHttpTestOptions
+}
diff --git a/tests/httpTestScript.tcl b/tests/httpTestScript.tcl
new file mode 100644
index 0000000..a40449a
--- /dev/null
+++ b/tests/httpTestScript.tcl
@@ -0,0 +1,509 @@
+# httpTestScript.tcl
+#
+#	Test HTTP/1.1 concurrent requests including
+#	queueing, pipelining and retries.
+#
+# Copyright (C) 2018 Keith Nash <kjnash@users.sourceforge.net>
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+# ------------------------------------------------------------------------------
+# "Package" httpTestScript for executing test scripts written in a convenient
+# shorthand.
+# ------------------------------------------------------------------------------
+
+# ------------------------------------------------------------------------------
+# Documentation for "package" httpTestScript.
+# ------------------------------------------------------------------------------
+# To use the package:
+# (a) define URLs as the values of elements in the array ::httpTestScript
+# (b) define a script in terms of the commands
+#         START STOP DELAY KEEPALIVE WAIT PIPELINE GET HEAD POST
+#     referring to URLs by the name of the corresponding array element.  The
+#     script can include any other Tcl commands, and evaluates in the
+#     httpTestScript namespace.
+# (c) Use the command httpTestScript::runHttpTestScript to evaluate the script.
+# (d) For tcltest tests, wrap the runHttpTestScript call in a suitable "test"
+#     command.
+# ------------------------------------------------------------------------------
+# START
+# Must be the first command of the script.
+#
+# STOP
+# Must be present in the script to avoid waiting for client timeout.
+# Usually the last command, but can be elsewhere to end a script prematurely.
+# Subsequent httpTestScript commands will have no effect.
+#
+# DELAY ms
+# If there are no WAIT commands, this sets the delay in ms between subsequent
+# calls to http::geturl.  Default 500ms.
+#
+# KEEPALIVE
+# Set the value passed to http::geturl for the -keepalive option.  The command
+# applies to subsequent requests in the script. Default 1.
+#
+# WAIT ms
+# Pause for a time in ms before sending subsequent requests.
+#
+# PIPELINE boolean
+# Set the value of -pipeline using http::config.  The last PIPELINE command
+# in the script applies to every request. Default 1.
+#
+# POSTFRESH boolean
+# Set the value of -postfresh using http::config.  The last POSTFRESH command
+# in the script applies to every request. Default 0.
+#
+# REPOST boolean
+# Set the value of -repost using http::config.  The last REPOST command
+# in the script applies to every request. Default 1 for httpTestScript.
+# (Default value in http is 0).
+#
+# GET uriCode ?arg ...?
+# Send a HTTP request using the GET method.
+# Arguments:
+# uriCode - the code for the base URI - the value must be stored in
+#           ::httpTestScript::URL($uriCode).
+# args    - strings that will be joined by "&" and appended to the query
+#           string with a preceding "&".
+#
+# HEAD uriCode ?arg ...?
+# Send a HTTP request using the HEAD method.
+# Arguments: as for GET
+#
+# POST uriCode ?arg ...?
+# Send a HTTP request using the POST method.
+# Arguments:
+# uriCode - the code for the base URI - the value must be stored in
+#           ::httpTestScript::URL($uriCode).
+# args    - strings that will be joined by "&" and used as the request body.
+# ------------------------------------------------------------------------------
+
+namespace eval ::httpTestScript {
+    namespace export runHttpTestScript cleanupHttpTestScript
+}
+
+# httpTestScript::START --
+# Initialise, and create a long-stop timeout.
+
+proc httpTestScript::START {} {
+    variable CountRequestedSoFar
+    variable RequestsWhenStopped
+    variable KeepAlive
+    variable Delay
+    variable TimeOutCode
+    variable TimeOutDone
+    variable StartDone
+    variable StopDone
+    variable CountFinishedSoFar
+    variable RequestList
+    variable RequestsMade
+    variable ExtraTime
+    variable ActualKeepAlive
+
+    if {[info exists StartDone] && ($StartDone == 1)} {
+        set msg {START has been called twice without an intervening STOP}
+        return -code error $msg
+    }
+
+    set StartDone 1
+    set StopDone 0
+    set TimeOutDone 0
+    set CountFinishedSoFar 0
+    set CountRequestedSoFar 0
+    set RequestList {}
+    set RequestsMade {}
+    set ExtraTime 0
+    set ActualKeepAlive 1
+
+    # Undefined until a STOP command:
+    unset -nocomplain RequestsWhenStopped
+
+    # Default values:
+    set KeepAlive 1
+    set Delay 500
+
+    # Default values for tests:
+    KEEPALIVE 1
+    PIPELINE  1
+    POSTFRESH 0
+    REPOST    1
+
+    set TimeOutCode [after 30000 httpTestScript::TimeOutNow]
+#    set TimeOutCode [after 4000 httpTestScript::TimeOutNow]
+    return
+}
+
+# httpTestScript::STOP --
+# Do not process any more commands.  The commands will be executed but will
+# silently do nothing.
+
+proc httpTestScript::STOP {} {
+    variable CountRequestedSoFar
+    variable CountFinishedSoFar
+    variable RequestsWhenStopped
+    variable TimeOutCode
+    variable StartDone
+    variable StopDone
+    variable RequestsMade
+
+    if {$StopDone} {
+        # Don't do anything on a second call.
+        return
+    }
+
+    if {![info exists StartDone]} {
+        return -code error {initialise the script by calling command START}
+    }
+
+    set StopDone 1
+    set StartDone 0
+    set RequestsWhenStopped $CountRequestedSoFar
+    unset -nocomplain StartDone
+
+    if {$CountFinishedSoFar == $RequestsWhenStopped} {
+        if {[info exists TimeOutCode]} {
+            after cancel $TimeOutCode
+        }
+        set ::httpTestScript::FOREVER 0
+    }
+    return
+}
+
+# httpTestScript::DELAY --
+# If there are no WAIT commands, this sets the delay in ms between subsequent
+# calls to http::geturl.  Default 500ms.
+
+proc httpTestScript::DELAY {t} {
+    variable StartDone
+    variable StopDone
+
+    if {$StopDone} {
+        return
+    }
+
+    if {![info exists StartDone]} {
+        return -code error {initialise the script by calling command START}
+    }
+
+    variable Delay
+
+    set Delay $t
+    return
+}
+
+# httpTestScript::KEEPALIVE --
+# Set the value passed to http::geturl for the -keepalive option.  Default 1.
+
+proc httpTestScript::KEEPALIVE {b} {
+    variable StartDone
+    variable StopDone
+
+    if {$StopDone} {
+        return
+    }
+
+    if {![info exists StartDone]} {
+        return -code error {initialise the script by calling command START}
+    }
+
+    variable KeepAlive
+    set KeepAlive $b
+    return
+}
+
+# httpTestScript::WAIT --
+# Pause for a time in ms before processing any more commands.
+
+proc httpTestScript::WAIT {t} {
+    variable StartDone
+    variable StopDone
+    variable ExtraTime
+
+    if {$StopDone} {
+        return
+    }
+
+    if {![info exists StartDone]} {
+        return -code error {initialise the script by calling command START}
+    }
+
+    if {(![string is integer -strict $t]) || $t < 0} {
+        return -code error {argument to WAIT must be a non-negative integer}
+    }
+
+    incr ExtraTime $t
+
+    return
+}
+
+# httpTestScript::PIPELINE --
+# Pass a value to http::config -pipeline.
+
+proc httpTestScript::PIPELINE {b} {
+    variable StartDone
+    variable StopDone
+
+    if {$StopDone} {
+        return
+    }
+
+    if {![info exists StartDone]} {
+        return -code error {initialise the script by calling command START}
+    }
+
+    ::http::config -pipeline $b
+    ##::http::Log http(-pipeline) is now [::http::config -pipeline]
+    return
+}
+
+# httpTestScript::POSTFRESH --
+# Pass a value to http::config -postfresh.
+
+proc httpTestScript::POSTFRESH {b} {
+    variable StartDone
+    variable StopDone
+
+    if {$StopDone} {
+        return
+    }
+
+    if {![info exists StartDone]} {
+        return -code error {initialise the script by calling command START}
+    }
+
+    ::http::config -postfresh $b
+    ##::http::Log http(-postfresh) is now [::http::config -postfresh]
+    return
+}
+
+# httpTestScript::REPOST --
+# Pass a value to http::config -repost.
+
+proc httpTestScript::REPOST {b} {
+    variable StartDone
+    variable StopDone
+
+    if {$StopDone} {
+        return
+    }
+
+    if {![info exists StartDone]} {
+        return -code error {initialise the script by calling command START}
+    }
+
+    ::http::config -repost $b
+    ##::http::Log http(-repost) is now [::http::config -repost]
+    return
+}
+
+# httpTestScript::GET --
+# Send a HTTP request using the GET method.
+# Arguments:
+# uriCode - the code for the base URI - the value must be stored in
+#           ::httpTestScript::URL($uriCode).
+# args    - strings that will each be preceded by "&" and appended to the query
+#           string.
+
+proc httpTestScript::GET {uriCode args} {
+    variable RequestList
+    lappend RequestList GET
+    RequestAfter $uriCode 0 {} {*}$args
+    return
+}
+
+# httpTestScript::HEAD --
+# Send a HTTP request using the HEAD method.
+# Arguments: as for GET
+
+proc httpTestScript::HEAD {uriCode args} {
+    variable RequestList
+    lappend RequestList HEAD
+    RequestAfter $uriCode 1 {} {*}$args
+    return
+}
+
+# httpTestScript::POST --
+# Send a HTTP request using the POST method.
+# Arguments:
+# uriCode - the code for the base URI - the value must be stored in
+#           ::httpTestScript::URL($uriCode).
+# args    - strings that will be joined by "&" and used as the request body.
+
+proc httpTestScript::POST {uriCode args} {
+    variable RequestList
+    lappend RequestList POST
+    RequestAfter $uriCode 0 {use} {*}$args
+    return
+}
+
+
+proc httpTestScript::RequestAfter {uriCode validate query args} {
+    variable CountRequestedSoFar
+    variable Delay
+    variable ExtraTime
+    variable StartDone
+    variable StopDone
+    variable KeepAlive
+
+    if {$StopDone} {
+        return
+    }
+
+    if {![info exists StartDone]} {
+        return -code error {initialise the script by calling command START}
+    }
+
+    incr CountRequestedSoFar
+    set idelay [expr {($CountRequestedSoFar - 1) * $Delay + 10 + $ExtraTime}]
+
+    # Could pass values of -pipeline, -postfresh, -repost if it were
+    # useful to change these mid-script.
+    after $idelay [list httpTestScript::Requester $uriCode $KeepAlive $validate $query {*}$args]
+    return
+}
+
+proc httpTestScript::Requester {uriCode keepAlive validate query args} {
+    variable URL
+
+    ::http::config -accept {*/*}
+
+    set absUrl $URL($uriCode)
+    if {$query eq {}} {
+	if {$args ne {}} {
+	    append absUrl & [join $args &]
+	}
+	set queryArgs {}
+    } elseif {$validate} {
+        return -code error {cannot have both -validate (HEAD) and -query (POST)}
+    } else {
+	set queryArgs [list -query [join $args &]]
+    }
+
+    if {[catch {
+        ::http::geturl     $absUrl        \
+                -validate  $validate      \
+                -timeout   10000          \
+                {*}$queryArgs             \
+                -keepalive $keepAlive     \
+                -command   ::httpTestScript::WhenFinished
+    } token]} {
+        set msg $token
+        catch {puts stdout "Error: $msg"}
+        return
+    } else {
+        # Request will begin.
+    }
+
+    return
+
+}
+
+proc httpTestScript::TimeOutNow {} {
+    variable TimeOutDone
+
+    set TimeOutDone 1
+    set ::httpTestScript::FOREVER 0
+    return
+}
+
+proc httpTestScript::WhenFinished {hToken} {
+    variable CountFinishedSoFar
+    variable RequestsWhenStopped
+    variable TimeOutCode
+    variable StopDone
+    variable RequestList
+    variable RequestsMade
+    variable ActualKeepAlive
+
+    upvar #0 $hToken state
+
+    if {[catch {
+	if {    [info exists state(transfer)]
+	     && ($state(transfer) eq "chunked")
+	} {
+	    set Trans chunked
+	} else {
+	    set Trans unchunked
+	}
+
+	if {    [info exists ::httpTest::testOptions(-verbose)]
+	     && ($::httpTest::testOptions(-verbose) > 0)
+	} {
+	    puts "Token    $hToken
+Response $state(http)
+Status   $state(status)
+Method   $state(method)
+Transfer $Trans
+Size     $state(currentsize)
+URL      $state(url)
+"
+	}
+
+	if {!$state(-keepalive)} {
+	    set ActualKeepAlive 0
+	}
+
+	if {[info exists state(method)]} {
+	    lappend RequestsMade $state(method)
+	} else {
+	    lappend RequestsMade UNKNOWN
+	}
+	set tk [namespace tail $hToken]
+
+	if {    ($state(http) != {HTTP/1.1 200 OK})
+	     || ($state(status) != {ok})
+	     || (($state(currentsize) == 0) && ($state(method) ne "HEAD"))
+	} {
+	    ::http::Log ^X$tk unexpected result Response $state(http) Status $state(status) Size $state(currentsize) - token $hToken
+	}
+    } err]} {
+	::http::Log ^X$tk httpTestScript::WhenFinished failed with error status: $err - token $hToken
+    }
+
+    incr CountFinishedSoFar
+    if {$StopDone && ($CountFinishedSoFar == $RequestsWhenStopped)} {
+        if {[info exists TimeOutCode]} {
+            after cancel $TimeOutCode
+        }
+        if {$RequestsMade ne $RequestList && $ActualKeepAlive} {
+	    ::http::Log ^X$tk unexpected result - Script asked for "{$RequestList}" but got "{$RequestsMade}" - token $hToken
+        }
+        set ::httpTestScript::FOREVER 0
+    }
+
+    return
+}
+
+
+proc httpTestScript::runHttpTestScript {scr} {
+    variable TimeOutDone
+    variable RequestsWhenStopped
+
+    after idle [list namespace eval ::httpTestScript $scr]
+    vwait ::httpTestScript::FOREVER
+    # N.B. does not automatically execute in this namespace, unlike some other events.
+    # Release when all requests have been served or have timed out.
+
+    if {$TimeOutDone} {
+        return -code error {test script timed out}
+    }
+
+    return $RequestsWhenStopped
+}
+
+
+proc httpTestScript::cleanupHttpTestScript {} {
+    variable TimeOutDone
+    variable RequestsWhenStopped
+
+    if {![info exists RequestsWhenStopped]} {
+	return -code error {Cleanup Failed: RequestsWhenStopped is undefined}
+    }
+
+    for {set i 1} {$i <= $RequestsWhenStopped} {incr i} {
+        http::cleanup ::http::$i
+    }
+
+    return
+}
diff --git a/tests/info.test b/tests/info.test
index 8176ad3..0de1510 100644
--- a/tests/info.test
+++ b/tests/info.test
@@ -19,9 +19,9 @@ if {{::tcltest} ni [namespace children]} {
     package require tcltest 2
     namespace import -force ::tcltest::*
 }
-
 ::tcltest::loadTestedCommands
 catch [list package require -exact Tcltest [info patchlevel]]
+testConstraint zlib [llength [info commands zlib]]
 
 # Set up namespaces needed to test operation of "info args", "info body",
 # "info default", and "info procs" with imported procedures.
@@ -33,7 +33,7 @@ namespace eval test_ns_info1 {
     proc p {x} {return "x=$x"}
     proc q {{y 27} {z {}}} {return "y=$y"}
 }
-
+
 test info-1.1 {info args option} {
     proc t1 {a bbb c} {return foo}
     info args t1
@@ -110,7 +110,7 @@ test info-2.6 {info body option, returning list bodies} {
 proc testinfocmdcount {} {
     set x [info cmdcount]
     set y 12345
-    set z [info cm]
+    set z [info cmdc]
     expr {$z-$x}
 }
 test info-3.1 {info cmdcount compiled} {
@@ -119,7 +119,7 @@ test info-3.1 {info cmdcount compiled} {
 test info-3.2 {info cmdcount evaled} -body {
     set x [info cmdcount]
     set y 12345
-    set z [info cm]
+    set z [info cmdc]
     expr {$z-$x}
 } -cleanup {unset x y z} -result 4
 test info-3.3 {info cmdcount evaled} -body [info body testinfocmdcount] -cleanup {unset x y z} -result 4
@@ -678,16 +678,16 @@ test info-21.1 {miscellaneous error conditions} -returnCodes error -body {
 } -result {wrong # args: should be "info subcommand ?arg ...?"}
 test info-21.2 {miscellaneous error conditions} -returnCodes error -body {
     info gorp
-} -result {unknown or ambiguous subcommand "gorp": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
+} -result {unknown or ambiguous subcommand "gorp": must be args, body, class, cmdcount, cmdtype, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
 test info-21.3 {miscellaneous error conditions} -returnCodes error -body {
     info c
-} -result {unknown or ambiguous subcommand "c": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
+} -result {unknown or ambiguous subcommand "c": must be args, body, class, cmdcount, cmdtype, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
 test info-21.4 {miscellaneous error conditions} -returnCodes error -body {
     info l
-} -result {unknown or ambiguous subcommand "l": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
+} -result {unknown or ambiguous subcommand "l": must be args, body, class, cmdcount, cmdtype, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
 test info-21.5 {miscellaneous error conditions} -returnCodes error -body {
     info s
-} -result {unknown or ambiguous subcommand "s": must be args, body, class, cmdcount, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
+} -result {unknown or ambiguous subcommand "s": must be args, body, class, cmdcount, cmdtype, commands, complete, coroutine, default, errorstack, exists, frame, functions, globals, hostname, level, library, loaded, locals, nameofexecutable, object, patchlevel, procs, script, sharedlibextension, tclversion, or vars}
 
 ##
 # ### ### ### ######### ######### #########
@@ -2396,6 +2396,174 @@ test info-33.35 {{*}, literal, simple, bytecompiled} -body {
 } -result {type source line 2389 file info.test cmd {info frame 0} proc ::foo::bar level 0}
 
 # -------------------------------------------------------------------------
+namespace eval ::testinfocmdtype {
+    apply {cmds {
+	foreach c $cmds {rename $c {}}
+    } ::testinfocmdtype} [info commands ::testinfocmdtype::*]
+}
+test info-40.1 {info cmdtype: syntax} -body {
+    info cmdtype
+} -returnCodes error -result {wrong # args: should be "info cmdtype commandName"}
+test info-40.2 {info cmdtype: syntax} -body {
+    info cmdtype foo bar
+} -returnCodes error -result {wrong # args: should be "info cmdtype commandName"}
+test info-40.3 {info cmdtype: no such command} -body {
+    info cmdtype ::testinfocmdtype::foo
+} -returnCodes error -result {unknown command "::testinfocmdtype::foo"}
+test info-40.4 {info cmdtype: native commands} -body {
+    info cmdtype ::if
+} -result native
+test info-40.5 {info cmdtype: native commands} -body {
+    info cmdtype ::puts
+} -result native
+test info-40.6 {info cmdtype: native commands} -body {
+    info cmdtype ::yield
+} -result native
+test info-40.7 {info cmdtype: procedures} -setup {
+    proc ::testinfocmdtype::someproc {} {}
+} -body {
+    info cmdtype ::testinfocmdtype::someproc
+} -cleanup {
+    rename ::testinfocmdtype::someproc {}
+} -result proc
+test info-40.8 {info cmdtype: aliases} -setup {
+    interp alias {} ::testinfocmdtype::somealias {} ::puts
+} -body {
+    info cmdtype ::testinfocmdtype::somealias
+} -cleanup {
+    rename ::testinfocmdtype::somealias {}
+} -result alias
+test info-40.9 {info cmdtype: imports} -setup {
+    namespace eval ::testinfocmdtype {
+	namespace eval foo {
+	    proc bar {} {}
+	    namespace export bar
+	}
+	namespace import foo::bar
+    }
+} -body {
+    info cmdtype ::testinfocmdtype::bar
+} -cleanup {
+    rename ::testinfocmdtype::bar {}
+    namespace delete ::testinfocmdtype::foo
+} -result import
+test info-40.10 {info cmdtype: slaves} -setup {
+    apply {i {
+	rename $i ::testinfocmdtype::slave
+	variable ::testinfocmdtype::slave $i
+    }} [interp create]
+} -body {
+    info cmdtype ::testinfocmdtype::slave
+} -cleanup {
+    interp delete $::testinfocmdtype::slave
+} -result slave
+test info-40.11 {info cmdtype: objects} -setup {
+    apply {{} {
+	oo::object create obj
+    } ::testinfocmdtype}
+} -body {
+    info cmdtype ::testinfocmdtype::obj
+} -cleanup {
+    ::testinfocmdtype::obj destroy
+} -result object
+test info-40.12 {info cmdtype: objects} -setup {
+    apply {{} {
+	oo::object create obj
+    } ::testinfocmdtype}
+} -body {
+    info cmdtype [info object namespace ::testinfocmdtype::obj]::my
+} -cleanup {
+    ::testinfocmdtype::obj destroy
+} -result privateObject
+test info-40.13 {info cmdtype: ensembles} -setup {
+    namespace eval ::testinfocmdtype {
+	namespace eval ensmbl {
+	    proc bar {} {}
+	    namespace export *
+	    namespace ensemble create
+	}
+    }
+} -body {
+    info cmdtype ::testinfocmdtype::ensmbl
+} -cleanup {
+    namespace delete ::testinfocmdtype::ensmbl
+} -result ensemble
+test info-40.14 {info cmdtype: zlib streams} -constraints zlib -setup {
+    namespace eval ::testinfocmdtype {
+	rename [zlib stream gzip] zstream
+    }
+} -body {
+    info cmdtype ::testinfocmdtype::zstream
+} -cleanup {
+    ::testinfocmdtype::zstream close
+} -result zlibStream
+test info-40.15 {info cmdtype: coroutines} -setup {
+    coroutine ::testinfocmdtype::coro eval yield
+} -body {
+    info cmdtype ::testinfocmdtype::coro
+} -cleanup {
+    ::testinfocmdtype::coro
+} -result coroutine
+test info-40.16 {info cmdtype: dynamic behavior} -setup {
+    proc ::testinfocmdtype::foo {} {}
+} -body {
+    namespace eval ::testinfocmdtype {
+	list [catch {info cmdtype foo}] [catch {info cmdtype bar}] \
+	    [namespace which foo] [rename foo bar] [namespace which bar] \
+	    [catch {info cmdtype foo}] [catch {info cmdtype bar}]
+    }
+} -cleanup {
+    namespace eval ::testinfocmdtype {
+	catch {rename foo {}}
+	catch {rename bar {}}
+    }
+} -result {0 1 ::testinfocmdtype::foo {} ::testinfocmdtype::bar 1 0}
+test info-40.17 {info cmdtype: aliases in slave interpreters} -setup {
+    set i [interp create]
+} -body {
+    $i alias foo gorp
+    $i eval {
+	info cmdtype foo
+    }
+} -cleanup {
+    interp delete $i
+} -result alias
+test info-40.18 {info cmdtype: aliases in slave interpreters} -setup {
+    set safe [interp create -safe]
+} -body {
+    $safe alias foo gorp
+    $safe eval {
+	info cmdtype foo
+    }
+} -cleanup {
+    interp delete $safe
+} -result native
+test info-40.19 {info cmdtype: aliases in slave interpreters} -setup {
+    set safe [interp create -safe]
+} -body {
+    set inner [interp create [list $safe bar]]
+    interp alias $inner foo $safe gorp
+    $safe eval {
+	bar eval {
+	    info cmdtype foo
+	}
+    }
+} -cleanup {
+    interp delete $safe
+} -result native
+test info-40.20 {info cmdtype: aliases in slave interpreters} -setup {
+    set safe [interp create -safe]
+} -body {
+    $safe eval {
+	interp alias {} foo {} gorp
+	info cmdtype foo
+    }
+} -cleanup {
+    interp delete $safe
+} -result alias
+namespace delete ::testinfocmdtype
+
+# -------------------------------------------------------------------------
 unset -nocomplain res
 
 test info-39.2 {Bug 4b61afd660} -setup {
diff --git a/tests/io.test b/tests/io.test
index 20bb565..683a1b2 100644
--- a/tests/io.test
+++ b/tests/io.test
@@ -15,14 +15,8 @@
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2
-    namespace import -force ::tcltest::*
 }
 
-::tcltest::loadTestedCommands
-catch [list package require -exact Tcltest [info patchlevel]]
-
-testConstraint testbytestring [llength [info commands testbytestring]]
-
 namespace eval ::tcl::test::io {
     namespace import ::tcltest::*
 
@@ -35,15 +29,16 @@ namespace eval ::tcl::test::io {
     variable msg
     variable expected
 
+    loadTestedCommands
+    catch [list package require -exact Tcltest [info patchlevel]]
+    package require tcltests
+
+testConstraint testbytestring [llength [info commands testbytestring]]
 testConstraint testchannel      [llength [info commands testchannel]]
-testConstraint exec             [llength [info commands exec]]
 testConstraint openpipe         1
-testConstraint fileevent        [llength [info commands fileevent]]
-testConstraint fcopy            [llength [info commands fcopy]]
 testConstraint testfevent       [llength [info commands testfevent]]
 testConstraint testchannelevent [llength [info commands testchannelevent]]
 testConstraint testmainthread   [llength [info commands testmainthread]]
-testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]
 testConstraint testobj		[llength [info commands testobj]]
 
 # You need a *very* special environment to do some tests.  In
diff --git a/tests/ioCmd.test b/tests/ioCmd.test
index cab4e97..948671e 100644
--- a/tests/ioCmd.test
+++ b/tests/ioCmd.test
@@ -21,10 +21,10 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
 ::tcltest::loadTestedCommands
 catch [list package require -exact Tcltest [info patchlevel]]
 
+package require tcltests
+
 # Custom constraints used in this file
-testConstraint fcopy		[llength [info commands fcopy]]
 testConstraint testchannel	[llength [info commands testchannel]]
-testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]
 
 #----------------------------------------------------------------------
 
@@ -395,7 +395,7 @@ test iocmd-11.2 {I/O to command pipelines} {unixOrPc unixExecs} {
 test iocmd-11.3 {I/O to command pipelines} {unixOrPc unixExecs} {
     list [catch {open "| echo > \"$path(test5)\"" r+} msg] $msg $::errorCode
 } {1 {can't read output from command: standard output was redirected} {TCL OPERATION EXEC BADREDIRECT}}
-test iocmd-11.4 {I/O to command pipelines} unixOrPc {
+test iocmd-11.4 {I/O to command pipelines} {notValgrind unixOrPc} {
     list [catch {open "| no_such_command_exists" rb} msg] $msg $::errorCode
 } {1 {couldn't execute "no_such_command_exists": no such file or directory} {POSIX ENOENT {no such file or directory}}}
 
@@ -3781,7 +3781,6 @@ test iocmd.tf-32.0 {origin thread of moved channel gone} -match glob -body {
 # Use constraints to skip this test while valgrinding so this expected leak
 # doesn't prevent a finding of "leak-free".
 #
-testConstraint notValgrind [expr {![testConstraint valgrind]}]
 test iocmd.tf-32.1 {origin thread of moved channel destroyed during access} -match glob -body {
 
     #puts <<$tcltest::mainThread>>main
@@ -3834,6 +3833,16 @@ test iocmd.tf-32.1 {origin thread of moved channel destroyed during access} -mat
 
 rename track {}
 # cleanup
+
+
+# Eliminate valgrind "still reachable" reports on outstanding "Detached"
+# structures in the detached list which stem from PipeClose2Proc not waiting
+# around for background processes to complete, meaning that previous calls to
+# Tcl_ReapDetachedProcs might not have had a chance to reap all processes.
+after 10
+exec [info nameofexecutable] << {}
+
+
 foreach file [list test1 test2 test3 test4] {
     removeFile $file
 }
diff --git a/tests/ioTrans.test b/tests/ioTrans.test
index 75752f7..0a335ff 100644
--- a/tests/ioTrans.test
+++ b/tests/ioTrans.test
@@ -1240,8 +1240,8 @@ test iortrans-11.1 {origin interpreter of moved transform destroyed during acces
 	set res
     }]
 } -cleanup {
-    tempdone
     interp delete $idb
+    tempdone
 } -result {Owner lost}
 test iortrans-11.2 {delete interp of reflected transform} -setup {
     interp create slave
diff --git a/tests/iogt.test b/tests/iogt.test
index aa579bf..3cac2cf 100644
--- a/tests/iogt.test
+++ b/tests/iogt.test
@@ -608,7 +608,7 @@ test iogt-3.0 {Tcl_Channel valid after stack/unstack, fevent handling} -setup {
 	variable copy 1
     }
 } -constraints {testchannel knownBug} -body {
-    # This test to check the validity of aquired Tcl_Channel references is not
+    # This test to check the validity of acquired Tcl_Channel references is not
     # possible because even a backgrounded fcopy will immediately start to
     # copy data, without waiting for the event loop. This is done only in case
     # of an underflow on the read size!. So stacking transforms after the
diff --git a/tests/lreplace.test b/tests/lreplace.test
index 4a6b853..fd2f7f8 100644
--- a/tests/lreplace.test
+++ b/tests/lreplace.test
@@ -100,10 +100,10 @@ test lreplace-1.26 {lreplace command} {
 } {a {} {}}
 test lreplace-1.27 {lreplace command} -body {
     lreplace x 1 1
-} -returnCodes 1 -result {list doesn't contain element 1}
+} -result x
 test lreplace-1.28 {lreplace command} -body {
     lreplace x 1 1 y
-} -returnCodes 1 -result {list doesn't contain element 1}
+} -result {x y}
 test lreplace-1.29 {lreplace command} -body {
     lreplace x 1 1 [error foo]
 } -returnCodes 1 -result {foo}
@@ -128,10 +128,10 @@ test lreplace-2.5 {lreplace errors} {
 } {1 {bad index "1x": must be integer?[+-]integer? or end?[+-]integer?}}
 test lreplace-2.6 {lreplace errors} {
     list [catch {lreplace x 3 2} msg] $msg
-} {1 {list doesn't contain element 3}}
+} {0 x}
 test lreplace-2.7 {lreplace errors} {
     list [catch {lreplace x 2 2} msg] $msg
-} {1 {list doesn't contain element 2}}
+} {0 x}
 
 test lreplace-3.1 {lreplace won't modify shared argument objects} {
     proc p {} {
diff --git a/tests/main.test b/tests/main.test
index ab66b38..5b43b43 100644
--- a/tests/main.test
+++ b/tests/main.test
@@ -1210,8 +1210,6 @@ namespace eval ::tcl::test::main {
 	Bug 1775878
     } -constraints {
 	exec Tcltest
-    } -setup {
-	catch {set f [open "|[list [interpreter]]" w+]}
     } -body {
 	exec [interpreter] << "testsetmainloop\nputs \\\npwd\ntestexitmainloop" >& result
 	set f [open result]
diff --git a/tests/msgcat.test b/tests/msgcat.test
index 12030fb..3dde124 100644
--- a/tests/msgcat.test
+++ b/tests/msgcat.test
@@ -999,7 +999,7 @@ if {[package vsatisfies [package provide msgcat] 1.7]} {
 	    mcpackagelocale isset
 	} -result {0}
 
-	
+
     # Tests msgcat-13.*: [mcpackageconfig subcmds]
 
 	test msgcat-13.1 {mcpackageconfig no subcommand} -body {
@@ -1153,7 +1153,7 @@ if {[package vsatisfies [package provide msgcat] 1.7]} {
 
 
     # Tests msgcat-15.*: tcloo coverage
-    
+
     # There are 4 use-cases, where 3 must be tested now:
     # - namespace defined, in class definition, class defined oo, classless
 
@@ -1210,7 +1210,7 @@ if {[package vsatisfies [package provide msgcat] 1.7]} {
     } -body {
 	bar::ObjCur method1
     } -result con2bar
-    
+
     test msgcat-15.4 {mc in classless object with explicite namespace eval}\
     -setup {
 	# full namespace is ::msgcat::test:bar
@@ -1236,7 +1236,7 @@ if {[package vsatisfies [package provide msgcat] 1.7]} {
     } -body {
 	bar::ObjCur method1
     } -result con2baz
-    
+
     # Test msgcat-16.*: command mcpackagenamespaceget
 
     test msgcat-16.1 {mcpackagenamespaceget in namespace procedure} -body {
@@ -1298,7 +1298,7 @@ if {[package vsatisfies [package provide msgcat] 1.7]} {
 
 
     # Test msgcat-17.*: mcn command
-    
+
     test msgcat-17.1 {mcn no parameters} -body {
 	mcn
     } -returnCodes 1\
@@ -1328,26 +1328,26 @@ if {[package vsatisfies [package provide msgcat] 1.7]} {
 	mcutil junk
     } -returnCodes 1\
     -result {unknown subcommand "junk": must be getpreferences, or getsystemlocale}
-    
+
     test msgcat-18.3 {mcutil - partial argument} -body {
 	mcutil getsystem
     } -returnCodes 1\
     -result {unknown subcommand "getsystem": must be getpreferences, or getsystemlocale}
-    
+
     test msgcat-18.4 {mcutil getpreferences - no argument} -body {
 	mcutil getpreferences
     } -returnCodes 1\
     -result {wrong # args: should be "mcutil getpreferences locale"}
-    
+
     test msgcat-18.5 {mcutil getpreferences - DE_de} -body {
 	mcutil getpreferences DE_de
     } -result {de_de de {}}
-    
+
     test msgcat-18.6 {mcutil getsystemlocale - wrong argument} -body {
 	mcutil getsystemlocale DE_de
     } -returnCodes 1\
     -result {wrong # args: should be "mcutil getsystemlocale"}
-    
+
     # The result is system dependent
     # So just test if it runs
     # The environment variable version was test with test 0.x
@@ -1355,8 +1355,8 @@ if {[package vsatisfies [package provide msgcat] 1.7]} {
 	mcutil getsystemlocale
 	set ok ok
     } -result {ok}
-    
-    
+
+
     cleanupTests
 }
 namespace delete ::msgcat::test
diff --git a/tests/namespace.test b/tests/namespace.test
index b9e6ead..606139f 100644
--- a/tests/namespace.test
+++ b/tests/namespace.test
@@ -205,7 +205,7 @@ test namespace-7.8 {Bug ba1419303b4c} -setup {
 	namespace delete ns1
     }
 } -body {
-    # No segmentation fault given --enable-symbols=mem. 
+    # No segmentation fault given --enable-symbols=mem.
     namespace delete ns1
 } -result {}
 
diff --git a/tests/obj.test b/tests/obj.test
index cb62d3f..d407669 100644
--- a/tests/obj.test
+++ b/tests/obj.test
@@ -20,8 +20,8 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
 catch [list package require -exact Tcltest [info patchlevel]]
 
 testConstraint testobj [llength [info commands testobj]]
-testConstraint longIs32bit	[expr {int(0x80000000) < 0}]
-testConstraint wideBiggerThanInt [expr {wide(0x80000000) != int(0x80000000)}]
+testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
+testConstraint wideIs64bit [expr {wide(0x8000000000000000) < 0}]
 
 test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} testobj {
     set r 1
@@ -549,11 +549,11 @@ test obj-32.1 {freeing very large object trees} {
     unset x
 } {}
 
-test obj-33.1 {integer overflow on input} {longIs32bit wideBiggerThanInt} {
+test obj-33.1 {integer overflow on input} {longIs32bit wideIs64bit} {
     set x 0x8000; append x 0000
     list [string is integer $x] [expr { wide($x) }]
 } {1 2147483648}
-test obj-33.2 {integer overflow on input} {longIs32bit wideBiggerThanInt} {
+test obj-33.2 {integer overflow on input} {longIs32bit wideIs64bit} {
     set x 0xffff; append x ffff
     list [string is integer $x] [expr { wide($x) }]
 } {1 4294967295}
@@ -561,15 +561,15 @@ test obj-33.3 {integer overflow on input} {
     set x 0x10000; append x 0000
     list [string is integer $x] [expr { wide($x) }]
 } {0 4294967296}
-test obj-33.4 {integer overflow on input} {longIs32bit wideBiggerThanInt} {
+test obj-33.4 {integer overflow on input} {longIs32bit wideIs64bit} {
     set x -0x8000; append x 0000
     list [string is integer $x] [expr { wide($x) }]
 } {1 -2147483648}
-test obj-33.5 {integer overflow on input} {longIs32bit wideBiggerThanInt} {
+test obj-33.5 {integer overflow on input} {longIs32bit wideIs64bit} {
     set x -0x8000; append x 0001
     list [string is integer $x] [expr { wide($x) }]
 } {1 -2147483649}
-test obj-33.6 {integer overflow on input} {longIs32bit wideBiggerThanInt} {
+test obj-33.6 {integer overflow on input} {longIs32bit wideIs64bit} {
     set x -0xffff; append x ffff
     list [string is integer $x] [expr { wide($x) }]
 } {1 -4294967295}
diff --git a/tests/oo.test b/tests/oo.test
index 9a22438..033daf5 100644
--- a/tests/oo.test
+++ b/tests/oo.test
@@ -13,13 +13,11 @@ if {"::tcltest" in [namespace children]} {
     namespace import -force ::tcltest::*
 }
 
-
 # The foundational objects oo::object and oo::class are sensitive to reference
 # counting errors and are deallocated only when an interp is deleted, so in
 # this test suite, interp creation and interp deletion are often used in
 # leaktests in order to leverage this sensitivity.
 
-
 testConstraint memory [llength [info commands memory]]
 if {[testConstraint memory]} {
     proc getbytes {} {
@@ -340,10 +338,10 @@ test oo-1.21 {basic test of OO functionality: default relations} -setup {
 	    lappend x [info object class ::oo::$initial]
 	}
 	return $x
-    }] {lsort $x}
+    }] {lsort [lmap y $x {if {[string match *::delegate $y]} continue; set y}]}
 } -cleanup {
     interp delete $fresh
-} -result {{} {::oo::Slot ::oo::class ::oo::object} {::oo::define::filter ::oo::define::mixin ::oo::define::superclass ::oo::define::variable ::oo::objdefine::filter ::oo::objdefine::mixin ::oo::objdefine::variable} {::oo::Slot ::oo::class} {} {} {} {} {} {} ::oo::object ::oo::object ::oo::class ::oo::class ::oo::class}
+} -result {{} {::oo::Slot ::oo::abstract ::oo::class ::oo::object ::oo::singleton} {::oo::define::filter ::oo::define::mixin ::oo::define::superclass ::oo::define::variable ::oo::objdefine::filter ::oo::objdefine::mixin ::oo::objdefine::variable} {::oo::Slot ::oo::class} {::oo::abstract ::oo::singleton} {} {} {} {} {} ::oo::object ::oo::object ::oo::class ::oo::class ::oo::class}
 
 test oo-2.1 {basic test of OO functionality: constructor} -setup {
     # This is a bit complex because it needs to run in a sub-interp as
@@ -2153,7 +2151,7 @@ test oo-15.13.1 {
 } -cleanup {
     Cls destroy
     Cls2 destroy
-} -result done 
+} -result done
 test oo-15.13.2 {OO: object cloning with target NS} -setup {
     oo::class create Super
     oo::class create Cls {superclass Super}
@@ -3838,6 +3836,11 @@ proc SampleSlotSetup script {
 		lappend ops [info level] Set $lst
 		return
 	    }
+	    method Resolve {lst} {
+		variable ops
+		lappend ops [info level] Resolve $lst
+		return $lst
+	    }
 	}
     }
     append script0 \n$script
@@ -3872,7 +3875,7 @@ test oo-32.3 {TIP 380: slots - class test} -setup [SampleSlotSetup {
 	[sampleSlot contents] [sampleSlot ops]
 } -cleanup [SampleSlotCleanup {
     rename sampleSlot {}
-}] -result {0 {} {a b c g h i} {1 Get 1 Set {a b c g h i}}}
+}] -result {0 {} {a b c g h i} {1 Resolve g 1 Resolve h 1 Resolve i 1 Get 1 Set {a b c g h i}}}
 test oo-32.4 {TIP 380: slots - class test} -setup [SampleSlotSetup {
     SampleSlot create sampleSlot
 }] -body {
@@ -3880,7 +3883,7 @@ test oo-32.4 {TIP 380: slots - class test} -setup [SampleSlotSetup {
 	[sampleSlot contents] [sampleSlot ops]
 } -cleanup [SampleSlotCleanup {
     rename sampleSlot {}
-}] -result {0 {} {d e f} {1 Set {d e f}}}
+}] -result {0 {} {d e f} {1 Resolve d 1 Resolve e 1 Resolve f 1 Set {d e f}}}
 test oo-32.5 {TIP 380: slots - class test} -setup [SampleSlotSetup {
     SampleSlot create sampleSlot
 }] -body {
@@ -3888,7 +3891,23 @@ test oo-32.5 {TIP 380: slots - class test} -setup [SampleSlotSetup {
 	[sampleSlot contents] [sampleSlot ops]
 } -cleanup [SampleSlotCleanup {
     rename sampleSlot {}
-}] -result {0 {} {} {d e f g h i} {1 Set {d e f} 1 Get 1 Set {d e f g h i}}}
+}] -result {0 {} {} {d e f g h i} {1 Resolve d 1 Resolve e 1 Resolve f 1 Set {d e f} 1 Resolve g 1 Resolve h 1 Resolve i 1 Get 1 Set {d e f g h i}}}
+test oo-32.6 {TIP 516: slots - class test} -setup [SampleSlotSetup {
+    SampleSlot create sampleSlot
+}] -body {
+    list [info level] [sampleSlot -prepend g h i] \
+	[sampleSlot contents] [sampleSlot ops]
+} -cleanup [SampleSlotCleanup {
+    rename sampleSlot {}
+}] -result {0 {} {g h i a b c} {1 Resolve g 1 Resolve h 1 Resolve i 1 Get 1 Set {g h i a b c}}}
+test oo-32.6 {TIP 516: slots - class test} -setup [SampleSlotSetup {
+    SampleSlot create sampleSlot
+}] -body {
+    list [info level] [sampleSlot -remove c a] \
+	[sampleSlot contents] [sampleSlot ops]
+} -cleanup [SampleSlotCleanup {
+    rename sampleSlot {}
+}] -result {0 {} b {1 Resolve c 1 Resolve a 1 Get 1 Set b}}
 
 test oo-33.1 {TIP 380: slots - defaulting} -setup [SampleSlotSetup {
     set s [SampleSlot new]
@@ -3911,7 +3930,7 @@ test oo-33.3 {TIP 380: slots - defaulting} -setup [SampleSlotSetup {
     list [$s destroy; $s unknown] [$s contents] [$s ops]
 } -cleanup [SampleSlotCleanup {
     rename $s {}
-}] -result {{} unknown {1 Set destroy 1 Set unknown}}
+}] -result {{} unknown {1 Resolve destroy 1 Set destroy 1 Resolve unknown 1 Set unknown}}
 test oo-33.4 {TIP 380: slots - errors} -setup [SampleSlotSetup {
     set s [SampleSlot new]
 }] -body {
@@ -3920,7 +3939,7 @@ test oo-33.4 {TIP 380: slots - errors} -setup [SampleSlotSetup {
 } -returnCodes error -cleanup [SampleSlotCleanup {
     rename $s {}
 }] -result \
-    {unknown method "-grill": must be -append, -clear, -set, contents or ops}
+    {unknown method "-grill": must be -append, -clear, -prepend, -remove, -set, contents or ops}
 
 test oo-34.1 {TIP 380: slots - presence} -setup {
     set obj [oo::object new]
@@ -3950,25 +3969,68 @@ proc getMethods obj {
 }
 test oo-34.3 {TIP 380: slots - presence} {
     getMethods oo::define::filter
-} {{-append -clear -set} {Get Set}}
+} {{-append -clear -prepend -remove -set} {Get Set}}
 test oo-34.4 {TIP 380: slots - presence} {
     getMethods oo::define::mixin
-} {{-append -clear -set} {--default-operation Get Set}}
+} {{-append -clear -prepend -remove -set} {--default-operation Get Resolve Set}}
 test oo-34.5 {TIP 380: slots - presence} {
     getMethods oo::define::superclass
-} {{-append -clear -set} {--default-operation Get Set}}
+} {{-append -clear -prepend -remove -set} {--default-operation Get Resolve Set}}
 test oo-34.6 {TIP 380: slots - presence} {
     getMethods oo::define::variable
-} {{-append -clear -set} {Get Set}}
+} {{-append -clear -prepend -remove -set} {Get Set}}
 test oo-34.7 {TIP 380: slots - presence} {
     getMethods oo::objdefine::filter
-} {{-append -clear -set} {Get Set}}
+} {{-append -clear -prepend -remove -set} {Get Set}}
 test oo-34.8 {TIP 380: slots - presence} {
     getMethods oo::objdefine::mixin
-} {{-append -clear -set} {--default-operation Get Set}}
+} {{-append -clear -prepend -remove -set} {--default-operation Get Resolve Set}}
 test oo-34.9 {TIP 380: slots - presence} {
     getMethods oo::objdefine::variable
-} {{-append -clear -set} {Get Set}}
+} {{-append -clear -prepend -remove -set} {Get Set}}
+test oo-34.10 {TIP 516: slots - resolution} -setup {
+    oo::class create parent
+    set result {}
+    oo::class create 516a { superclass parent }
+    oo::class create 516b { superclass parent }
+    oo::class create 516c { superclass parent }
+    namespace eval 516test {
+	oo::class create 516a { superclass parent }
+	oo::class create 516b { superclass parent }
+	oo::class create 516c { superclass parent }
+    }
+} -body {
+    # Must find the right classes when making the mixin
+    namespace eval 516test {
+	oo::define 516a {
+	    mixin 516b 516c
+	}
+    }
+    lappend result [info class mixin 516test::516a]
+    # Must not remove class with just simple name match 
+    oo::define 516test::516a {
+	mixin -remove 516b
+    }
+    lappend result [info class mixin 516test::516a]
+    # Must remove class with resolved name match
+    oo::define 516test::516a {
+	mixin -remove 516test::516c
+    }
+    lappend result [info class mixin 516test::516a]
+    # Must remove class with resolved name match even after renaming, but only
+    # with the renamed name; it is a slot of classes, not strings!
+    rename 516test::516b 516test::516d
+    oo::define 516test::516a {
+	mixin -remove 516test::516b
+    }
+    lappend result [info class mixin 516test::516a]
+    oo::define 516test::516a {
+	mixin -remove 516test::516d
+    }
+    lappend result [info class mixin 516test::516a]
+} -cleanup {
+    parent destroy
+} -result {{::516test::516b ::516test::516c} {::516test::516b ::516test::516c} ::516test::516b ::516test::516d {}}
 
 test oo-35.1 {Bug 9d61624b3d: Empty superclass must not cause crash} -setup {
     oo::class create fruit {
@@ -4845,6 +4907,75 @@ test oo-40.3 {TIP 500: private and unexport} -setup {
 } -cleanup {
     cls destroy
 } -result {{} {} foo {} foo {}}
+
+test oo-41.1 {TIP 478: myclass command, including class morphing} -setup {
+    oo::class create parent
+    set result {}
+} -body {
+    oo::class create cls1 {
+	superclass parent
+	self method count {} {
+	    my variable c
+	    incr c
+	}
+	method act {} {
+	    myclass count
+	}
+    }
+    cls1 create x
+    lappend result [x act] [x act]
+    cls1 create y
+    lappend result [y act] [y act] [x act]
+    oo::class create cls2 {
+	superclass cls1
+	self method count {} {
+	    my variable d
+	    expr {1.0 * [incr d]}
+	}
+    }
+    oo::objdefine x {class cls2}
+    lappend result [x act] [y act] [x act] [y act]
+} -cleanup {
+    parent destroy
+} -result {1 2 3 4 5 1.0 6 2.0 7}
+test oo-41.2 {TIP 478: myclass command cleanup} -setup {
+    oo::class create parent
+    set result {}
+} -body {
+    oo::class create cls1 {
+	superclass parent
+	self method hi {} {
+	    return "this is [self]"
+	}
+	method hi {} {
+	    return "this is [self]"
+	}
+    }
+    cls1 create x
+    rename [info object namespace x]::my foo
+    rename [info object namespace x]::myclass bar
+    lappend result [cls1 hi] [x hi] [foo hi] [bar hi]
+    x destroy
+    lappend result [catch {foo hi}] [catch {bar hi}]
+} -cleanup {
+    parent destroy
+} -result {{this is ::cls1} {this is ::x} {this is ::x} {this is ::cls1} 1 1}
+test oo-41.3 {TIP 478: myclass command calls unexported methods, via forward} -setup {
+    oo::class create parent
+    set result {}
+} -body {
+    oo::class create cls1 {
+	superclass parent
+	self method Hi {} {
+	    return "this is [self]"
+	}
+	forward poke myclass Hi
+    }
+    cls1 create x
+    lappend result [catch {cls1 Hi}] [x poke]
+} -cleanup {
+    parent destroy
+} -result {1 {this is ::cls1}}
 
 cleanupTests
 return
diff --git a/tests/ooUtil.test b/tests/ooUtil.test
new file mode 100644
index 0000000..ff7093f
--- /dev/null
+++ b/tests/ooUtil.test
@@ -0,0 +1,563 @@
+# This file contains a collection of tests for functionality originally
+# sourced from the ooutil package in Tcllib. Sourcing this file into Tcl runs
+# the tests and generates output for errors. No output means no errors were
+# found.
+#
+# Copyright (c) 2014-2016 Andreas Kupries
+# Copyright (c) 2018 Donal K. Fellows
+#
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+package require TclOO 1.0.3
+package require tcltest 2
+if {"::tcltest" in [namespace children]} {
+    namespace import -force ::tcltest::*
+}
+
+test ooUtil-1.1 {TIP 478: classmethod} -setup {
+    oo::class create parent
+} -body {
+    oo::class create ActiveRecord {
+	superclass parent
+        classmethod find args {
+	    return "[self] called with arguments: $args"
+	}
+    }
+    oo::class create Table {
+        superclass ActiveRecord
+    }
+    Table find foo bar
+} -cleanup {
+    parent destroy
+} -result {::Table called with arguments: foo bar}
+test ooUtil-1.2 {TIP 478: classmethod in namespace} -setup {
+    namespace eval ::testns {}
+} -body {
+    namespace eval ::testns {
+	oo::class create ActiveRecord {
+	    classmethod find args {
+		return "[self] called with arguments: $args"
+	    }
+	}
+	oo::class create Table {
+	    superclass ActiveRecord
+	}
+    }
+    testns::Table find foo bar
+} -cleanup {
+    namespace delete ::testns
+} -result {::testns::Table called with arguments: foo bar}
+test ooUtil-1.3 {TIP 478: classmethod must not interfere with constructor signatures} -setup {
+    oo::class create parent
+} -body {
+    oo::class create TestClass {
+        superclass oo::class parent
+        self method create {name ignore body} {
+            next $name $body
+        }
+    }
+    TestClass create okay {} {}
+} -cleanup {
+    parent destroy
+} -result {::okay}
+test ooUtil-1.4 {TIP 478: classmethod with several inheritance levels} -setup {
+    oo::class create parent
+} -body {
+    oo::class create ActiveRecord {
+	superclass parent
+        classmethod find args {
+	    return "[self] called with arguments: $args"
+	}
+    }
+    oo::class create Table {
+        superclass ActiveRecord
+    }
+    oo::class create SubTable {
+        superclass Table
+    }
+    SubTable find foo bar
+} -cleanup {
+    parent destroy
+} -result {::SubTable called with arguments: foo bar}
+test ooUtil-1.5 {TIP 478: classmethod and instances} -setup {
+    oo::class create parent
+} -body {
+    oo::class create ActiveRecord {
+	superclass parent
+        classmethod find args {
+	    return "[self] called with arguments: $args"
+	}
+    }
+    oo::class create Table {
+	superclass ActiveRecord
+    }
+    set t [Table new]
+    $t find 1 2 3
+} -cleanup {
+    parent destroy
+} -result {::Table called with arguments: 1 2 3}
+test ooUtil-1.6 {TIP 478: classmethod and instances} -setup {
+    oo::class create parent
+} -body {
+    oo::class create ActiveRecord {
+	superclass parent
+        classmethod find args {
+	    return "[self] called with arguments: $args"
+	}
+    }
+    oo::class create Table {
+	superclass ActiveRecord
+	unexport find
+    }
+    set t [Table new]
+    $t find 1 2 3
+} -returnCodes error -cleanup {
+    parent destroy
+} -match glob -result {unknown method "find": must be *}
+test ooUtil-1.7 {} -setup {
+    oo::class create parent
+} -body {
+    oo::class create Foo {
+	superclass parent
+        classmethod bar {} {
+            puts "This is in the class; self is [self]"
+            my meee
+        }
+        classmethod meee {} {
+            puts "This is meee"
+        }
+    }
+    oo::class create Grill {
+        superclass Foo
+        classmethod meee {} {
+            puts "This is meee 2"
+        }
+    }
+    list [Foo bar] [Grill bar] [[Foo new] bar] [[Grill new] bar]
+} -cleanup {
+    parent destroy
+} -result {{} {} {} {}} -output "This is in the class; self is ::Foo\nThis is meee\nThis is in the class; self is ::Grill\nThis is meee 2\nThis is in the class; self is ::Foo\nThis is meee\nThis is in the class; self is ::Grill\nThis is meee 2\n"
+# Two tests to confirm that we correctly initialise the scripted part of TclOO
+# in child interpreters. This is slightly tricky at the implementation level
+# because we cannot count on either [source] or [open] being available.
+test ooUtil-1.8 {TIP 478: classmethod in child interp} -setup {
+    set childinterp [interp create]
+} -body {
+    $childinterp eval {
+	oo::class create ActiveRecord {
+	    classmethod find args {
+		return "[self] called with arguments: $args"
+	    }
+	}
+	oo::class create Table {
+	    superclass ActiveRecord
+	}
+	# This is confirming that this is not the master interpreter
+	list [Table find foo bar] [info globals childinterp]
+    }
+} -cleanup {
+    interp delete $childinterp
+} -result {{::Table called with arguments: foo bar} {}}
+test ooUtil-1.9 {TIP 478: classmethod in safe child interp} -setup {
+    set safeinterp [interp create -safe]
+} -body {
+    $safeinterp eval {
+	oo::class create ActiveRecord {
+	    classmethod find args {
+		return "[self] called with arguments: $args"
+	    }
+	}
+	oo::class create Table {
+	    superclass ActiveRecord
+	}
+	# This is confirming that this is a (basic) safe interpreter
+	list [Table find foo bar] [info commands source]
+    }
+} -cleanup {
+    interp delete $safeinterp
+} -result {{::Table called with arguments: foo bar} {}}
+
+test ooUtil-2.1 {TIP 478: callback generation} -setup {
+    oo::class create parent
+} -body {
+    oo::class create c {
+	superclass parent
+	method CallMe {} { return ok,[self] }
+	method makeCall {} {
+	    return [callback CallMe]
+	}
+    }
+    c create ::context
+    set cb [context makeCall]
+    {*}$cb
+} -cleanup {
+    parent destroy
+} -result {ok,::context}
+test ooUtil-2.2 {TIP 478: callback generation} -setup {
+    oo::class create parent
+} -body {
+    oo::class create c {
+	superclass parent
+	method CallMe {a b c} { return ok,[self],$a,$b,$c }
+	method makeCall {b} {
+	    return [callback CallMe 123 $b]
+	}
+    }
+    c create ::context
+    set cb [context makeCall "a b c"]
+    {*}$cb PQR
+} -cleanup {
+    parent destroy
+} -result {ok,::context,123,a b c,PQR}
+test ooUtil-2.3 {TIP 478: callback generation, alternate name} -setup {
+    oo::class create parent
+} -body {
+    oo::class create c {
+	superclass parent
+	method CallMe {} { return ok,[self] }
+	method makeCall {} {
+	    return [mymethod CallMe]
+	}
+    }
+    c create ::context
+    set cb [context makeCall]
+    {*}$cb
+} -cleanup {
+    parent destroy
+} -result {ok,::context}
+test ooUtil-2.4 {TIP 478: callback generation, alternate name} -setup {
+    oo::class create parent
+} -body {
+    oo::class create c {
+	superclass parent
+	method CallMe {a b c} { return ok,[self],$a,$b,$c }
+	method makeCall {b} {
+	    return [mymethod CallMe 123 $b]
+	}
+    }
+    c create ::context
+    set cb [context makeCall "a b c"]
+    {*}$cb PQR
+} -cleanup {
+    parent destroy
+} -result {ok,::context,123,a b c,PQR}
+test ooUtil-2.5 {TIP 478: callbacks and method lifetime} -setup {
+    oo::class create parent
+} -body {
+    oo::class create c {
+	superclass parent
+	method makeCall {b} {
+	    return [callback CallMe 123 $b]
+	}
+    }
+    c create ::context
+    set cb [context makeCall "a b c"]
+    set result [list [catch {{*}$cb PQR} msg] $msg]
+    oo::objdefine context {
+	method CallMe {a b c} { return ok,[self],$a,$b,$c }
+    }
+    lappend result [{*}$cb PQR]
+} -cleanup {
+    parent destroy
+} -result {1 {unknown method "CallMe": must be <cloned>, destroy, eval, makeCall, unknown, variable or varname} {ok,::context,123,a b c,PQR}}
+test ooUtil-2.6 {TIP 478: callback use case} -setup {
+    oo::class create parent
+    unset -nocomplain x
+} -body {
+    oo::class create c {
+	superclass parent
+	variable count
+	constructor {var} {
+	    set count 0
+	    upvar 1 $var v
+	    trace add variable v write [callback TraceCallback]
+	}
+	method count {} {return $count}
+	method TraceCallback {name1 name2 op} {
+	    incr count
+	}
+    }
+    set o [c new x]
+    for {set x 0} {$x < 5} {incr x} {}
+    $o count
+} -cleanup {
+    unset -nocomplain x
+    parent destroy
+} -result 6
+
+test ooUtil-3.1 {TIP 478: class initialisation} -setup {
+    oo::class create parent
+    catch {rename ::foobar-3.1 {}}
+} -body {
+    oo::class create ::cls {
+	superclass parent
+	initialise {
+	    proc foobar-3.1 {} {return ok}
+	}
+	method calls {} {
+	    list [catch foobar-3.1 msg] $msg \
+		[namespace eval [info object namespace [self class]] foobar-3.1]
+	}
+    }
+    [cls new] calls
+} -cleanup {
+    parent destroy
+} -result {1 {invalid command name "foobar-3.1"} ok}
+test ooUtil-3.2 {TIP 478: class variables} -setup {
+    oo::class create parent
+    catch {rename ::foobar-3.1 {}}
+} -body {
+    oo::class create ::cls {
+	superclass parent
+	initialise {
+	    variable x 123
+	}
+	method call {} {
+	    classvariable x
+	    incr x
+	}
+    }
+    cls create a
+    cls create b
+    cls create c
+    list [a call] [b call] [c call] [a call] [b call] [c call]
+} -cleanup {
+    parent destroy
+} -result {124 125 126 127 128 129}
+test ooUtil-3.3 {TIP 478: class initialisation} -setup {
+    oo::class create parent
+    catch {rename ::foobar-3.3 {}}
+} -body {
+    oo::class create ::cls {
+	superclass parent
+	initialize {
+	    proc foobar-3.3 {} {return ok}
+	}
+	method calls {} {
+	    list [catch foobar-3.3 msg] $msg \
+		[namespace eval [info object namespace [self class]] foobar-3.3]
+	}
+    }
+    [cls new] calls
+} -cleanup {
+    parent destroy
+} -result {1 {invalid command name "foobar-3.3"} ok}
+test ooUtil-3.4 {TIP 478: class initialisation} -setup {
+    oo::class create parent
+    catch {rename ::appendToResultVar {}}
+    proc ::appendToResultVar args {
+	lappend ::result {*}$args
+    }
+    set result {}
+} -body {
+    trace add execution oo::define::initialise enter appendToResultVar
+    oo::class create ::cls {
+	superclass parent
+	initialize {proc xyzzy {} {}}
+    }
+    return $result
+} -cleanup {
+    catch {
+	trace remove execution oo::define::initialise enter appendToResultVar
+    }
+    rename ::appendToResultVar {}
+    parent destroy
+} -result {{initialize {proc xyzzy {} {}}} enter}
+test ooUtil-3.5 {TIP 478: class initialisation} -body {
+    oo::define oo::object {
+	::list [::namespace which initialise] [::namespace which initialize] \
+	     [::namespace origin initialise] [::namespace origin initialize]
+    }
+} -result {::oo::define::initialise ::oo::define::initialize ::oo::define::initialise ::oo::define::initialise}
+
+test ooUtil-4.1 {TIP 478: singleton} -setup {
+    oo::class create parent
+} -body {
+    oo::singleton create xyz {
+	superclass parent
+    }
+    set x [xyz new]
+    set y [xyz new]
+    set z [xyz new]
+    set code [catch {$x destroy} msg]
+    set p [xyz new]
+    lappend code [catch {rename $x ""}]
+    set q [xyz new]
+    string map [list $x ONE $q TWO] [list {*}$code $x $y $z $p $q [xyz new]]
+} -cleanup {
+    parent destroy
+} -result {1 0 ONE ONE ONE ONE TWO TWO}
+test ooUtil-4.2 {TIP 478: singleton errors} -setup {
+    oo::class create parent
+} -body {
+    oo::singleton create xyz {
+	superclass parent
+    }
+    [xyz new] destroy
+} -returnCodes error -cleanup {
+    parent destroy
+} -result {may not destroy a singleton object}
+test ooUtil-4.3 {TIP 478: singleton errors} -setup {
+    oo::class create parent
+} -body {
+    oo::singleton create xyz {
+	superclass parent
+    }
+    oo::copy [xyz new]
+} -returnCodes error -cleanup {
+    parent destroy
+} -result {may not clone a singleton object}
+
+
+test ooUtil-5.1 {TIP 478: abstract} -setup {
+    oo::class create parent
+} -body {
+    oo::abstract create xyz {
+	superclass parent
+	method foo {} {return 123}
+    }
+    oo::class create pqr {
+	superclass xyz
+	method bar {} {return 456}
+    }
+    set codes [list [catch {xyz new}] [catch {xyz create x}] [catch {xyz createWithNamespace x y}]]
+    set x [pqr new]
+    set y [pqr create ::y]
+    lappend codes [$x foo] [$x bar] $y
+} -cleanup {
+    parent destroy
+} -result {1 1 1 123 456 ::y}
+
+test ooUtil-6.1 {TIP 478: classvarable} -setup {
+    oo::class create parent
+} -body {
+    oo::class create xyz {
+	superclass parent
+	initialise {
+	    variable x 1 y 2
+	}
+	method a {} {
+	    classvariable x
+	    incr x
+	}
+	method b {} {
+	    classvariable y
+	    incr y
+	}
+	method c {} {
+	    classvariable x y
+	    list $x $y
+	}
+    }
+    set p [xyz new]
+    set q [xyz new]
+    set result [list [$p c] [$q c]]
+    $p a
+    $q b
+    lappend result [[xyz new] c]
+} -cleanup {
+    parent destroy
+} -result {{1 2} {1 2} {2 3}}
+test ooUtil-6.2 {TIP 478: classvarable error case} -setup {
+    oo::class create parent
+} -body {
+    oo::class create xyz {
+	superclass parent
+	method a {} {
+	    classvariable x(1)
+	    incr x(1)
+	}
+    }
+    set p [xyz new]
+    set q [xyz new]
+    list [$p a] [$q a]
+} -returnCodes error -cleanup {
+    parent destroy
+} -result {bad variable name "x(1)": can't create a scalar variable that looks like an array element}
+test ooUtil-6.3 {TIP 478: classvarable error case} -setup {
+    oo::class create parent
+} -body {
+    oo::class create xyz {
+	superclass parent
+	method a {} {
+	    classvariable ::x
+	    incr x
+	}
+    }
+    set p [xyz new]
+    set q [xyz new]
+    list [$p a] [$q a]
+} -returnCodes error -cleanup {
+    parent destroy
+} -result {bad variable name "::x": can't create a local variable with a namespace separator in it}
+
+test ooUtil-7.1 {TIP 478: link calling pattern} -setup {
+    oo::class create parent
+} -body {
+    oo::class create cls {
+	superclass parent
+	method foo {} {return "in foo of [self]"}
+	method Bar {} {return "in bar of [self]"}
+	method Grill {} {return "in grill of [self]"}
+	export eval
+	constructor {} {
+	    link foo
+	    link {bar Bar} {grill Grill}
+	}
+    }
+    cls create o
+    o eval {list [foo] [bar] [grill]}
+} -cleanup {
+    parent destroy
+} -result {{in foo of ::o} {in bar of ::o} {in grill of ::o}}
+test ooUtil-7.2 {TIP 478: link removed when [my] disappears} -setup {
+    oo::class create parent
+} -body {
+    oo::class create cls {
+	superclass parent
+	method foo {} {return "in foo of [self]"}
+	constructor {cmd} {
+	    link [list ::$cmd foo]
+	}
+    }
+    cls create o pqr
+    list [o foo] [pqr] [rename [info object namespace o]::my {}] [catch pqr msg] $msg
+} -cleanup {
+    parent destroy
+} -result {{in foo of ::o} {in foo of ::o} {} 1 {invalid command name "pqr"}}
+
+# Tests that verify issues detected with the tcllib version of the code
+test ooUtil-tcllib-ticket-b3577ed586 {test scoping of delegation in oo::class.Delegate } -setup {
+    oo::class create animal {}
+    namespace eval ::ooutiltest {
+	oo::class create pet { superclass animal }
+    }
+} -body {
+    namespace eval ::ooutiltest {
+	oo::class create dog { superclass pet }
+    }
+} -cleanup {
+    namespace delete ooutiltest
+    rename animal {}
+} -result {::ooutiltest::dog}
+test ooUtil-tcllib-ticket-fe7a0e0a3a {classmethod must not interfere with constructor signatures} -setup {
+    oo::class create TestClass {
+        superclass oo::class
+        self method create {name ignore body} {
+            next $name $body
+        }
+    }
+} -body {
+    TestClass create okay {} {}
+} -cleanup {
+    rename TestClass {}
+} -result {::okay}
+
+cleanupTests
+return
+
+# Local Variables:
+# fill-column: 78
+# mode: tcl
+# End:
diff --git a/tests/package.test b/tests/package.test
index 2843701..2dca06b 100644
--- a/tests/package.test
+++ b/tests/package.test
@@ -23,7 +23,7 @@ catch [list package require -exact Tcltest [info patchlevel]]
 # Do all this in a slave interp to avoid garbaging the package list
 set i [interp create]
 tcltest::loadIntoSlaveInterpreter $i {*}$argv
-load {} Tcltest $i
+catch [list load {} Tcltest $i]
 interp eval $i {
 namespace import -force ::tcltest::*
 #package forget {*}[package names]
@@ -630,13 +630,13 @@ test package-3.54 {Tcl_PkgRequire procedure, coroutine support} -setup {
 } -body {
     coroutine coro1 apply {{} {
 	package ifneeded t 2.1 {
-	    yield 
+	    yield
 	    package provide t 2.1
 	}
 	package require t 2.1
     }}
     list [catch {coro1} msg] $msg
-} -match glob -result {0 2.1} 
+} -match glob -result {0 2.1}
 
 
 test package-4.1 {Tcl_PackageCmd procedure} -returnCodes error -body {
diff --git a/tests/pkgIndex.tcl b/tests/pkgIndex.tcl
new file mode 100644
index 0000000..854b943
--- /dev/null
+++ b/tests/pkgIndex.tcl
@@ -0,0 +1,6 @@
+#! /usr/bin/env tclsh
+
+package ifneeded tcltests 0.1 "
+    source [list $dir/tcltests.tcl]
+    package provide tcltests 0.1
+"
diff --git a/tests/platform.test b/tests/platform.test
index 8a68351..53d534e 100644
--- a/tests/platform.test
+++ b/tests/platform.test
@@ -22,8 +22,10 @@ namespace eval ::tcl::test::platform {
 
 ::tcltest::loadTestedCommands
 catch [list package require -exact Tcltest [info patchlevel]]
+package require tcltests
 
 testConstraint testCPUID [llength [info commands testcpuid]]
+testConstraint testlongsize [llength [info commands testlongsize]]
 
 test platform-1.0 {tcl_platform(engine)} {
   set tcl_platform(engine)
@@ -38,16 +40,9 @@ test platform-1.1 {TclpSetVariables: tcl_platform} {
     set result
 } {byteOrder engine machine os osVersion pathSeparator platform pointerSize user wordSize}
 
-# Test assumes twos-complement arithmetic, which is true of virtually
-# everything these days.  Note that this does *not* use wide(), and
-# this is intentional since that could make Tcl's numbers wider than
-# the machine-integer on some platforms...
-test platform-2.1 {tcl_platform(wordSize) indicates size of native word} {
-    set result [expr {int(1 << (8 * $tcl_platform(wordSize) - 1))}]
-    # Result must be the largest bit in a machine word, which this checks
-    # without assuming how wide the word really is
-    list [expr {$result < 0}] [expr {$result ^ int($result - 1)}]
-} {1 -1}
+test platform-2.1 {tcl_platform(wordSize) indicates size of native word} testlongsize {
+    expr {$tcl_platform(wordSize) == [testlongsize]}
+} {1}
 
 # On Windows/UNIX, test that the CPU ID works
 
@@ -67,7 +62,10 @@ test platform-3.1 {CPU ID on Windows/UNIX} \
 # format of string it produces consists of two non-empty words separated by a
 # hyphen.
 package require platform
-test platform-4.1 {format of platform::identify result} -match regexp -body {
+test platform-4.1 {format of platform::identify result} -constraints notValgrind -match regexp -body {
+    # [identify] may attempt to [exec] dpkg-architecture, which may not exist,
+    # in which case fork will not be followed by exec, and valgrind will issue
+    # "still reachable" reports.
     platform::identify
 } -result {^([^-]+-)+[^-]+$}
 test platform-4.2 {format of platform::generic result} -match regexp -body {
diff --git a/tests/proc.test b/tests/proc.test
index bae5e15..1893d0f 100644
--- a/tests/proc.test
+++ b/tests/proc.test
@@ -110,6 +110,14 @@ test proc-1.8 {Tcl_ProcObjCmd, check that formal parameter names are simple name
     proc p {b:a b::a} {
     }
 } -returnCodes error -result {formal parameter "b::a" is not a simple name}
+test proc-1.9 {Tcl_ProcObjCmd, arguments via canonical list (string-representation bug [631b4c45df])} -body {
+    set v 2
+    binary scan AB cc a b
+    proc p [list [list a $a] [list b $b] [list v [expr {$v + 2}]]] {expr {$a + $b + $v}}
+    p
+} -result [expr {65+66+4}] -cleanup {
+   rename p {}
+}
 
 test proc-2.1 {TclFindProc, simple proc name and proc not in namespace} -setup {
     catch {namespace delete {*}[namespace children :: test_ns_*]}
@@ -383,6 +391,14 @@ test proc-7.4 {Proc struct outlives its interp: Bug 3532959} {
     interp delete slave
     unset lambda
 } {}
+
+test proc-7.5 {[631b4c45df] Crash in argument processing} {
+    binary scan A c val
+    proc foo [list  [list from $val]] {}
+    rename foo {}
+    unset -nocomplain val
+} {}
+
 
 # cleanup
 catch {rename p ""}
diff --git a/tests/process.test b/tests/process.test
index b88c50a..5aa8354 100644
--- a/tests/process.test
+++ b/tests/process.test
@@ -63,7 +63,7 @@ test process-4.1 {exec one child} -body {
     set statuses [tcl::process status -wait]
     set status [lindex [tcl::process status $pid] 1]
     expr {
-           [llength $list] eq 1 
+           [llength $list] eq 1
         && [lindex $list 0] eq $pid
         && [dict size $statuses] eq 1
         && [dict get $statuses $pid] eq $status
@@ -139,7 +139,7 @@ test process-5.1 {exec one child} -body {
     set statuses [tcl::process status -wait]
     set status [lindex [tcl::process status $pid] 1]
     expr {
-           [llength $list] eq 1 
+           [llength $list] eq 1
         && [lindex $list 0] eq $pid
         && [dict size $statuses] eq 1
         && [dict get $statuses $pid] eq $status
diff --git a/tests/scan.test b/tests/scan.test
index 1f32b9f..5c38fff 100644
--- a/tests/scan.test
+++ b/tests/scan.test
@@ -85,8 +85,7 @@ proc testIEEE {} {
 }
 
 testConstraint ieeeFloatingPoint [testIEEE]
-testConstraint wideIs64bit \
-	[expr {(wide(0x80000000) > 0) && (wide(0x8000000000000000) < 0)}]
+testConstraint wideIs64bit [expr {wide(0x8000000000000000) < 0}]
 
 test scan-1.1 {BuildCharSet, CharInSet} {
     list [scan foo {%[^o]} x] $x
diff --git a/tests/set-old.test b/tests/set-old.test
index b2e7aa6..ea5155b 100644
--- a/tests/set-old.test
+++ b/tests/set-old.test
@@ -340,7 +340,7 @@ test set-old-8.6 {array command} {
     catch {unset a}
     set a(22) 3
     list [catch {array gorp a} msg] $msg
-} {1 {unknown or ambiguous subcommand "gorp": must be anymore, donesearch, exists, for, get, names, nextelement, set, size, startsearch, statistics, or unset}}
+} {1 {unknown or ambiguous subcommand "gorp": must be anymore, default, donesearch, exists, for, get, names, nextelement, set, size, startsearch, statistics, or unset}}
 test set-old-8.7 {array command, anymore option} {
     catch {unset a}
     list [catch {array anymore a x} msg] $msg
@@ -700,7 +700,7 @@ test set-old-9.1 {ids for array enumeration} {
     catch {unset a}
     set a(a) 1
     list [array star a] [array star a] [array done a s-1-a; array star a] \
-	    [array done a s-2-a; array d a s-3-a; array start a]
+	    [array done a s-2-a; array do a s-3-a; array start a]
 } {s-1-a s-2-a s-3-a s-1-a}
 test set-old-9.2 {array enumeration} {
     catch {unset a}
diff --git a/tests/string.test b/tests/string.test
index 0cbafae..d169193 100644
--- a/tests/string.test
+++ b/tests/string.test
@@ -280,7 +280,7 @@ test string-3.17.$noComp {string equal, unicode} {
 } 1
 test string-3.18.$noComp {string equal, unicode} {
     run {string equal \334 \u00fc}
-} 0 
+} 0
 test string-3.19.$noComp {string equal, unicode} {
     run {string equal \334\334\334\374\374 \334\334\334\334\334}
 } 0
@@ -307,7 +307,7 @@ test string-3.24.$noComp {string equal -nocase with length} {
 } 1
 test string-3.25.$noComp {string equal -nocase with length} {
     run {string equal -nocase -length 3 abcde Abxyz}
-} 0 
+} 0
 test string-3.26.$noComp {string equal -nocase with length <= 0} {
     run {string equal -nocase -length -1 abcde AbCdEf}
 } 0
@@ -2306,6 +2306,12 @@ test string-29.15.$noComp {string cat, efficiency} -setup {
     tcl::unsupported::representation [run {string cat $e $f $e $f [list x]}]
 } -match glob -result {*no string representation}
 }
+test string-30.1.1.$noComp {[Bug ba921a8d98]: string cat} {
+    run {string cat [set data [binary format a* hello]] [encoding convertto $data] [unset data]}
+} hellohello
+test string-30.1.2.$noComp {[Bug ba921a8d98]: inplace cat by subst (compiled to "strcat" instruction)} {
+    run {set x "[set data [binary format a* hello]][encoding convertto $data][unset data]"}
+} hellohello
 
 }
 
diff --git a/tests/tailcall.test b/tests/tailcall.test
index ce506a7..9174167 100644
--- a/tests/tailcall.test
+++ b/tests/tailcall.test
@@ -688,6 +688,26 @@ if {[testConstraint testnrelevels]} {
     namespace delete testnre
 }
 
+test tailcall-14.1 {in a deleted namespace} -body {
+    namespace eval ns {
+	proc p args {
+	    tailcall [namespace current] $args
+	}
+	namespace delete [namespace current]
+	p
+    }
+} -returnCodes 1 -result {namespace "::ns" not found}
+
+test tailcall-14.1-bc {{in a deleted namespace} {byte compiled}} -body {
+    namespace eval ns {
+	proc p args {
+	    tailcall [namespace current] {*}$args
+	}
+	namespace delete [namespace current]
+	p
+    }
+} -returnCodes 1 -result {namespace "::ns" not found}
+
 # cleanup
 ::tcltest::cleanupTests
 
diff --git a/tests/tcltest.test b/tests/tcltest.test
index 17fa926..544027a 100644
--- a/tests/tcltest.test
+++ b/tests/tcltest.test
@@ -312,7 +312,7 @@ test tcltest-5.5 {InitConstraints: list of built-in constraints} \
 	-result [lsort {
     95 98 asyncPipeClose eformat emptyTest exec hasIsoLocale interactive
     knownBug mac macCrash macOnly macOrPc macOrUnix macOrWin nonBlockFiles
-    nonPortable notRoot nt pc pcCrash pcOnly root singleTestInterp socket
+    nonPortable notRoot nt pc pcCrash pcOnly root singleTestInterp slowTest socket
     stdio tempNotMac tempNotPc tempNotUnix tempNotWin unix unixCrash unixExecs
     unixOnly unixOrPc unixOrWin userInteraction win winCrash winOnly
 }]
@@ -908,7 +908,9 @@ removeFile load.tcl
 
 # [interpreter]
 test tcltest-13.1 {interpreter} {
+    -constraints notValgrind
     -setup {
+	#to do:  Why is $::tcltest::tcltest being saved and restored here?
 	set old $::tcltest::tcltest
 	set ::tcltest::tcltest tcltest
     }
@@ -920,6 +922,11 @@ test tcltest-13.1 {interpreter} {
     }
     -result {tcltest tclsh tclsh}
     -cleanup {
+	# writing ::tcltest::tcltest triggers a trace that sets up the stdio
+	# constraint, which involves a call to [exec] that might fail after
+	# "fork" and before "exec", in which case the forked process will not
+	# have a chance to clean itself up before exiting, which causes
+	# valgrind to issue numerous "still reachable" reports.
 	set ::tcltest::tcltest $old
     }
 }
diff --git a/tests/tcltests.tcl b/tests/tcltests.tcl
new file mode 100644
index 0000000..74d1b40
--- /dev/null
+++ b/tests/tcltests.tcl
@@ -0,0 +1,11 @@
+#! /usr/bin/env tclsh
+
+package require tcltest 2.2
+namespace import ::tcltest::*
+
+testConstraint exec          [llength [info commands exec]]
+testConstraint fcopy         [llength [info commands fcopy]]
+testConstraint fileevent     [llength [info commands fileevent]]
+testConstraint thread        [
+    expr {0 == [catch {package require Thread 2.7-}]}]
+testConstraint notValgrind   [expr {![testConstraint valgrind]}]
diff --git a/tests/thread.test b/tests/thread.test
index cc4c871..2524911 100644
--- a/tests/thread.test
+++ b/tests/thread.test
@@ -11,25 +11,22 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 
-if {[lsearch [namespace children] ::tcltest] == -1} {
-    package require tcltest 2.2
+if {"::tcltest" ni [namespace children]} {
+    package require tcltest 2
     namespace import -force ::tcltest::*
 }
 
+#  when thread::release is used, -wait is passed in order allow the thread to
+#  be fully finalized, which avoids valgrind "still reachable" reports.
+
 ::tcltest::loadTestedCommands
 catch [list package require -exact Tcltest [info patchlevel]]
+package require tcltests
 
 # Some tests require the testthread command
 
-testConstraint testthread [expr {[info commands testthread] != {}}]
-
-# Some tests require the Thread package
-
-testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]
+testConstraint testthread [expr {[info commands testthread] ne {}}]
 
-# Some tests may not work under valgrind
-
-testConstraint notValgrind [expr {![testConstraint valgrind]}]
 
 set threadSuperKillScript {
     rename catch ""
@@ -72,6 +69,17 @@ proc ThreadError {id info} {
     set threadSawError($id) true; # signal main thread to exit [vwait].
 }
 
+proc threadSuperKill id {
+    variable threadSuperKillScript
+    try {
+	thread::send $id $::threadSuperKillScript
+    } on error {tres topts} {
+	if {$tres ne {target thread died}} {
+	    return -options $topts $tres
+	}
+    }
+}
+
 if {[testConstraint thread]} {
     thread::errorproc ThreadError
 }
@@ -96,22 +104,22 @@ test thread-1.3 {Tcl_ThreadObjCmd: initial thread list} {thread} {
 test thread-1.4 {Tcl_ThreadObjCmd: thread create } {thread} {
     set serverthread [thread::create -preserved]
     set numthreads [llength [thread::names]]
-    thread::release $serverthread
+    thread::release -wait $serverthread
     set numthreads
-} {2}
+} 2
 test thread-1.5 {Tcl_ThreadObjCmd: thread create one shot} {thread} {
     thread::create {set x 5}
     foreach try {0 1 2 4 5 6} {
-	# Try various ways to yield
-	update
-	after 10
-	set l [llength [thread::names]]
-	if {$l == 1} {
-	    break
-	}
+        # Try various ways to yield
+        update
+        after 10
+        set l [llength [thread::names]]
+        if {$l == 1} {
+            break
+        }
     }
     set l
-} {1}
+} 1
 test thread-1.6 {Tcl_ThreadObjCmd: thread exit} {thread} {
     thread::create {{*}{}}
     update
@@ -121,13 +129,13 @@ test thread-1.6 {Tcl_ThreadObjCmd: thread exit} {thread} {
 test thread-1.13 {Tcl_ThreadObjCmd: send args} {thread} {
     set serverthread [thread::create -preserved]
     set five [thread::send $serverthread {set x 5}]
-    thread::release $serverthread
+    thread::release -wait $serverthread
     set five
 } 5
 test thread-1.15 {Tcl_ThreadObjCmd: wait} {thread} {
     set serverthread [thread::create -preserved {set z 5 ; thread::wait}]
     set five [thread::send $serverthread {set z}]
-    thread::release $serverthread
+    thread::release -wait $serverthread
     set five
 } 5
 
@@ -159,7 +167,7 @@ test thread-3.1 {TclThreadList} {thread} {
     set l2 [thread::names]
     set c [string compare [lsort [concat [thread::id] $l1]] [lsort $l2]]
     foreach t $l1 {
-	thread::release $t
+	thread::release -wait $t
     }
     list $len $c
 } {1 0}
@@ -887,7 +895,7 @@ test thread-7.24 {cancel: nested catch inside pure bytecode loop} {thread drainE
     # wait for other thread to signal "ready to cancel"
     vwait ::threadIdStarted; after 1000
     set res [thread::cancel $serverthread]
-    thread::send $serverthread $::threadSuperKillScript
+    threadSuperKill $serverthread
     vwait ::threadSawError($serverthread)
     thread::join $serverthread; drainEventQueue
     list $res [expr {[info exists ::threadIdStarted] ? \
@@ -929,7 +937,7 @@ test thread-7.25 {cancel: nested catch inside pure inside-command loop} {thread
     # wait for other thread to signal "ready to cancel"
     vwait ::threadIdStarted; after 1000
     set res [thread::cancel $serverthread]
-    thread::send $serverthread $::threadSuperKillScript
+    threadSuperKill $serverthread
     vwait ::threadSawError($serverthread)
     thread::join $serverthread; drainEventQueue
     list $res [expr {[info exists ::threadIdStarted] ? \
@@ -1029,7 +1037,7 @@ test thread-7.28 {cancel: send async cancel nested catch inside pure bytecode lo
     # wait for other thread to signal "ready to cancel"
     vwait ::threadIdStarted; after 1000
     set res [thread::send -async $serverthread {interp cancel}]
-    thread::send $serverthread $::threadSuperKillScript
+    threadSuperKill $serverthread
     vwait ::threadSawError($serverthread)
     thread::join $serverthread; drainEventQueue
     list $res [expr {[info exists ::threadIdStarted] ? \
@@ -1071,7 +1079,7 @@ test thread-7.29 {cancel: send async cancel nested catch pure inside-command loo
     # wait for other thread to signal "ready to cancel"
     vwait ::threadIdStarted; after 1000
     set res [thread::send -async $serverthread {interp cancel}]
-    thread::send $serverthread $::threadSuperKillScript
+    threadSuperKill $serverthread
     vwait ::threadSawError($serverthread)
     thread::join $serverthread; drainEventQueue
     list $res [expr {[info exists ::threadIdStarted] ? \
@@ -1111,7 +1119,7 @@ test thread-7.30 {cancel: send async thread cancel nested catch inside pure byte
     # wait for other thread to signal "ready to cancel"
     vwait ::threadIdStarted; after 1000
     set res [thread::send -async $serverthread {thread::cancel [thread::id]}]
-    thread::send $serverthread $::threadSuperKillScript
+    threadSuperKill $serverthread
     vwait ::threadSawError($serverthread)
     thread::join $serverthread; drainEventQueue
     list $res [expr {[info exists ::threadIdStarted] ? \
@@ -1153,7 +1161,7 @@ test thread-7.31 {cancel: send async thread cancel nested catch pure inside-comm
     # wait for other thread to signal "ready to cancel"
     vwait ::threadIdStarted; after 1000
     set res [thread::send -async $serverthread {thread::cancel [thread::id]}]
-    thread::send $serverthread $::threadSuperKillScript
+    threadSuperKill $serverthread
     vwait ::threadSawError($serverthread)
     thread::join $serverthread; drainEventQueue
     list $res [expr {[info exists ::threadIdStarted] ? \
diff --git a/tests/uplevel.test b/tests/uplevel.test
index 737c571..be2268a 100644
--- a/tests/uplevel.test
+++ b/tests/uplevel.test
@@ -137,27 +137,27 @@ test uplevel-4.15 {level parsing} {
 test uplevel-4.16 {level parsing} {
     apply {{} {uplevel #[expr 1] {}}}
 } {}
-test uplevel-4.17 {level parsing} {
+test uplevel-4.17 {level parsing} -returnCodes error -body {
     apply {{} {uplevel -0xffffffff {}}}
-} {}
-test uplevel-4.18 {level parsing} {
+} -result {bad level "-0xffffffff"}
+test uplevel-4.18 {level parsing} -returnCodes error -body {
     apply {{} {uplevel #-0xffffffff {}}}
-} {}
-test uplevel-4.19 {level parsing} {
+} -result {bad level "#-0xffffffff"}
+test uplevel-4.19 {level parsing} -returnCodes error -body {
     apply {{} {uplevel [expr -0xffffffff] {}}}
-} {}
-test uplevel-4.20 {level parsing} {
+} -result {bad level "-4294967295"}
+test uplevel-4.20 {level parsing} -returnCodes error -body {
     apply {{} {uplevel #[expr -0xffffffff] {}}}
-} {}
+} -result {bad level "#-4294967295"}
 test uplevel-4.21 {level parsing} -body {
     apply {{} {uplevel -1 {}}}
-} -returnCodes error -result {invalid command name "-1"}
+} -returnCodes error -result {bad level "-1"}
 test uplevel-4.22 {level parsing} -body {
     apply {{} {uplevel #-1 {}}}
 } -returnCodes error -result {bad level "#-1"}
 test uplevel-4.23 {level parsing} -body {
     apply {{} {uplevel [expr -1] {}}}
-} -returnCodes error -result {invalid command name "-1"}
+} -returnCodes error -result {bad level "-1"}
 test uplevel-4.24 {level parsing} -body {
     apply {{} {uplevel #[expr -1] {}}}
 } -returnCodes error -result {bad level "#-1"}
@@ -175,13 +175,13 @@ test uplevel-4.28 {level parsing} -body {
 } -returnCodes error -result {bad level "#4294967295"}
 test uplevel-4.29 {level parsing} -body {
     apply {{} {uplevel 0.2 {}}}
-} -returnCodes error -result {bad level "0.2"}
+} -returnCodes error -result {invalid command name "0.2"}
 test uplevel-4.30 {level parsing} -body {
     apply {{} {uplevel #0.2 {}}}
 } -returnCodes error -result {bad level "#0.2"}
 test uplevel-4.31 {level parsing} -body {
     apply {{} {uplevel [expr 0.2] {}}}
-} -returnCodes error -result {bad level "0.2"}
+} -returnCodes error -result {invalid command name "0.2"}
 test uplevel-4.32 {level parsing} -body {
     apply {{} {uplevel #[expr 0.2] {}}}
 } -returnCodes error -result {bad level "#0.2"}
@@ -193,7 +193,7 @@ test uplevel-4.34 {level parsing} -body {
 } -returnCodes error -result {bad level "#.2"}
 test uplevel-4.35 {level parsing} -body {
     apply {{} {uplevel [expr .2] {}}}
-} -returnCodes error -result {bad level "0.2"}
+} -returnCodes error -result {invalid command name "0.2"}
 test uplevel-4.36 {level parsing} -body {
     apply {{} {uplevel #[expr .2] {}}}
 } -returnCodes error -result {bad level "#0.2"}
diff --git a/tests/utf.test b/tests/utf.test
index 9dd8017..e820359 100644
--- a/tests/utf.test
+++ b/tests/utf.test
@@ -44,6 +44,18 @@ test utf-1.6 {Tcl_UniCharToUtf: negative Tcl_UniChar} testbytestring {
 test utf-1.7 {Tcl_UniCharToUtf: 4 byte sequences} -constraints testbytestring -body {
     expr {"\U014e4e" eq [testbytestring "\xf0\x94\xb9\x8e"]}
 } -result 1
+test utf-1.8 {Tcl_UniCharToUtf: 3 byte sequence, upper surrogate} testbytestring {
+    expr {"\ud842" eq [testbytestring "\xed\xa1\x82"]}
+} 1
+test utf-1.9 {Tcl_UniCharToUtf: 3 byte sequence, lower surrogate} testbytestring {
+    expr {"\udc42" eq [testbytestring "\xed\xb1\x82"]}
+} 1
+test utf-1.10 {Tcl_UniCharToUtf: 3 byte sequence, upper surrogate} testbytestring {
+    expr {[format %c 0xd842] eq [testbytestring "\xed\xa1\x82"]}
+} 1
+test utf-1.11 {Tcl_UniCharToUtf: 3 byte sequence, lower surrogate} testbytestring {
+    expr {[format %c 0xdc42] eq [testbytestring "\xed\xb1\x82"]}
+} 1
 
 test utf-2.1 {Tcl_UtfToUniChar: low ascii} {
     string length "abc"
@@ -146,6 +158,12 @@ test utf-8.3 {Tcl_UniCharAtIndex: index > 0} {
 test utf-8.4 {Tcl_UniCharAtIndex: index > 0} {
     string index \u4e4e\u25a\xff\u543 2
 } "\uff"
+test utf-8.5 {Tcl_UniCharAtIndex: upper surrogate} {
+    string index \ud842 0
+} "\ud842"
+test utf-8.5 {Tcl_UniCharAtIndex: lower surrogate} {
+    string index \udc42 0
+} "\udc42"
 
 test utf-9.1 {Tcl_UtfAtIndex: index = 0} {
     string range abcd 0 2
@@ -251,6 +269,9 @@ test utf-11.4 {Tcl_UtfToUpper} {
 test utf-11.5 {Tcl_UtfToUpper Georgian (new in Unicode 11)} {
     string toupper \u10d0\u1c90
 } \u1c90\u1c90
+test utf-11.6 {Tcl_UtfToUpper low/high surrogate)} {
+    string toupper \udc24\ud824
+} \udc24\ud824
 
 test utf-12.1 {Tcl_UtfToLower} {
     string tolower {}
@@ -267,6 +288,9 @@ test utf-12.4 {Tcl_UtfToLower} {
 test utf-12.5 {Tcl_UtfToLower Georgian (new in Unicode 11)} {
     string tolower \u10d0\u1c90
 } \u10d0\u10d0
+test utf-12.6 {Tcl_UtfToUpper low/high surrogate)} {
+    string tolower \udc24\ud824
+} \udc24\ud824
 
 test utf-13.1 {Tcl_UtfToTitle} {
     string totitle {}
@@ -286,6 +310,9 @@ test utf-13.5 {Tcl_UtfToTitle Georgian (new in Unicode 11)} {
 test utf-13.6 {Tcl_UtfToTitle Georgian (new in Unicode 11)} {
     string totitle \u1c90\u10d0
 } \u1c90\u10d0
+test utf-13.7 {Tcl_UtfToTitle low/high surrogate)} {
+    string totitle \udc24\ud824
+} \udc24\ud824
 
 test utf-14.1 {Tcl_UtfNcasecmp} {
     string compare -nocase a b
diff --git a/tests/var.test b/tests/var.test
index 7b7fc25..36beb3a 100644
--- a/tests/var.test
+++ b/tests/var.test
@@ -1046,7 +1046,7 @@ test var-22.2 {leak in parsedVarName} -constraints memory -body {
 } -cleanup {
     unset -nocomplain i x
 } -result 0
-
+
 unset -nocomplain a k v
 test var-23.1 {array command, for loop, too many args} -returnCodes error -body {
     array for {k v} c d e {}
@@ -1202,6 +1202,261 @@ test var-23.14 {array for, shared arguments} -setup {
 } -cleanup {
     unset -nocomplain $vn vn
 } -result {}
+
+test var-24.1 {array default set and get: interpreted} -setup {
+    unset -nocomplain ary
+} -body {
+    array set ary {a 3}
+    array default set ary 7
+    list $ary(a) $ary(b) [info exist ary(a)] [info exist ary(b)] \
+	[array default get ary]
+} -cleanup {
+    unset -nocomplain ary
+} -result {3 7 1 0 7}
+test var-24.2 {array default set and get: compiled} {
+    apply {{} {
+	array set ary {a 3}
+	array default set ary 7
+	list $ary(a) $ary(b) [info exist ary(a)] [info exist ary(b)] \
+	    [array default get ary]
+    }}
+} {3 7 1 0 7}
+test var-24.3 {array default unset: interpreted} -setup {
+    unset -nocomplain ary
+} -body {
+    array set ary {a 3}
+    array default set ary 7
+    list $ary(a) $ary(b) [array default unset ary] $ary(a) [catch {set ary(b)}]
+} -cleanup {
+    unset -nocomplain ary
+} -result {3 7 {} 3 1}
+test var-24.4 {array default unset: compiled} {
+    apply {{} {
+	array set ary {a 3}
+	array default set ary 7
+	list $ary(a) $ary(b) [array default unset ary] $ary(a) \
+	    [catch {set ary(b)}]
+    }}
+} {3 7 {} 3 1}
+test var-24.5 {array default exists: interpreted} -setup {
+    unset -nocomplain ary result
+    set result {}
+} -body {
+    array set ary {a 3}
+    lappend result [info exists ary],[array exists ary],[array default exists ary]
+    array default set ary 7
+    lappend result [info exists ary],[array exists ary],[array default exists ary]
+    array default unset ary
+    lappend result [info exists ary],[array exists ary],[array default exists ary]
+    unset ary
+    lappend result [info exists ary],[array exists ary],[array default exists ary]
+    array default set ary 11
+    lappend result [info exists ary],[array exists ary],[array default exists ary]
+} -cleanup {
+    unset -nocomplain ary result
+} -result {1,1,0 1,1,1 1,1,0 0,0,0 1,1,1}
+test var-24.6 {array default exists: compiled} {
+    apply {{} {
+	array set ary {a 3}
+	lappend result [info exists ary],[array exists ary],[array default exists ary]
+	array default set ary 7
+	lappend result [info exists ary],[array exists ary],[array default exists ary]
+	array default unset ary
+	lappend result [info exists ary],[array exists ary],[array default exists ary]
+	unset ary
+	lappend result [info exists ary],[array exists ary],[array default exists ary]
+	array default set ary 11
+	lappend result [info exists ary],[array exists ary],[array default exists ary]
+    }}
+} {1,1,0 1,1,1 1,1,0 0,0,0 1,1,1}
+test var-24.7 {array default and append: interpreted} -setup {
+    unset -nocomplain ary result
+    set result {}
+} -body {
+    array default set ary grill
+    lappend result [array size ary] [info exist ary(x)]
+    append ary(x) abc
+    lappend result [array size ary] $ary(x)
+    array default unset ary
+    append ary(x) def
+    append ary(y) ghi
+    lappend result [array size ary] $ary(x) $ary(y)
+} -cleanup {
+    unset -nocomplain ary result
+} -result {0 0 1 grillabc 2 grillabcdef ghi}
+test var-24.8 {array default and append: compiled} {
+    apply {{} {
+	array default set ary grill
+	lappend result [array size ary] [info exist ary(x)]
+	append ary(x) abc
+	lappend result [array size ary] $ary(x)
+	array default unset ary
+	append ary(x) def
+	append ary(y) ghi
+	lappend result [array size ary] $ary(x) $ary(y)
+    }}
+} {0 0 1 grillabc 2 grillabcdef ghi}
+test var-24.9 {array default and lappend: interpreted} -setup {
+    unset -nocomplain ary result
+    set result {}
+} -body {
+    array default set ary grill
+    lappend result [array size ary] [info exist ary(x)]
+    lappend ary(x) abc
+    lappend result [array size ary] $ary(x)
+    array default unset ary
+    lappend ary(x) def
+    lappend ary(y) ghi
+    lappend result [array size ary] $ary(x) $ary(y)
+} -cleanup {
+    unset -nocomplain ary result
+} -result {0 0 1 {grill abc} 2 {grill abc def} ghi}
+test var-24.10 {array default and lappend: compiled} {
+    apply {{} {
+	array default set ary grill
+	lappend result [array size ary] [info exist ary(x)]
+	lappend ary(x) abc
+	lappend result [array size ary] $ary(x)
+	array default unset ary
+	lappend ary(x) def
+	lappend ary(y) ghi
+	lappend result [array size ary] $ary(x) $ary(y)
+    }}
+} {0 0 1 {grill abc} 2 {grill abc def} ghi}
+test var-24.11 {array default and incr: interpreted} -setup {
+    unset -nocomplain ary result
+    set result {}
+} -body {
+    array default set ary 7
+    lappend result [array size ary] [info exist ary(x)]
+    incr ary(x) 11
+    lappend result [array size ary] $ary(x)
+    array default unset ary
+    incr ary(x)
+    incr ary(y)
+    lappend result [array size ary] $ary(x) $ary(y)
+} -cleanup {
+    unset -nocomplain ary result
+} -result {0 0 1 18 2 19 1}
+test var-24.12 {array default and incr: compiled} {
+    apply {{} {
+	array default set ary 7
+	lappend result [array size ary] [info exist ary(x)]
+	incr ary(x) 11
+	lappend result [array size ary] $ary(x)
+	array default unset ary
+	incr ary(x)
+	incr ary(y)
+	lappend result [array size ary] $ary(x) $ary(y)
+    }}
+} {0 0 1 18 2 19 1}
+test var-24.13 {array default and dict: interpreted} -setup {
+    unset -nocomplain ary x y z
+} -body {
+    array default set ary {x y}
+    dict lappend ary(p) x z
+    dict update ary(q) x y {
+	set y z
+    }
+    dict with ary(r) {
+	set x 123
+    }
+    lsort -stride 2 -index 0 [array get ary]
+} -cleanup {
+    unset -nocomplain ary x y z
+} -result {p {x {y z}} q {x z} r {x 123}}
+test var-24.14 {array default and dict: compiled} {
+    lsort -stride 2 -index 0 [apply {{} {
+	array default set ary {x y}
+	dict lappend ary(p) x z
+	dict update ary(q) x y {
+	    set y z
+	}
+	dict with ary(r) {
+	    set x 123
+	}
+	array get ary
+    }}]
+} {p {x {y z}} q {x z} r {x 123}}
+test var-24.15 {array default set and get: two-level} {
+    apply {{} {
+	array set ary {a 3}
+	array default set ary 7
+	apply {{} {
+	    upvar 1 ary ary ary(c) c
+	    lappend result $ary(a) $ary(b) $c
+	    lappend result [info exist ary(a)] [info exist ary(b)] [info exist c]
+	    lappend result [array default get ary]
+	}}
+    }}
+} {3 7 7 1 0 0 7}
+test var-24.16 {array default set: errors} -setup {
+    unset -nocomplain ary
+} -body {
+    set ary not-an-array
+    array default set ary 7
+} -returnCodes error -cleanup {
+    unset -nocomplain ary
+} -result {can't array default set "ary": variable isn't array}
+test var-24.17 {array default set: errors} -setup {
+    unset -nocomplain ary
+} -body {
+    array default set ary
+} -returnCodes error -cleanup {
+    unset -nocomplain ary
+} -result * -match glob
+test var-24.18 {array default set: errors} -setup {
+    unset -nocomplain ary
+} -body {
+    array default set ary x y
+} -returnCodes error -cleanup {
+    unset -nocomplain ary
+} -result * -match glob
+test var-24.19 {array default get: errors} -setup {
+    unset -nocomplain ary
+} -body {
+    set ary not-an-array
+    array default get ary
+} -returnCodes error -cleanup {
+    unset -nocomplain ary
+} -result {"ary" isn't an array}
+test var-24.20 {array default get: errors} -setup {
+    unset -nocomplain ary
+} -body {
+    array default get ary x y
+} -returnCodes error -cleanup {
+    unset -nocomplain ary
+} -result * -match glob
+test var-24.21 {array default exists: errors} -setup {
+    unset -nocomplain ary
+} -body {
+    set ary not-an-array
+    array default exists ary
+} -returnCodes error -cleanup {
+    unset -nocomplain ary
+} -result {"ary" isn't an array}
+test var-24.22 {array default exists: errors} -setup {
+    unset -nocomplain ary
+} -body {
+    array default exists ary x
+} -returnCodes error -cleanup {
+    unset -nocomplain ary
+} -result * -match glob
+test var-24.23 {array default unset: errors} -setup {
+    unset -nocomplain ary
+} -body {
+    set ary not-an-array
+    array default unset ary
+} -returnCodes error -cleanup {
+    unset -nocomplain ary
+} -result {"ary" isn't an array}
+test var-24.24 {array default unset: errors} -setup {
+    unset -nocomplain ary
+} -body {
+    array default unset ary x
+} -returnCodes error -cleanup {
+    unset -nocomplain ary
+} -result * -match glob
 
 catch {namespace delete ns}
 catch {unset arr}
diff --git a/tests/winPipe.test b/tests/winPipe.test
index 53e46fc..5dab3b7 100644
--- a/tests/winPipe.test
+++ b/tests/winPipe.test
@@ -308,9 +308,54 @@ test winpipe-6.2 {PipeSetupProc & PipeCheckProc: write threads} \
     lappend x [catch {close $f} msg] $msg
 } {writable timeout 0 {}}
 
-set path(echoArgs.tcl) [makeFile {
-    puts "[list $argv0 $argv]"
-} echoArgs.tcl]
+proc _testExecArgs {single args} {
+    variable path
+    if {![info exists path(echoArgs.tcl)] || ![file exists $path(echoArgs.tcl)]} {
+	set path(echoArgs.tcl) [makeFile {
+	    puts "[list [file tail $argv0] {*}$argv]"
+	} echoArgs.tcl]
+    }
+    if {![info exists path(echoArgs.bat)] || ![file exists $path(echoArgs.bat)]} {
+	set path(echoArgs.bat) [makeFile "@[file native [interpreter]] $path(echoArgs.tcl) %*" "echoArgs.bat"]
+    }
+    set cmds [list [list [interpreter] $path(echoArgs.tcl)]]
+    if {!($single & 2)} {
+	lappend cmds [list $path(echoArgs.bat)]
+    } else {
+	if {![info exists path(echoArgs2.bat)] || ![file exists $path(echoArgs2.bat)]} {
+	    file mkdir [file join [temporaryDirectory] test(Dir)Check]
+	    set path(echoArgs2.bat) [makeFile "@[file native [interpreter]] $path(echoArgs.tcl) %*" \
+		"test(Dir)Check/echo(Cmd)Test Args & Batch.bat"]
+	}
+	lappend cmds [list $path(echoArgs2.bat)]
+    }
+    set broken {}
+    foreach args $args {
+	if {$single & 1} {
+	    # enclose single test-arg between 1st/3rd to be sure nothing is truncated
+	    # (e. g. to cover unexpected trim by nts-zero case, and args don't recombined):
+	    set args [list "1st" $args "3rd"]
+	}
+	set args [list {*}$args]; # normalized canonical list
+	foreach cmd $cmds {
+	    set e [linsert $args 0 [file tail $path(echoArgs.tcl)]]
+	    tcltest::DebugPuts 4 "  ## test exec [file extension [lindex $cmd 0]] ($cmd) for\n  ##   $args"
+	    if {[catch {
+		exec {*}$cmd {*}$args
+	    } r]} {
+		set r "ERROR: $r"
+	    }
+	    if {$r ne $e} {
+		append broken "\[ERROR\]: exec [file extension [lindex $cmd 0]] on $args\n  -- result:\n$r\n  -- expected:\n$e\n"
+	    }
+	    if {$single & 8} {
+		# if test exe only:
+		break
+	    }
+	}
+    }
+    return $broken
+}
 
 ### validate the raw output of BuildCommandLine().
 ###
@@ -369,65 +414,178 @@ test winpipe-7.18 {BuildCommandLine: special chars #5} {win exec} {
     exec $env(COMSPEC) /c echo foo \} bar
 } "foo \} bar"
 
+set injectList {
+    {test"whoami}     {test""whoami}
+    {test"""whoami}   {test""""whoami}
+
+    "test\"whoami\\"     "test\"\"whoami\\"
+    "test\"\"\"whoami\\" "test\"\"\"\"whoami\\"
+
+    {test\\&\\test}    {test"\\&\\test}
+    {"test\\&\\test}   {"test"\\&\\"test"}
+    {test\\"&"\\test}  {test"\\"&"\\test}
+    {"test\\"&"\\test} {"test"\\"&"\\"test"}
+
+    {test\"&whoami}    {test"\"&whoami}
+    {test""\"&whoami}  {test"""\"&whoami}
+    {test\"\&whoami}   {test"\"\&whoami}
+    {test""\"\&whoami} {test"""\"\&whoami}
+
+    {test&whoami}    {test|whoami}
+    {"test&whoami}   {"test|whoami}
+    {test"&whoami}   {test"|whoami}
+    {"test"&whoami}  {"test"|whoami}
+    {""test"&whoami} {""test"|whoami}
+
+    {test&echo "}    {test|echo "}
+    {"test&echo "}   {"test|echo "}
+    {test"&echo "}   {test"|echo "}
+    {"test"&echo "}  {"test"|echo "}
+    {""test"&echo "} {""test"|echo "}
+
+    {test&echo ""}    {test|echo ""}
+    {"test&echo ""}   {"test|echo ""}
+    {test"&echo ""}   {test"|echo ""}
+    {"test"&echo ""}  {"test"|echo ""}
+    {""test"&echo ""} {""test"|echo ""}
+
+    {test>whoami}    {test<whoami}
+    {"test>whoami}   {"test<whoami}
+    {test">whoami}   {test"<whoami}
+    {"test">whoami}  {"test"<whoami}
+    {""test">whoami} {""test"<whoami}
+    {test(whoami)}   {test(whoami)}
+    {test"(whoami)}  {test"(whoami)}
+    {test^whoami}    {test^^echo ^^^}
+    {test"^whoami}   {test"^^echo ^^^}
+    {test"^echo ^^^"} {test""^echo" ^^^"}
+
+    {test%USERDOMAIN%\%USERNAME%}
+    {test" %USERDOMAIN%\%USERNAME%}
+    {test%USERDOMAIN%\\%USERNAME%}
+    {test" %USERDOMAIN%\\%USERNAME%}
+    {test%USERDOMAIN%&%USERNAME%}
+    {test" %USERDOMAIN%&%USERNAME%}
+    {test%USERDOMAIN%\&\%USERNAME%}
+    {test" %USERDOMAIN%\&\%USERNAME%}
+
+    {test%USERDOMAIN%\&\test}
+    {test" %USERDOMAIN%\&\test}
+    {test%USERDOMAIN%\\&\\test}
+    {test" %USERDOMAIN%\\&\\test}
+
+    {test%USERDOMAIN%\&\"test}
+    {test" %USERDOMAIN%\&\"test}
+    {test%USERDOMAIN%\\&\\"test}
+    {test" %USERDOMAIN%\\&\\"test}
+}
+
 ### validate the pass-thru from BuildCommandLine() to the crt's parse_cmdline().
 ###
-test winpipe-8.1 {BuildCommandLine/parse_cmdline pass-thru: null arguments} {win exec} {
-    exec [interpreter] $path(echoArgs.tcl) foo "" bar
-} [list $path(echoArgs.tcl) [list foo {} bar]]
-test winpipe-8.2 {BuildCommandLine/parse_cmdline pass-thru: null arguments} {win exec} {
-    exec [interpreter] $path(echoArgs.tcl) foo {} bar
-} [list $path(echoArgs.tcl) [list foo {} bar]]
-test winpipe-8.3 {BuildCommandLine/parse_cmdline pass-thru: dbl quote quoting #1} {win exec} {
-    exec [interpreter] $path(echoArgs.tcl) foo "\"" bar
-} [list $path(echoArgs.tcl) [list foo "\"" bar]]
-test winpipe-8.4 {BuildCommandLine/parse_cmdline pass-thru: dbl quote quoting #2} {win exec} {
-    exec [interpreter] $path(echoArgs.tcl) foo {""} bar
-} [list $path(echoArgs.tcl) [list foo {""} bar]]
-test winpipe-8.5 {BuildCommandLine/parse_cmdline pass-thru: dbl quote quoting #3} {win exec} {
-    exec [interpreter] $path(echoArgs.tcl) foo "\" " bar
-} [list $path(echoArgs.tcl) [list foo "\" " bar]]
-test winpipe-8.6 {BuildCommandLine/parse_cmdline pass-thru: dbl quote quoting #4} {win exec} {
-    exec [interpreter] $path(echoArgs.tcl) foo {a="b"} bar
-} [list $path(echoArgs.tcl) [list foo {a="b"} bar]]
-test winpipe-8.7 {BuildCommandLine/parse_cmdline pass-thru: dbl quote quoting #5} {win exec} {
-    exec [interpreter] $path(echoArgs.tcl) foo {a = "b"} bar
-} [list $path(echoArgs.tcl) [list foo {a = "b"} bar]]
-test winpipe-8.8 {BuildCommandLine/parse_cmdline pass-thru: dbl quote quoting #6} {win exec} {
-    exec [interpreter] $path(echoArgs.tcl) {"hello"} {""hello""} {"""hello"""} {"\"hello\""} {he llo} {he " llo}
-} [list $path(echoArgs.tcl) [list {"hello"} {""hello""} {"""hello"""} {"\"hello\""} {he llo} {he " llo}]]
-test winpipe-8.9 {BuildCommandLine/parse_cmdline pass-thru: N backslashes followed a quote rule #1} {win exec} {
-    exec [interpreter] $path(echoArgs.tcl) foo \\ bar
-} [list $path(echoArgs.tcl) [list foo \\ bar]]
-test winpipe-8.10 {BuildCommandLine/parse_cmdline pass-thru: N backslashes followed a quote rule #2} {win exec} {
-    exec [interpreter] $path(echoArgs.tcl) foo \\\\ bar
-} [list $path(echoArgs.tcl) [list foo \\\\ bar]]
-test winpipe-8.11 {BuildCommandLine/parse_cmdline pass-thru: N backslashes followed a quote rule #3} {win exec} {
-    exec [interpreter] $path(echoArgs.tcl) foo \\\ \\ bar
-} [list $path(echoArgs.tcl) [list foo \\\ \\ bar]]
-test winpipe-8.12 {BuildCommandLine/parse_cmdline pass-thru: N backslashes followed a quote rule #4} {win exec} {
-    exec [interpreter] $path(echoArgs.tcl) foo \\\ \\\\ bar
-} [list $path(echoArgs.tcl) [list foo \\\ \\\\ bar]]
-test winpipe-8.13 {BuildCommandLine/parse_cmdline pass-thru: N backslashes followed a quote rule #5} {win exec} {
-    exec [interpreter] $path(echoArgs.tcl) foo \\\ \\\\\\ bar
-} [list $path(echoArgs.tcl) [list foo \\\ \\\\\\ bar]]
-test winpipe-8.14 {BuildCommandLine/parse_cmdline pass-thru: N backslashes followed a quote rule #6} {win exec} {
-    exec [interpreter] $path(echoArgs.tcl) foo \\\ \\\" bar
-} [list $path(echoArgs.tcl) [list foo \\\ \\\" bar]]
-test winpipe-8.15 {BuildCommandLine/parse_cmdline pass-thru: N backslashes followed a quote rule #7} {win exec} {
-    exec [interpreter] $path(echoArgs.tcl) foo \\\ \\\\\" bar
-} [list $path(echoArgs.tcl) [list foo \\\ \\\\\" bar]]
-test winpipe-8.16 {BuildCommandLine/parse_cmdline pass-thru: N backslashes followed a quote rule #8} {win exec} {
-    exec [interpreter] $path(echoArgs.tcl) foo \\\ \\\\\\\" bar
-} [list $path(echoArgs.tcl) [list foo \\\ \\\\\\\" bar]]
-test winpipe-8.17 {BuildCommandLine/parse_cmdline pass-thru: special chars #1} {win exec} {
-    exec [interpreter] $path(echoArgs.tcl) foo \{ bar
-} [list $path(echoArgs.tcl) [list foo \{ bar]]
-test winpipe-8.18 {BuildCommandLine/parse_cmdline pass-thru: special chars #2} {win exec} {
-    exec [interpreter] $path(echoArgs.tcl) foo \} bar
-} [list $path(echoArgs.tcl) [list foo \} bar]]
-test winpipe-8.19 {ensure parse_cmdline isn't doing wildcard replacement} {win exec} {
-    exec [interpreter] $path(echoArgs.tcl) foo * makefile.?c bar
-} [list $path(echoArgs.tcl) [list foo * makefile.?c bar]]
+test winpipe-8.1 {BuildCommandLine/parse_cmdline pass-thru: dumped arguments are equal original} \
+-constraints {win exec} -body {
+    _testExecArgs 0 \
+	[list foo "" bar] \
+	[list foo {} bar] \
+	[list foo "\"" bar] \
+	[list foo {""} bar] \
+	[list foo "\" " bar] \
+	[list foo {a="b"} bar] \
+	[list foo {a = "b"} bar] \
+	[list {"hello"} {""hello""} {"""hello"""} {"\"hello\""} {he llo} {he " llo}] \
+	[list foo \\ bar] \
+	[list foo \\\\ bar] \
+	[list foo \\\ \\ bar] \
+	[list foo \\\ \\\\ bar] \
+	[list foo \\\ \\\\\\ bar] \
+	[list foo \\\ \\\" bar] \
+	[list foo \\\ \\\\\" bar] \
+	[list foo \\\ \\\\\\\" bar] \
+	[list foo \{ bar] \
+	[list foo \} bar] \
+	[list foo * makefile.?c bar]
+} -result {}
+
+test winpipe-8.2 {BuildCommandLine/parse_cmdline pass-thru: check injection on special meta-chars (particular)} \
+-constraints {win exec slowTest} -body {
+    _testExecArgs 1 {*}$injectList
+} -result {}
+
+test winpipe-8.3 {BuildCommandLine/parse_cmdline pass-thru: check injection on special meta-chars (jointly)} \
+-constraints {win exec} -body {
+    _testExecArgs 0 \
+	[list START     {*}$injectList END] \
+	[list "START\"" {*}$injectList END] \
+	[list START     {*}$injectList "\"END"] \
+	[list "START\"" {*}$injectList "\"END"]
+} -result {}
+
+test winpipe-8.4 {BuildCommandLine/parse_cmdline pass-thru: check injection on special meta-chars (command/jointly args)} \
+-constraints {win exec} -body {
+    _testExecArgs 2 \
+	[list START     {*}$injectList END] \
+	[list "START\"" {*}$injectList END] \
+	[list START     {*}$injectList "\"END"] \
+	[list "START\"" {*}$injectList "\"END"]
+} -result {}
+
+test winpipe-8.5 {BuildCommandLine/parse_cmdline pass-thru: check injection on special meta-chars (random mix)} \
+-constraints {win exec} -body {
+    set lst {}
+    set maps {
+	{\&|^<>!()%}
+	{\&|^<>!()% }
+	{"\&|^<>!()%}
+	{"\&|^<>!()% }
+	{"""""\\\\\&|^<>!()%}
+	{"""""\\\\\&|^<>!()% }
+    }
+    set i 0
+    time {
+	set args {[incr i].}
+	time {
+	    set map [lindex $maps [expr {int(rand()*[llength $maps])}]]
+	    # be sure arg has some prefix (avoid special handling, like |& etc)
+	    set a {x}
+	    while {[string length $a] < 50} {
+		append a [string index $map [expr {int(rand()*[string length $map])}]]
+	    }
+	    lappend args $a
+	} 20
+	lappend lst $args
+    } 10
+    _testExecArgs 0 {*}$lst
+} -result {} -cleanup {
+    unset -nocomplain lst args a map maps
+}
+
+set injectList {
+    "test\"\nwhoami"     "test\"\"\nwhoami"
+    "test\"\"\"\nwhoami" "test\"\"\"\"\nwhoami"
+    "test;\n&echo \""    "\"test;\n&echo \""
+    "test\";\n&echo \""  "\"test\";\n&echo \""
+    "\"\"test\";\n&echo \""
+}
+
+test winpipe-8.6 {BuildCommandLine/parse_cmdline pass-thru: check new-line quoted in args} \
+-constraints {win exec} -body {
+    # test exe only, because currently there is no proper way to escape a new-line char resp.
+    # to supply a new-line to the batch-files within arguments (command line is truncated).
+    _testExecArgs 8 \
+	[list START     {*}$injectList END] \
+	[list "START\"" {*}$injectList END] \
+	[list START     {*}$injectList "\"END"] \
+	[list "START\"" {*}$injectList "\"END"]
+} -result {}
+
+test winpipe-8.7 {BuildCommandLine/parse_cmdline pass-thru: check new-line quoted in args (batch)} \
+-constraints {win exec knownBug} -body {
+    # this will fail if executed batch-file, because currently there is no proper way to escape a new-line char.
+    _testExecArgs 0 $injectList
+} -result {}
+
+
+rename _testExecArgs {}
 
 # restore old values for env(TMP) and env(TEMP)
 
@@ -446,6 +604,8 @@ removeFile stdout
 removeFile stderr
 removeFile nothing
 removeFile echoArgs.tcl
+removeFile echoArgs.bat
+file delete -force [file join [temporaryDirectory] test(Dir)Check]
 ::tcltest::cleanupTests
 return
 
diff --git a/tests/zipfs.test b/tests/zipfs.test
new file mode 100644
index 0000000..1a5225c
--- /dev/null
+++ b/tests/zipfs.test
@@ -0,0 +1,283 @@
+# The file tests the tclZlib.c file.
+#
+# This file contains a collection of tests for one or more of the Tcl built-in
+# commands. Sourcing this file into Tcl runs the tests and generates output
+# for errors. No output means no errors were found.
+#
+# Copyright (c) 1996-1998 by Sun Microsystems, Inc.
+# Copyright (c) 1998-1999 by Scriptics Corporation.
+#
+# See the file "license.terms" for information on usage and redistribution of
+# this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+if {"::tcltest" ni [namespace children]} {
+    package require tcltest 2.1
+    namespace import -force ::tcltest::*
+}
+
+testConstraint zipfs [expr {[llength [info commands zlib]] && [regexp tcltest [info nameofexecutable]]}]
+
+# Removed in tip430 - zipfs is no longer a static package
+#test zipfs-0.0 {zipfs basics} -constraints zipfs -body {
+#    load {} zipfs
+#} -result {}
+
+set ziproot [zipfs root]
+set CWD [pwd]
+set tmpdir  [file join $CWD tmp]
+file mkdir $tmpdir
+
+test zipfs-0.1 {zipfs basics} -constraints zipfs -body {
+    package require zipfs
+} -result {2.0}
+
+test zipfs-0.1 {zipfs basics} -constraints zipfs -body {
+    expr {${ziproot} in [file volumes]}
+} -result 1
+
+if {![string match ${ziproot}* $tcl_library]} {
+    ###
+    # "make test" does not map tcl_library from the dynamic library on Unix
+    #
+    # Hack the environment to pretend we did pull tcl_library from a zip
+    # archive
+    ###
+    set tclzip [file join $CWD [::tcl::pkgconfig get zipfile,runtime]]
+    if {[file exists $tclzip]} {
+        zipfs mount /lib/tcl $tclzip
+        set ::tcl_library ${ziproot}lib/tcl/tcl_library
+    } else {
+        tcltest::skip zipfs-0.*
+    }
+}
+
+test zipfs-0.2 {zipfs basics} -constraints zipfs -body {
+    string match ${ziproot}* $tcl_library
+} -result 1
+
+test zipfs-0.3 {zipfs basics: glob} -constraints zipfs -body {
+    set pwd [pwd]
+    cd $tcl_library
+    lsort [glob -dir . http*]
+} -cleanup {
+    cd $pwd
+} -result {./http}
+
+test zipfs-0.4 {zipfs basics: glob} -constraints zipfs -body {
+    set pwd [pwd]
+    cd $tcl_library
+    lsort [glob -dir [pwd] http*]
+} -cleanup {
+    cd $pwd
+} -result [list $tcl_library/http]
+
+test zipfs-0.5 {zipfs basics: glob} -constraints zipfs -body {
+    lsort [glob -dir $tcl_library http*]
+} -result [list $tcl_library/http]
+
+test zipfs-0.6 {zipfs basics: glob} -constraints zipfs -body {
+    lsort [glob $tcl_library/http*]
+} -result [list $tcl_library/http]
+
+test zipfs-0.7 {zipfs basics: glob} -constraints zipfs -body {
+    lsort [glob -tails -dir $tcl_library http*]
+} -result {http}
+
+test zipfs-0.8 {zipfs basics: glob} -constraints zipfs -body {
+    lsort [glob -nocomplain -tails -types d -dir $tcl_library http*]
+} -result {http}
+
+test zipfs-0.9 {zipfs basics: glob} -constraints zipfs -body {
+    lsort [glob -nocomplain -tails -types f -dir $tcl_library http*]
+} -result {}
+
+test zipfs-0.10 {zipfs basics: join} -constraints zipfs -body {
+    file join [zipfs root] bar baz
+} -result "[zipfs root]bar/baz"
+
+test zipfs-0.11 {zipfs basics: join} -constraints zipfs -body {
+    file normalize [zipfs root]
+} -result "[zipfs root]"
+
+test zipfs-0.12 {zipfs basics: join} -constraints zipfs -body {
+    file normalize [zipfs root]//bar/baz//qux/../
+} -result "[zipfs root]bar/baz"
+
+test zipfs-1.3 {zipfs errors} -constraints zipfs -returnCodes error -body {
+    zipfs mount a b c d e f
+} -result {wrong # args: should be "zipfs mount ?mountpoint? ?zipfile? ?password?"}
+
+test zipfs-1.4 {zipfs errors} -constraints zipfs -returnCodes error -body {
+    zipfs unmount a b c d e f
+} -result {wrong # args: should be "zipfs unmount zipfile"}
+
+test zipfs-1.5 {zipfs errors} -constraints zipfs -returnCodes error -body {
+    zipfs mkkey a b c d e f
+} -result {wrong # args: should be "zipfs mkkey password"}
+
+test zipfs-1.6 {zipfs errors} -constraints zipfs -returnCodes error -body {
+    zipfs mkimg a b c d e f
+} -result {wrong # args: should be "zipfs mkimg outfile indir ?strip? ?password? ?infile?"}
+
+test zipfs-1.7 {zipfs errors} -constraints zipfs -returnCodes error -body {
+    zipfs mkzip a b c d e f
+} -result {wrong # args: should be "zipfs mkzip outfile indir ?strip? ?password?"}
+
+test zipfs-1.8 {zipfs errors} -constraints zipfs -returnCodes error -body {
+    zipfs exists a b c d e f
+} -result {wrong # args: should be "zipfs exists filename"}
+
+test zipfs-1.9 {zipfs errors} -constraints zipfs -returnCodes error -body {
+    zipfs info a b c d e f
+} -result {wrong # args: should be "zipfs info filename"}
+
+test zipfs-1.10 {zipfs errors} -constraints zipfs -returnCodes error -body {
+    zipfs list a b c d e f
+} -result {wrong # args: should be "zipfs list ?(-glob|-regexp)? ?pattern?"}
+
+file mkdir tmp
+
+test zipfs-2.1 {zipfs mkzip empty archive} -constraints zipfs -returnCodes error -body {
+    zipfs mkzip [file join $tmpdir empty.zip] $tcl_library/xxxx
+} -result {empty archive}
+
+###
+# The 2.2 series of tests operate within
+# a zipfile created a temporary directory
+###
+set zipfile [file join $tmpdir abc.zip]
+if {[file exists $zipfile]} {
+   file delete $zipfile
+}
+
+test zipfs-2.2.0 {zipfs mkzip} -constraints zipfs -body {
+    cd $tcl_library/encoding
+    zipfs mkzip $zipfile .
+    zipfs mount ${ziproot}abc $zipfile
+    zipfs list -glob ${ziproot}abc/cp850.*
+} -cleanup {
+    cd $CWD
+} -result "[zipfs root]abc/cp850.enc"
+
+if {![zipfs exists /abc/cp850.enc]} {
+   skip [concat [skip] zipfs-2.2.*]
+}
+
+test zipfs-2.2.1 {zipfs info} -constraints zipfs -body {
+    set r [zipfs info ${ziproot}abc/cp850.enc]
+    lrange $r 0 2
+} -result [list $zipfile 1090 527] ;# NOTE: Only the first 3 results are stable
+
+test zipfs-2.2.3 {zipfs data} -constraints zipfs -body {
+    set zipfd [open ${ziproot}/abc/cp850.enc]	;# FIXME: leave open - see later test
+    read $zipfd
+} -result {# Encoding file: cp850, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+00C700FC00E900E200E400E000E500E700EA00EB00E800EF00EE00EC00C400C5
+00C900E600C600F400F600F200FB00F900FF00D600DC00F800A300D800D70192
+00E100ED00F300FA00F100D100AA00BA00BF00AE00AC00BD00BC00A100AB00BB
+2591259225932502252400C100C200C000A9256325512557255D00A200A52510
+25142534252C251C2500253C00E300C3255A25542569256625602550256C00A4
+00F000D000CA00CB00C8013100CD00CE00CF2518250C2588258400A600CC2580
+00D300DF00D400D200F500D500B500FE00DE00DA00DB00D900FD00DD00AF00B4
+00AD00B1201700BE00B600A700F700B800B000A800B700B900B300B225A000A0
+} ;# FIXME: result depends on content of encodings dir
+
+test zipfs-2.2.4 {zipfs exists} -constraints zipfs -body {
+    zipfs exists /abc/cp850.enc
+} -result 1
+
+test zipfs-2.2.5 {zipfs unmount while busy} -constraints zipfs -body {
+    zipfs unmount /abc
+} -returnCodes error -result {filesystem is busy}
+
+test zipfs-2.2.6 {zipfs unmount} -constraints zipfs -body {
+    close $zipfd
+    zipfs unmount /abc
+    zipfs exists /abc/cp850.enc
+} -result 0
+
+
+###
+# Repeat the tests for a buffer mounted archive
+###
+test zipfs-2.3.0 {zipfs mkzip} -constraints zipfs -body {
+   cd $tcl_library/encoding
+   zipfs mkzip $zipfile .
+   set fin [open $zipfile r]
+   fconfigure $fin -translation binary
+   set dat [read $fin]
+   close $fin
+   zipfs mount_data def $dat
+    zipfs list -glob ${ziproot}def/cp850.*
+} -cleanup {
+    cd $CWD
+} -result "[zipfs root]def/cp850.enc"
+
+if {![zipfs exists /def/cp850.enc]} {
+   skip [concat [skip] zipfs-2.3.*]
+}
+
+test zipfs-2.3.1 {zipfs info} -constraints zipfs -body {
+    set r [zipfs info ${ziproot}def/cp850.enc]
+    lrange $r 0 2
+} -result [list {Memory Buffer} 1090 527] ;# NOTE: Only the first 3 results are stable
+
+test zipfs-2.3.3 {zipfs data} -constraints zipfs -body {
+    set zipfd [open ${ziproot}/def/cp850.enc]	;# FIXME: leave open - see later test
+    read $zipfd
+} -result {# Encoding file: cp850, single-byte
+S
+003F 0 1
+00
+0000000100020003000400050006000700080009000A000B000C000D000E000F
+0010001100120013001400150016001700180019001A001B001C001D001E001F
+0020002100220023002400250026002700280029002A002B002C002D002E002F
+0030003100320033003400350036003700380039003A003B003C003D003E003F
+0040004100420043004400450046004700480049004A004B004C004D004E004F
+0050005100520053005400550056005700580059005A005B005C005D005E005F
+0060006100620063006400650066006700680069006A006B006C006D006E006F
+0070007100720073007400750076007700780079007A007B007C007D007E007F
+00C700FC00E900E200E400E000E500E700EA00EB00E800EF00EE00EC00C400C5
+00C900E600C600F400F600F200FB00F900FF00D600DC00F800A300D800D70192
+00E100ED00F300FA00F100D100AA00BA00BF00AE00AC00BD00BC00A100AB00BB
+2591259225932502252400C100C200C000A9256325512557255D00A200A52510
+25142534252C251C2500253C00E300C3255A25542569256625602550256C00A4
+00F000D000CA00CB00C8013100CD00CE00CF2518250C2588258400A600CC2580
+00D300DF00D400D200F500D500B500FE00DE00DA00DB00D900FD00DD00AF00B4
+00AD00B1201700BE00B600A700F700B800B000A800B700B900B300B225A000A0
+} ;# FIXME: result depends on content of encodings dir
+
+test zipfs-2.3.4 {zipfs exists} -constraints zipfs -body {
+    zipfs exists /def/cp850.enc
+} -result 1
+
+test zipfs-2.3.5 {zipfs unmount while busy} -constraints zipfs -body {
+    zipfs unmount /def
+} -returnCodes error -result {filesystem is busy}
+
+test zipfs-2.3.6 {zipfs unmount} -constraints zipfs -body {
+    close $zipfd
+    zipfs unmount /def
+    zipfs exists /def/cp850.enc
+} -result 0
+
+catch {file delete -force $tmpdir}
+
+
+::tcltest::cleanupTests
+return
+
+# Local Variables:
+# mode: tcl
+# End:
diff --git a/tools/empty.zip b/tools/empty.zip
new file mode 100644
index 0000000..15cb0ec
--- /dev/null
+++ b/tools/empty.zip
diff --git a/tools/makeHeader.tcl b/tools/makeHeader.tcl
new file mode 100644
index 0000000..e9b7ed1
--- /dev/null
+++ b/tools/makeHeader.tcl
@@ -0,0 +1,182 @@
+# makeHeader.tcl --
+#
+#	This script generates embeddable C source (in a .h file) from a .tcl
+#	script.
+#
+# Copyright (c) 2018 Donal K. Fellows
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+package require Tcl 8.6
+
+namespace eval makeHeader {
+
+    ####################################################################
+    #
+    # mapSpecial --
+    #	Transform a single line so that it is able to be put in a C string.
+    #
+    proc mapSpecial {str} {
+	# All Tcl metacharacters and key C backslash sequences
+	set MAP {
+	    \" \\\\\" \\ \\\\\\\\ $ \\$ [ \\[ ] \\] ' \\\\' ? \\\\?
+	    \a \\\\a \b \\\\b \f \\\\f \n \\\\n \r \\\\r \t \\\\t \v \\\\v
+	}
+	set XFORM {[format \\\\\\\\u%04x {*}[scan & %c]]}
+
+	subst [regsub -all {[^\u0020-\u007e]} [string map $MAP $str] $XFORM]
+    }
+
+    ####################################################################
+    #
+    # compactLeadingSpaces --
+    #	Converts the leading whitespace on a line into a more compact form.
+    #
+    proc compactLeadingSpaces {line} {
+	set line [string map {\t {        }} [string trimright $line]]
+	if {[regexp {^[ ]+} $line spaces]} {
+	    regsub -all {[ ]{4}} $spaces \t replace
+	    set len [expr {[string length $spaces] - 1}]
+	    set line [string replace $line 0 $len $replace]
+	}
+	return $line
+    }
+
+    ####################################################################
+    #
+    # processScript --
+    #	Transform a whole sequence of lines with [mapSpecial].
+    #
+    proc processScript {scriptLines} {
+	lmap line $scriptLines {
+	    # Skip blank and comment lines; they're there in the original
+	    # sources so we don't need to copy them over.
+	    if {[regexp {^\s*(?:#|$)} $line]} continue
+	    format {"%s"} [mapSpecial [compactLeadingSpaces $line]\n]
+	}
+    }
+
+    ####################################################################
+    #
+    # updateTemplate --
+    #	Rewrite a template to contain the content from the input script.
+    #
+    proc updateTemplate {dataVar scriptLines} {
+	set BEGIN "*!BEGIN!: Do not edit below this line.*"
+	set END "*!END!: Do not edit above this line.*"
+
+	upvar 1 $dataVar data
+
+	set from [lsearch -glob $data $BEGIN]
+	set to [lsearch -glob $data $END]
+	if {$from == -1 || $to == -1 || $from >= $to} {
+	    throw BAD "not a template"
+	}
+
+	set data [lreplace $data $from+1 $to-1 {*}[processScript $scriptLines]]
+    }
+
+    ####################################################################
+    #
+    # stripSurround --
+    #	Removes the header and footer comments from a (line-split list of
+    #	lines of) Tcl script code.
+    #
+    proc stripSurround {lines} {
+	set RE {^\s*$|^#}
+	set state 0
+	set lines [lmap line [lreverse $lines] {
+	    if {!$state && [regexp $RE $line]} continue {
+		set state 1
+		set line
+	    }
+	}]
+	return [lmap line [lreverse $lines] {
+	    if {$state && [regexp $RE $line]} continue {
+		set state 0
+		set line
+	    }
+	}]
+    }
+
+    ####################################################################
+    #
+    # updateTemplateFile --
+    #	Rewrites a template file with the lines of the given script.
+    #
+    proc updateTemplateFile {headerFile scriptLines} {
+	set f [open $headerFile "r+"]
+	try {
+	    set content [split [chan read -nonewline $f] "\n"]
+	    updateTemplate content [stripSurround $scriptLines]
+	    chan seek $f 0
+	    chan puts $f [join $content \n]
+	    chan truncate $f
+	} trap BAD msg {
+	    # Add the filename to the message
+	    throw BAD "${headerFile}: $msg"
+	} finally {
+	    chan close $f
+	}
+    }
+
+    ####################################################################
+    #
+    # readScript --
+    #	Read a script from a file and return its lines.
+    #
+    proc readScript {script} {
+	set f [open $script]
+	try {
+	    chan configure $f -encoding utf-8
+	    return [split [string trim [chan read $f]] "\n"]
+	} finally {
+	    chan close $f
+	}
+    }
+
+    ####################################################################
+    #
+    # run --
+    #	The main program of this script.
+    #
+    proc run {args} {
+	try {
+	    if {[llength $args] != 2} {
+		throw ARGS "inputTclScript templateFile"
+	    }
+	    lassign $args inputTclScript templateFile
+
+	    puts "Inserting $inputTclScript into $templateFile"
+	    set scriptLines [readScript $inputTclScript]
+	    updateTemplateFile $templateFile $scriptLines
+	    exit 0
+	} trap ARGS msg {
+	    puts stderr "wrong # args: should be \"[file tail $::argv0] $msg\""
+	    exit 2
+	} trap BAD msg {
+	    puts stderr $msg
+	    exit 1
+	} trap POSIX msg {
+	    puts stderr $msg
+	    exit 1
+	} on error {- opts} {
+	    puts stderr [dict get $opts -errorinfo]
+	    exit 3
+	}
+    }
+}
+
+########################################################################
+#
+# Launch the main program
+#
+if {[info script] eq $::argv0} {
+    makeHeader::run {*}$::argv
+}
+
+# Local-Variables:
+# mode: tcl
+# fill-column: 78
+# End:
diff --git a/tools/mkVfs.tcl b/tools/mkVfs.tcl
new file mode 100644
index 0000000..cbfb81e
--- /dev/null
+++ b/tools/mkVfs.tcl
@@ -0,0 +1,99 @@
+proc cat fname {
+    set fname [open $fname r]
+    set data [read $fname]
+    close $fname
+    return $data
+}
+
+proc pkgIndexDir {root fout d1} {
+
+    puts [format {%*sIndexing %s} [expr {4 * [info level]}] {} \
+	      [file tail $d1]]
+    set idx [string length $root]
+    foreach ftail [glob -directory $d1 -nocomplain -tails *] {
+        set f [file join $d1 $ftail]
+        if {[file isdirectory $f] && [string compare CVS $ftail]} {
+            pkgIndexDir $root $fout $f
+        } elseif {[file tail $f] eq "pkgIndex.tcl"} {
+      	    puts $fout "set dir \${VFSROOT}[string range $d1 $idx end]"
+	          puts $fout [cat $f]
+	      }
+    }
+}
+
+###
+# Script to build the VFS file system
+###
+proc copyDir {d1 d2} {
+
+    puts [format {%*sCreating %s} [expr {4 * [info level]}] {} \
+	      [file tail $d2]]
+
+    file delete -force -- $d2
+    file mkdir $d2
+
+    foreach ftail [glob -directory $d1 -nocomplain -tails *] {
+        set f [file join $d1 $ftail]
+        if {[file isdirectory $f] && [string compare CVS $ftail]} {
+            copyDir $f [file join $d2 $ftail]
+        } elseif {[file isfile $f]} {
+      	    file copy -force $f [file join $d2 $ftail]
+	          if {$::tcl_platform(platform) eq {unix}} {
+            		file attributes [file join $d2 $ftail] -permissions 0644
+      	    } else {
+            		file attributes [file join $d2 $ftail] -readonly 1
+	          }
+	      }
+    }
+
+    if {$::tcl_platform(platform) eq {unix}} {
+      	file attributes $d2 -permissions 0755
+    } else {
+	      file attributes $d2 -readonly 1
+    }
+}
+
+if {[llength $argv] < 3} {
+    puts "Usage: VFS_ROOT TCLSRC_ROOT PLATFORM"
+    exit 1
+}
+set TCL_SCRIPT_DIR [lindex $argv 0]
+set TCLSRC_ROOT    [lindex $argv 1]
+set PLATFORM       [lindex $argv 2]
+set TKDLL          [lindex $argv 3]
+set TKVER          [lindex $argv 4]
+
+puts "Building [file tail $TCL_SCRIPT_DIR] for $PLATFORM"
+copyDir ${TCLSRC_ROOT}/library ${TCL_SCRIPT_DIR}
+
+if {$PLATFORM == "windows"} {
+    set ddedll [glob -nocomplain ${TCLSRC_ROOT}/win/tcldde*.dll]
+    puts "DDE DLL $ddedll"
+    if {$ddedll != {}} {
+      	file copy $ddedll ${TCL_SCRIPT_DIR}/dde
+    }
+    set regdll [glob -nocomplain ${TCLSRC_ROOT}/win/tclreg*.dll]
+    puts "REG DLL $ddedll"
+    if {$regdll != {}} {
+      	file copy $regdll ${TCL_SCRIPT_DIR}/reg
+    }
+} else {
+    # Remove the dde and reg package paths
+    file delete -force ${TCL_SCRIPT_DIR}/dde
+    file delete -force ${TCL_SCRIPT_DIR}/reg
+}
+
+# For the following packages, cat their pkgIndex files to tclIndex
+file attributes ${TCL_SCRIPT_DIR}/tclIndex -readonly 0
+set fout [open ${TCL_SCRIPT_DIR}/tclIndex a]
+puts $fout {#
+# MANIFEST OF INCLUDED PACKAGES
+#
+set VFSROOT $dir
+}
+if {$TKDLL ne {} && [file exists $TKDLL]} {
+  file copy $TKDLL ${TCL_SCRIPT_DIR}
+  puts $fout [list package ifneeded Tk $TKVER "load \$dir $TKDLL"]
+}
+pkgIndexDir ${TCL_SCRIPT_DIR} $fout ${TCL_SCRIPT_DIR}
+close $fout
diff --git a/tools/valgrind_suppress b/tools/valgrind_suppress
new file mode 100644
index 0000000..fb7f173
--- /dev/null
+++ b/tools/valgrind_suppress
@@ -0,0 +1,126 @@
+{
+   TclCreatesocketAddress/getaddrinfo/calloc
+   Memcheck:Leak
+   match-leak-kinds: reachable
+   fun:calloc
+   ...
+   fun:getaddrinfo
+   fun:TclCreateSocketAddress
+}
+
+{
+   TclCreatesocketAddress/getaddrinfo/malloc
+   Memcheck:Leak
+   match-leak-kinds: reachable
+   fun:malloc
+   ...
+   fun:getaddrinfo
+   fun:TclCreateSocketAddress
+}
+
+{
+   TclpDlopen/load
+   Memcheck:Leak
+   match-leak-kinds: reachable
+   fun:calloc
+   ...
+   fun:dlopen
+   fun:TclpDlopen
+}
+
+{
+   TclpDlopen/load
+   Memcheck:Leak
+   match-leak-kinds: reachable
+   fun:malloc
+   ...
+   fun:dlopen
+   fun:TclpDlopen
+}
+
+{
+   TclpGetGrNam/__nss_next2/calloc
+   Memcheck:Leak
+   match-leak-kinds: reachable
+   fun:calloc
+   ...
+   fun:__nss_next2
+   ...
+   fun:TclpGetGrNam
+}
+
+{
+   TclpGetGrNam/__nss_next2/malloc
+   Memcheck:Leak
+   match-leak-kinds: reachable
+   fun:malloc
+   ...
+   fun:__nss_next2
+   ...
+   fun:TclpGetGrNam
+}
+
+{
+   TclpGetGrNam/__nss_systemd_getfrname_r/malloc
+   Memcheck:Leak
+   match-leak-kinds: reachable
+   fun:malloc
+   ...
+   fun:_nss_systemd_getgrnam_r
+   ...
+   fun:TclpGetGrNam
+}
+
+{
+   TclpGetPwNam/getpwname_r/__nss_next2/calloc
+   Memcheck:Leak
+   match-leak-kinds: reachable
+   fun:calloc
+   ...
+   fun:__nss_next2
+   ...
+   fun:TclpGetPwNam
+}
+
+{
+   TclpGetPwNam/getpwname_r/__nss_next2/malloc
+   Memcheck:Leak
+   match-leak-kinds: reachable
+   fun:malloc
+   ...
+   fun:__nss_next2
+   ...
+   fun:TclpGetPwNam
+}
+
+{
+   TclpGetPwNam/getpwname_r/_nss_systemd_getpwnam_r/malloc
+   Memcheck:Leak
+   match-leak-kinds: reachable
+   fun:malloc
+   ...
+   fun:_nss_systemd_getpwnam_r
+   ...
+   fun:TclpGetPwNam
+}
+
+{
+	TclpThreadExit/pthread_exit/calloc
+    Memcheck:Leak
+    match-leak-kinds: reachable
+	fun:calloc
+	...
+	fun:pthread_exit
+	fun:TclpThreadExit
+}
+
+{
+	TclpThreadExit/pthread_exit/malloc
+    Memcheck:Leak
+    match-leak-kinds: reachable
+	fun:malloc
+	...
+	fun:pthread_exit
+	fun:TclpThreadExit
+}
+
diff --git a/unix/Makefile.in b/unix/Makefile.in
index f044e41..95e7b80 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -242,6 +242,8 @@ ZLIB_DIR		= ${COMPAT_DIR}/zlib
 ZLIB_INCLUDE		= @ZLIB_INCLUDE@
 
 CC			= @CC@
+OBJEXT		        = @OBJEXT@
+
 #CC			= purify -best-effort @CC@ -DPURIFY
 
 # Flags to be passed to installManPage to control how the manpages should be
@@ -259,10 +261,13 @@ INSTALL_TZDATA		= @INSTALL_TZDATA@
 #--------------------------------------------------------------------------
 
 GDB			= gdb
+LLDB			= lldb
 TRACE			= strace
 TRACE_OPTS		=
 VALGRIND		= valgrind
-VALGRINDARGS		= --tool=memcheck --num-callers=8 --leak-resolution=high --leak-check=yes --show-reachable=yes -v
+VALGRINDARGS		= --tool=memcheck --num-callers=24 \
+    --leak-resolution=high --leak-check=yes --show-reachable=yes -v \
+    --suppressions=$(TOOL_DIR)/valgrind_suppress
 
 #--------------------------------------------------------------------------
 # The information below should be usable as is. The configure script won't
@@ -308,7 +313,7 @@ GENERIC_OBJS = regcomp.o regexec.o regfree.o regerror.o tclAlloc.o \
 	tclStrToD.o tclThread.o \
 	tclThreadAlloc.o tclThreadJoin.o tclThreadStorage.o tclStubInit.o \
 	tclTimer.o tclTrace.o tclUtf.o tclUtil.o tclVar.o tclZlib.o \
-	tclTomMathInterface.o
+	tclTomMathInterface.o tclZipfs.o
 
 OO_OBJS = tclOO.o tclOOBasic.o tclOOCall.o tclOODefineCmds.o tclOOInfo.o \
 	tclOOMethod.o tclOOStubInit.o
@@ -464,7 +469,8 @@ GENERIC_SRCS = \
 	$(GENERIC_DIR)/tclUtil.c \
 	$(GENERIC_DIR)/tclVar.c \
 	$(GENERIC_DIR)/tclAssembly.c \
-	$(GENERIC_DIR)/tclZlib.c
+	$(GENERIC_DIR)/tclZlib.c \
+	$(GENERIC_DIR)/tclZipfs.c
 
 OO_SRCS = \
 	$(GENERIC_DIR)/tclOO.c \
@@ -617,6 +623,44 @@ ZLIB_SRCS = \
 SRCS = $(GENERIC_SRCS) $(TOMMATH_SRCS) $(UNIX_SRCS) $(NOTIFY_SRCS) \
 	$(OO_SRCS) $(STUB_SRCS) @PLAT_SRCS@ @ZLIB_SRCS@
 
+###
+# Tip 430 - ZipFS Modifications
+###
+
+TCL_ZIP_FILE		= @TCL_ZIP_FILE@
+TCL_VFS_PATH		= libtcl.vfs/tcl_library
+TCL_VFS_ROOT		= libtcl.vfs
+
+HOST_CC		        = @CC_FOR_BUILD@
+HOST_EXEEXT             = @EXEEXT_FOR_BUILD@
+HOST_OBJEXT             = @OBJEXT_FOR_BUILD@
+ZIPFS_BUILD	        = @ZIPFS_BUILD@
+NATIVE_ZIP		= @ZIP_PROG@
+ZIP_PROG_OPTIONS		= @ZIP_PROG_OPTIONS@
+ZIP_PROG_VFSSEARCH  = @ZIP_PROG_VFSSEARCH@
+SHARED_BUILD		= @SHARED_BUILD@
+INSTALL_LIBRARIES       = @INSTALL_LIBRARIES@
+INSTALL_MSGS            = @INSTALL_MSGS@
+
+# Minizip
+MINIZIP_OBJS = \
+        adler32.$(HOST_OBJEXT) \
+        compress.$(HOST_OBJEXT) \
+        crc32.$(HOST_OBJEXT) \
+        deflate.$(HOST_OBJEXT) \
+        infback.$(HOST_OBJEXT) \
+        inffast.$(HOST_OBJEXT) \
+        inflate.$(HOST_OBJEXT) \
+        inftrees.$(HOST_OBJEXT) \
+        ioapi.$(HOST_OBJEXT) \
+        trees.$(HOST_OBJEXT) \
+        uncompr.$(HOST_OBJEXT) \
+        zip.$(HOST_OBJEXT) \
+        zutil.$(HOST_OBJEXT) \
+        minizip.$(HOST_OBJEXT)
+
+ZIP_INSTALL_OBJS =  @ZIP_INSTALL_OBJS@
+
 #--------------------------------------------------------------------------
 # Start of rules
 #--------------------------------------------------------------------------
@@ -629,11 +673,23 @@ libraries:
 
 doc:
 
+tclzipfile: ${TCL_ZIP_FILE}
+
+
+${TCL_ZIP_FILE}:  ${ZIP_INSTALL_OBJS}
+	rm -rf ${TCL_VFS_ROOT}
+	mkdir -p ${TCL_VFS_PATH}
+	cp -a $(TOP_DIR)/library/* ${TCL_VFS_PATH}
+	cd  ${TCL_VFS_ROOT} ; ${NATIVE_ZIP} ${ZIP_PROG_OPTIONS} ../${TCL_ZIP_FILE} ${ZIP_PROG_VFSSEARCH}
+
 # The following target is configured by autoconf to generate either a shared
 # library or non-shared library for Tcl.
-${LIB_FILE}: ${STUB_LIB_FILE} ${OBJS}
+${LIB_FILE}: ${STUB_LIB_FILE} ${OBJS} ${TCL_ZIP_FILE}
 	rm -f $@
 	@MAKE_LIB@
+ifeq (${ZIPFS_BUILD},1)
+	cat ${TCL_ZIP_FILE} >> ${LIB_FILE}
+endif
 
 ${STUB_LIB_FILE}: ${STUB_LIB_OBJS}
 	@if test "x${LIB_FILE}" = "xlibtcl${MAJOR_VERSION}.${MINOR_VERSION}.dll"; then \
@@ -656,6 +712,7 @@ ${TCL_EXE}: ${TCLSH_OBJS} ${TCL_LIB_FILE} ${TCL_STUB_LIB_FILE}
 	${CC} ${CFLAGS} ${LDFLAGS} ${TCLSH_OBJS} \
 		@TCL_BUILD_LIB_SPEC@ ${TCL_STUB_LIB_FILE} ${LIBS} @EXTRA_TCLSH_LIBS@ \
 		${CC_SEARCH_FLAGS} -o ${TCL_EXE}
+		cat ${TOOL_DIR}/empty.zip >> ${TCL_EXE}
 
 # Must be empty so it doesn't conflict with rule for ${TCL_EXE} above
 ${NATIVE_TCLSH}:
@@ -667,7 +724,8 @@ Makefile: $(UNIX_DIR)/Makefile.in $(DLTEST_DIR)/Makefile.in
 
 clean: clean-packages
 	rm -rf *.a *.o libtcl* core errs *~ \#* TAGS *.E a.out \
-		errors ${TCL_EXE} ${TCLTEST_EXE} lib.exp Tcl @DTRACE_HDR@
+		errors ${TCL_EXE} ${TCLTEST_EXE} lib.exp Tcl @DTRACE_HDR@ \
+		minizip${HOST_EXEEXT} *.${HOST_OBJEXT} *.zip *.vfs
 	cd dltest ; $(MAKE) clean
 
 distclean: distclean-packages clean
@@ -730,6 +788,12 @@ gdb-test: ${TCLTEST_EXE}
 	$(GDB) ./${TCLTEST_EXE} --command=gdb.run
 	rm gdb.run
 
+lldb-test: ${TCLTEST_EXE}
+	@echo "settings set target.env-vars @LD_LIBRARY_PATH_VAR@=`pwd`:$${@LD_LIBRARY_PATH_VAR@}" > lldb.run
+	@echo "settings set target.env-vars TCL_LIBRARY=${TCL_BUILDTIME_LIBRARY}" >> lldb.run
+	$(LLDB) --source lldb.run ./${TCLTEST_EXE} -- $(TOP_DIR)/tests/all.tcl $(TESTFLAGS) -singleproc 1
+	rm lldb.run
+
 # Useful target to launch a built tcltest with the proper path,...
 runtest: ${TCLTEST_EXE}
 	$(SHELL_ENV) ./${TCLTEST_EXE}
@@ -777,7 +841,7 @@ trace-test: ${TCLTEST_EXE}
 # Installation rules
 #--------------------------------------------------------------------------
 
-INSTALL_BASE_TARGETS = install-binaries install-libraries install-msgs $(INSTALL_TZDATA)
+INSTALL_BASE_TARGETS = install-binaries $(INSTALL_LIBRARIES) $(INSTALL_MSGS) $(INSTALL_TZDATA)
 INSTALL_DOC_TARGETS = install-doc
 INSTALL_PACKAGE_TARGETS = install-packages
 INSTALL_DEV_TARGETS = install-headers
@@ -821,6 +885,25 @@ install-binaries: binaries
 	@$(INSTALL_DATA_DIR) $(LIB_INSTALL_DIR)/pkgconfig
 	@$(INSTALL_DATA) tcl.pc $(LIB_INSTALL_DIR)/pkgconfig/tcl.pc
 
+install-libraries-zipfs-shared: libraries
+	@for i in "$(SCRIPT_INSTALL_DIR)"; \
+	    do \
+	    if [ ! -d "$$i" ] ; then \
+		echo "Making directory $$i"; \
+		$(INSTALL_DATA_DIR) "$$i"; \
+		else true; \
+		fi; \
+	    done;
+	@echo "Installing library files to $(SCRIPT_INSTALL_DIR)/";
+	@for i in \
+		$(UNIX_DIR)/tclAppInit.c @LDAIX_SRC@ @DTRACE_SRC@; \
+	    do \
+	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"; \
+	    done;
+
+install-libraries-zipfs-static: install-libraries-zipfs-shared
+	$(INSTALL_DATA) ${TCL_ZIP_FILE} "$(LIB_INSTALL_DIR)" ;\
+
 install-libraries: libraries
 	@for i in "$(SCRIPT_INSTALL_DIR)"; \
 	    do \
@@ -844,8 +927,8 @@ install-libraries: libraries
 	    do \
 	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"; \
 	    done;
-	@echo "Installing package http 2.8.13 as a Tcl Module";
-	@$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.6/http-2.8.13.tm;
+	@echo "Installing package http 2.9.0 as a Tcl Module";
+	@$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.6/http-2.9.0.tm;
 	@echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/";
 	@for i in $(TOP_DIR)/library/opt/*.tcl ; \
 	    do \
@@ -870,6 +953,7 @@ install-libraries: libraries
 	    echo "if {![interp issafe]} { ::tcl::tm::roots {$(TCL_MODULE_PATH)} }" >> \
 	        "$(SCRIPT_INSTALL_DIR)"/tm.tcl; \
 	fi
+	end
 
 install-tzdata:
 	@for i in tzdata; \
@@ -1220,7 +1304,7 @@ tclNamesp.o: $(GENERIC_DIR)/tclNamesp.c $(COMPILEHDR)
 tclNotify.o: $(GENERIC_DIR)/tclNotify.c
 	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclNotify.c
 
-tclOO.o: $(GENERIC_DIR)/tclOO.c
+tclOO.o: $(GENERIC_DIR)/tclOO.c $(GENERIC_DIR)/tclOOScript.h
 	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclOO.c
 
 tclOOBasic.o: $(GENERIC_DIR)/tclOOBasic.c
@@ -1277,6 +1361,8 @@ tclPkgConfig.o: $(GENERIC_DIR)/tclPkgConfig.c
 		-DCFG_RUNTIME_SCRDIR="\"$(TCL_LIBRARY)\"" \
 		-DCFG_RUNTIME_INCDIR="\"$(includedir)\"" \
 		-DCFG_RUNTIME_DOCDIR="\"$(mandir)\"" \
+		-DCFG_RUNTIME_DLLFILE="\"$(TCL_LIB_FILE)\"" \
+		-DCFG_RUNTIME_ZIPFILE="\"$(TCL_ZIP_FILE)\"" \
 		\
 		$(GENERIC_DIR)/tclPkgConfig.c
 
@@ -1328,6 +1414,14 @@ tclVar.o: $(GENERIC_DIR)/tclVar.c
 tclZlib.o: $(GENERIC_DIR)/tclZlib.c
 	$(CC) -c $(CC_SWITCHES) $(ZLIB_INCLUDE) $(GENERIC_DIR)/tclZlib.c
 
+tclZipfs.o: $(GENERIC_DIR)/tclZipfs.c
+	$(CC) -c $(CC_SWITCHES) \
+	-DCFG_RUNTIME_DLLFILE="\"$(TCL_LIB_FILE)\"" \
+	-DCFG_RUNTIME_ZIPFILE="\"$(TCL_ZIP_FILE)\"" \
+	-DCFG_RUNTIME_LIBDIR="\"$(libdir)\"" \
+	-DCFG_RUNTIME_SCRDIR="\"$(TCL_LIBRARY)\"" \
+	$(ZLIB_INCLUDE) -I$(ZLIB_DIR)/contrib/minizip $(GENERIC_DIR)/tclZipfs.c
+
 tclTest.o: $(GENERIC_DIR)/tclTest.c $(IOHDR) $(TCLREHDRS)
 	$(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclTest.c
 
@@ -1736,6 +1830,54 @@ tclOOStubLib.o: $(GENERIC_DIR)/tclOOStubLib.c
 	$(CC) -c $(CC_SWITCHES) $<
 
 #--------------------------------------------------------------------------
+# Minizip implementation
+#--------------------------------------------------------------------------
+adler32.$(HOST_OBJEXT):
+	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/adler32.c
+
+compress.$(HOST_OBJEXT):
+	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/compress.c
+
+crc32.$(HOST_OBJEXT):
+	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/crc32.c
+
+deflate.$(HOST_OBJEXT):
+	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/deflate.c
+
+ioapi.$(HOST_OBJEXT):
+	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/ioapi.c
+
+infback.$(HOST_OBJEXT):
+	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/infback.c
+
+inffast.$(HOST_OBJEXT):
+	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/inffast.c
+
+inflate.$(HOST_OBJEXT):
+	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/inflate.c
+
+inftrees.$(HOST_OBJEXT):
+	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/inftrees.c
+
+trees.$(HOST_OBJEXT):
+	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/trees.c
+
+uncompr.$(HOST_OBJEXT):
+	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/uncompr.c
+
+zip.$(HOST_OBJEXT):
+	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/zip.c
+
+zutil.$(HOST_OBJEXT):
+	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/zutil.c
+
+minizip.$(HOST_OBJEXT):
+	$(HOST_CC) -o $@ -I$(ZLIB_DIR)  -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/minizip.c
+
+minizip${HOST_EXEEXT}: $(MINIZIP_OBJS)
+	$(HOST_CC) -o $@ $(MINIZIP_OBJS)
+
+#--------------------------------------------------------------------------
 # Bundled Package targets
 #--------------------------------------------------------------------------
 
@@ -1888,6 +2030,11 @@ $(GENERIC_DIR)/tclOOStubInit.c: $(GENERIC_DIR)/tclOO.decls
 	@echo "Developers may want to run \"make genstubs\" to regenerate."
 	@echo "This warning can be safely ignored, do not report as a bug!"
 
+$(GENERIC_DIR)/tclOOScript.h: $(GENERIC_DIR)/tclOOScript.tcl
+	@echo "Warning: tclOOScript.h may be out of date."
+	@echo "Developers may want to run \"make genscript\" to regenerate."
+	@echo "This warning can be safely ignored, do not report as a bug!"
+
 genstubs:
 	$(NATIVE_TCLSH) $(TOOL_DIR)/genStubs.tcl $(GENERIC_DIR) \
 		$(GENERIC_DIR)/tcl.decls $(GENERIC_DIR)/tclInt.decls \
@@ -1895,6 +2042,10 @@ genstubs:
 	$(NATIVE_TCLSH) $(TOOL_DIR)/genStubs.tcl $(GENERIC_DIR) \
 		$(GENERIC_DIR)/tclOO.decls
 
+genscript:
+	$(NATIVE_TCLSH) $(TOOL_DIR)/makeHeader.tcl \
+		$(GENERIC_DIR)/tclOOScript.tcl $(GENERIC_DIR)/tclOOScript.h
+
 #
 # Target to check that all exported functions have an entry in the stubs
 # tables.
@@ -2141,6 +2292,7 @@ BUILD_HTML = \
 .PHONY: install-tzdata install-msgs
 .PHONY: packages configure-packages test-packages clean-packages
 .PHONY: dist-packages distclean-packages install-packages
+.PHONY: iinstall-libraries-zipfs-shared install-libraries-zipfs-static tclzipfile
 
 #--------------------------------------------------------------------------
 # DO NOT DELETE THIS LINE -- make depend depends on it.
diff --git a/unix/configure b/unix/configure
index b6ead40..aa7953b 100755
--- a/unix/configure
+++ b/unix/configure
@@ -664,6 +664,16 @@ TCL_PATCH_LEVEL
 TCL_MINOR_VERSION
 TCL_MAJOR_VERSION
 TCL_VERSION
+INSTALL_MSGS
+INSTALL_LIBRARIES
+TCL_ZIP_FILE
+ZIPFS_BUILD
+ZIP_INSTALL_OBJS
+ZIP_PROG_VFSSEARCH
+ZIP_PROG_OPTIONS
+ZIP_PROG
+EXEEXT_FOR_BUILD
+CC_FOR_BUILD
 DTRACE
 LDFLAGS_DEFAULT
 CFLAGS_DEFAULT
@@ -699,6 +709,7 @@ ZLIB_INCLUDE
 ZLIB_SRCS
 ZLIB_OBJS
 TCLSH_PROG
+SHARED_BUILD
 EGREP
 GREP
 CPP
@@ -747,7 +758,8 @@ PACKAGE_VERSION
 PACKAGE_TARNAME
 PACKAGE_NAME
 PATH_SEPARATOR
-SHELL'
+SHELL
+OBJEXT_FOR_BUILD'
 ac_subst_files=''
 ac_user_opts='
 enable_option_checking
@@ -766,6 +778,7 @@ enable_langinfo
 enable_dll_unloading
 with_tzdata
 enable_dtrace
+enable_zipfs
 enable_framework
 '
       ac_precious_vars='build_alias
@@ -1405,6 +1418,7 @@ Optional Features:
                           startup, otherwise use old heuristic (default: on)
   --enable-dll-unloading  enable the 'unload' command (default: on)
   --enable-dtrace         build with DTrace support (default: off)
+  --enable-zipfs          build with Zipfs support (default: on)
   --enable-framework      package shared libraries in MacOSX frameworks
                           (default: off)
 
@@ -3316,6 +3330,7 @@ _ACEOF
 esac
 
 
+
 #--------------------------------------------------------------------
 # Supply substitutes for missing POSIX header files.  Special notes:
 #	- stdlib.h doesn't define strtol, strtoul, or
@@ -4497,6 +4512,7 @@ $as_echo "#define STATIC_BUILD 1" >>confdefs.h
     fi
 
 
+
 #--------------------------------------------------------------------
 # Look for a native installed tclsh binary (if available)
 # If one cannot be found then use the binary we build (fails for
@@ -10113,6 +10129,186 @@ fi
 $as_echo "$tcl_ok" >&6; }
 
 #--------------------------------------------------------------------
+#	Zipfs support - Tip 430
+#--------------------------------------------------------------------
+# Check whether --enable-zipfs was given.
+if test "${enable_zipfs+set}" = set; then :
+  enableval=$enable_zipfs; tcl_ok=$enableval
+else
+  tcl_ok=yes
+fi
+
+if test "$tcl_ok" = "yes" ; then
+    #
+    # Find a native compiler
+    #
+    # Put a plausible default for CC_FOR_BUILD in Makefile.
+    if test -z "$CC_FOR_BUILD"; then
+      if test "x$cross_compiling" = "xno"; then
+        CC_FOR_BUILD='$(CC)'
+      else
+        { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gcc" >&5
+$as_echo_n "checking for gcc... " >&6; }
+        if ${ac_cv_path_cc+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+
+            search_path=`echo ${PATH} | sed -e 's/:/ /g'`
+            for dir in $search_path ; do
+                for j in `ls -r $dir/gcc 2> /dev/null` \
+                        `ls -r $dir/gcc 2> /dev/null` ; do
+                    if test x"$ac_cv_path_cc" = x ; then
+                        if test -f "$j" ; then
+                            ac_cv_path_cc=$j
+                            break
+                        fi
+                    fi
+                done
+            done
+
+fi
+
+      fi
+    fi
+
+    # Also set EXEEXT_FOR_BUILD.
+    if test "x$cross_compiling" = "xno"; then
+      EXEEXT_FOR_BUILD='$(EXEEXT)'
+      OBJEXT_FOR_BUILD='$(OBJEXT)'
+    else
+      OBJEXT_FOR_BUILD='.no'
+      { $as_echo "$as_me:${as_lineno-$LINENO}: checking for build system executable suffix" >&5
+$as_echo_n "checking for build system executable suffix... " >&6; }
+if ${bfd_cv_build_exeext+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  rm -f conftest*
+         echo 'int main () { return 0; }' > conftest.c
+         bfd_cv_build_exeext=
+         ${CC_FOR_BUILD} -o conftest conftest.c 1>&5 2>&5
+         for file in conftest.*; do
+           case $file in
+           *.c | *.o | *.obj | *.ilk | *.pdb) ;;
+           *) bfd_cv_build_exeext=`echo $file | sed -e s/conftest//` ;;
+           esac
+         done
+         rm -f conftest*
+         test x"${bfd_cv_build_exeext}" = x && bfd_cv_build_exeext=no
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $bfd_cv_build_exeext" >&5
+$as_echo "$bfd_cv_build_exeext" >&6; }
+      EXEEXT_FOR_BUILD=""
+      test x"${bfd_cv_build_exeext}" != xno && EXEEXT_FOR_BUILD=${bfd_cv_build_exeext}
+    fi
+
+    #
+    # Find a native zip implementation
+    #
+
+    ZIP_PROG=""
+    ZIP_PROG_OPTIONS=""
+    ZIP_PROG_VFSSEARCH=""
+    ZIP_INSTALL_OBJS=""
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for zip" >&5
+$as_echo_n "checking for zip... " >&6; }
+    # If our native tclsh processes the "install" command line option
+    # we can use it to mint zip files
+    if $TCLSH_PROG install; then :
+
+      ZIP_PROG=${TCLSH_PROG}
+      ZIP_PROG_OPTIONS="install mkzip"
+      ZIP_PROG_VFSSEARCH="."
+      { $as_echo "$as_me:${as_lineno-$LINENO}: result: Can use Native Tclsh for Zip encoding" >&5
+$as_echo "Can use Native Tclsh for Zip encoding" >&6; }
+
+fi
+
+    if test "x$ZIP_PROG" = "x" ; then
+        { $as_echo "$as_me:${as_lineno-$LINENO}: checking for zip" >&5
+$as_echo_n "checking for zip... " >&6; }
+        if ${ac_cv_path_zip+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+
+        search_path=`echo ${PATH} | sed -e 's/:/ /g'`
+        for dir in $search_path ; do
+            for j in `ls -r $dir/zip 2> /dev/null` \
+                `ls -r $dir/zip 2> /dev/null` ; do
+            if test x"$ac_cv_path_zip" = x ; then
+                if test -f "$j" ; then
+                ac_cv_path_zip=$j
+                break
+                fi
+            fi
+            done
+        done
+
+fi
+
+        if test -f "$ac_cv_path_zip" ; then
+            ZIP_PROG="$ac_cv_path_zip "
+            { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ZIP_PROG" >&5
+$as_echo "$ZIP_PROG" >&6; }
+            ZIP_PROG_OPTIONS="-rq"
+            ZIP_PROG_VFSSEARCH="."
+            { $as_echo "$as_me:${as_lineno-$LINENO}: result: Found INFO Zip in environment" >&5
+$as_echo "Found INFO Zip in environment" >&6; }
+            # Use standard arguments for zip
+        else
+            # It is not an error if an installed version of Zip can't be located.
+            # We can use the locally distributed minizip instead
+            ZIP_PROG="../minizip${EXEEXT_FOR_BUILD}"
+            ZIP_PROG_OPTIONS="-o -r"
+            ZIP_PROG_VFSSEARCH="."
+            ZIP_INSTALL_OBJS="minizip${EXEEXT_FOR_BUILD}"
+            { $as_echo "$as_me:${as_lineno-$LINENO}: result: No zip found on PATH building minizip" >&5
+$as_echo "No zip found on PATH building minizip" >&6; }
+        fi
+    fi
+
+
+
+
+
+	ZIPFS_BUILD=1
+	TCL_ZIP_FILE=libtcl_${TCL_MAJOR_VERSION}_${TCL_MINOR_VERSION}_${TCL_PATCH_LEVEL}.zip
+else
+	ZIPFS_BUILD=0
+	TCL_ZIP_FILE=
+fi
+# Do checking message here to not mess up interleaved configure output
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for building with zipfs" >&5
+$as_echo_n "checking for building with zipfs... " >&6; }
+if test "${ZIPFS_BUILD}" = 1; then
+    if test "${SHARED_BUILD}" = 0; then
+       ZIPFS_BUILD=2;
+
+$as_echo "#define ZIPFS_BUILD 2" >>confdefs.h
+
+       INSTALL_LIBRARIES=install-libraries-zipfs-static
+       { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+     else
+
+$as_echo "#define ZIPFS_BUILD 1" >>confdefs.h
+\
+       INSTALL_LIBRARIES=install-libraries-zipfs-shared
+       { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+    fi
+else
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+INSTALL_LIBRARIES=install-libraries
+INSTALL_MSGS=install-msgs
+fi
+
+
+
+
+
+
+#--------------------------------------------------------------------
 # The check below checks whether the cpuid instruction is usable.
 #--------------------------------------------------------------------
 
@@ -10398,6 +10594,7 @@ TCL_SHARED_BUILD=${SHARED_BUILD}
 
 
 
+
 ac_config_files="$ac_config_files Makefile:../unix/Makefile.in dltest/Makefile:../unix/dltest/Makefile.in tclConfig.sh:../unix/tclConfig.sh.in tcl.pc:../unix/tcl.pc.in"
 
 cat >confcache <<\_ACEOF
diff --git a/unix/configure.ac b/unix/configure.ac
index 609312b..bd8ea97 100644
--- a/unix/configure.ac
+++ b/unix/configure.ac
@@ -86,6 +86,7 @@ fi
 AC_PROG_CC
 AC_C_INLINE
 
+
 #--------------------------------------------------------------------
 # Supply substitutes for missing POSIX header files.  Special notes:
 #	- stdlib.h doesn't define strtol, strtoul, or
@@ -782,6 +783,52 @@ fi
 AC_MSG_RESULT([$tcl_ok])
 
 #--------------------------------------------------------------------
+#	Zipfs support - Tip 430
+#--------------------------------------------------------------------
+AC_ARG_ENABLE(zipfs,
+    AC_HELP_STRING([--enable-zipfs],
+	[build with Zipfs support (default: on)]),
+    [tcl_ok=$enableval], [tcl_ok=yes])
+if test "$tcl_ok" = "yes" ; then
+    #
+    # Find a native compiler
+    #
+    AX_CC_FOR_BUILD
+    #
+    # Find a native zip implementation
+    #
+    SC_ZIPFS_SUPPORT
+	ZIPFS_BUILD=1
+	TCL_ZIP_FILE=libtcl_${TCL_MAJOR_VERSION}_${TCL_MINOR_VERSION}_${TCL_PATCH_LEVEL}.zip
+else
+	ZIPFS_BUILD=0
+	TCL_ZIP_FILE=
+fi
+# Do checking message here to not mess up interleaved configure output
+AC_MSG_CHECKING([for building with zipfs])
+if test "${ZIPFS_BUILD}" = 1; then
+    if test "${SHARED_BUILD}" = 0; then
+       ZIPFS_BUILD=2;
+       AC_DEFINE(ZIPFS_BUILD, 2, [Are we building with zipfs enabled?])
+       INSTALL_LIBRARIES=install-libraries-zipfs-static
+       AC_MSG_RESULT([yes])
+     else
+       AC_DEFINE(ZIPFS_BUILD, 1, [Are we building with zipfs enabled?])\
+       INSTALL_LIBRARIES=install-libraries-zipfs-shared
+       AC_MSG_RESULT([yes])
+    fi
+else
+AC_MSG_RESULT([no])
+INSTALL_LIBRARIES=install-libraries
+INSTALL_MSGS=install-msgs
+fi
+AC_SUBST(ZIPFS_BUILD)
+AC_SUBST(TCL_ZIP_FILE)
+AC_SUBST(INSTALL_LIBRARIES)
+AC_SUBST(INSTALL_MSGS)
+
+
+#--------------------------------------------------------------------
 # The check below checks whether the cpuid instruction is usable.
 #--------------------------------------------------------------------
 
@@ -951,6 +998,7 @@ AC_SUBST(TCL_PATCH_LEVEL)
 AC_SUBST(TCL_YEAR)
 AC_SUBST(PKG_CFG_ARGS)
 
+AC_SUBST(TCL_ZIP_FILE)
 AC_SUBST(TCL_LIB_FILE)
 AC_SUBST(TCL_LIB_FLAG)
 AC_SUBST(TCL_LIB_SPEC)
diff --git a/unix/installManPage b/unix/installManPage
index 1f1cbde..09a31dd 100755
--- a/unix/installManPage
+++ b/unix/installManPage
@@ -60,20 +60,35 @@ test -z "$SymOrLoc" && SymOrLoc="$Dir/"
 #
 Names=`sed -n '
 #                               Look for a line that starts with .SH NAME
-    /^\.SH NAME/{
-#                               Read next line
-	n
-#                               Remove all commas ...
-	s/,//g
-#                               ... and backslash-escaped spaces.
-	s/\\\ //g
-#                               Delete from \- to the end of line
-	s/ \\\-.*//
-#                               Convert all non-space non-alphanum sequences
-#                               to single underscores.
-	s/[^ A-Za-z0-9][^ A-Za-z0-9]*/_/g
-#                               print the result and exit
-	p;q
+    /^\.SH NAME/,/^\./{
+
+
+	/^\./!{
+
+	    # Remove all commas...
+	    s/,//g
+
+	    # ... and backslash-escaped spaces.
+	    s/\\\ //g
+
+	    /\\\-.*/{
+		# Delete from \- to the end of line
+		s/ \\\-.*//
+		h
+		s/.*/./
+		x
+	    }
+
+	    # Convert all non-space non-alphanum sequences
+	    # to single underscores.
+	    s/[^ A-Za-z0-9][^ A-Za-z0-9]*/_/g
+	    p
+	    g
+	    /^\./{
+		q
+	    }
+    }
+
     }' $ManPage`
 
 if test -z "$Names" ; then
diff --git a/unix/tcl.m4 b/unix/tcl.m4
index 3df859a..44403dc 100644
--- a/unix/tcl.m4
+++ b/unix/tcl.m4
@@ -91,11 +91,13 @@ AC_DEFUN([SC_PATH_TCLCONFIG], [
 		for i in `ls -d ${libdir} 2>/dev/null` \
 			`ls -d ${exec_prefix}/lib 2>/dev/null` \
 			`ls -d ${prefix}/lib 2>/dev/null` \
-			`ls -d /usr/contrib/lib 2>/dev/null` \
 			`ls -d /usr/local/lib 2>/dev/null` \
+			`ls -d /usr/contrib/lib 2>/dev/null` \
 			`ls -d /usr/pkg/lib 2>/dev/null` \
 			`ls -d /usr/lib 2>/dev/null` \
 			`ls -d /usr/lib64 2>/dev/null` \
+			`ls -d /usr/local/lib/tcl8.7 2>/dev/null` \
+			`ls -d /usr/local/lib/tcl/tcl8.7 2>/dev/null` \
 			; do
 		    if test -f "$i/tclConfig.sh" ; then
 			ac_cv_c_tclconfig="`(cd $i; pwd)`"
@@ -224,8 +226,11 @@ AC_DEFUN([SC_PATH_TKCONFIG], [
 			`ls -d ${prefix}/lib 2>/dev/null` \
 			`ls -d /usr/local/lib 2>/dev/null` \
 			`ls -d /usr/contrib/lib 2>/dev/null` \
+			`ls -d /usr/pkg/lib 2>/dev/null` \
 			`ls -d /usr/lib 2>/dev/null` \
 			`ls -d /usr/lib64 2>/dev/null` \
+			`ls -d /usr/local/lib/tk8.7 2>/dev/null` \
+			`ls -d /usr/local/lib/tcl/tk8.7 2>/dev/null` \
 			; do
 		    if test -f "$i/tkConfig.sh" ; then
 			ac_cv_c_tkconfig="`(cd $i; pwd)`"
@@ -542,6 +547,7 @@ AC_DEFUN([SC_ENABLE_SHARED], [
 	SHARED_BUILD=0
 	AC_DEFINE(STATIC_BUILD, 1, [Is this a static build?])
     fi
+    AC_SUBST(SHARED_BUILD)
 ])
 
 #------------------------------------------------------------------------
@@ -2956,6 +2962,140 @@ if test "x$NEED_FAKE_RFC2553" = "x1"; then
    AC_CHECK_FUNC(strlcpy)
 fi
 ])
+
+#------------------------------------------------------------------------
+# SC_CC_FOR_BUILD
+#	For cross compiles, locate a C compiler that can generate native binaries.
+#
+# Arguments:
+#	none
+#
+# Results:
+#	Substitutes the following vars:
+#		CC_FOR_BUILD
+#		EXEEXT_FOR_BUILD
+#------------------------------------------------------------------------
+
+dnl Get a default for CC_FOR_BUILD to put into Makefile.
+AC_DEFUN([AX_CC_FOR_BUILD],[# Put a plausible default for CC_FOR_BUILD in Makefile.
+    if test -z "$CC_FOR_BUILD"; then
+      if test "x$cross_compiling" = "xno"; then
+        CC_FOR_BUILD='$(CC)'
+      else
+        AC_MSG_CHECKING([for gcc])
+        AC_CACHE_VAL(ac_cv_path_cc, [
+            search_path=`echo ${PATH} | sed -e 's/:/ /g'`
+            for dir in $search_path ; do
+                for j in `ls -r $dir/gcc 2> /dev/null` \
+                        `ls -r $dir/gcc 2> /dev/null` ; do
+                    if test x"$ac_cv_path_cc" = x ; then
+                        if test -f "$j" ; then
+                            ac_cv_path_cc=$j
+                            break
+                        fi
+                    fi
+                done
+            done
+        ])
+      fi
+    fi
+    AC_SUBST(CC_FOR_BUILD)
+    # Also set EXEEXT_FOR_BUILD.
+    if test "x$cross_compiling" = "xno"; then
+      EXEEXT_FOR_BUILD='$(EXEEXT)'
+      OBJEXT_FOR_BUILD='$(OBJEXT)'
+    else
+      OBJEXT_FOR_BUILD='.no'
+      AC_CACHE_CHECK([for build system executable suffix], bfd_cv_build_exeext,
+        [rm -f conftest*
+         echo 'int main () { return 0; }' > conftest.c
+         bfd_cv_build_exeext=
+         ${CC_FOR_BUILD} -o conftest conftest.c 1>&5 2>&5
+         for file in conftest.*; do
+           case $file in
+           *.c | *.o | *.obj | *.ilk | *.pdb) ;;
+           *) bfd_cv_build_exeext=`echo $file | sed -e s/conftest//` ;;
+           esac
+         done
+         rm -f conftest*
+         test x"${bfd_cv_build_exeext}" = x && bfd_cv_build_exeext=no])
+      EXEEXT_FOR_BUILD=""
+      test x"${bfd_cv_build_exeext}" != xno && EXEEXT_FOR_BUILD=${bfd_cv_build_exeext}
+    fi
+    AC_SUBST(EXEEXT_FOR_BUILD)])dnl
+    AC_SUBST(OBJEXT_FOR_BUILD)])dnl
+])
+
+
+#------------------------------------------------------------------------
+# SC_ZIPFS_SUPPORT
+#	Locate a zip encoder installed on the system path, or none.
+#
+# Arguments:
+#	none
+#
+# Results:
+#	Substitutes the following vars:
+#		ZIP_PROG
+#       ZIP_PROG_OPTIONS
+#       ZIP_PROG_VFSSEARCH
+#       ZIP_INSTALL_OBJS
+#------------------------------------------------------------------------
+
+AC_DEFUN([SC_ZIPFS_SUPPORT], [
+    ZIP_PROG=""
+    ZIP_PROG_OPTIONS=""
+    ZIP_PROG_VFSSEARCH=""
+    ZIP_INSTALL_OBJS=""
+    AC_MSG_CHECKING([for zip])
+    # If our native tclsh processes the "install" command line option
+    # we can use it to mint zip files
+    AS_IF([$TCLSH_PROG install],[
+      ZIP_PROG=${TCLSH_PROG}
+      ZIP_PROG_OPTIONS="install mkzip"
+      ZIP_PROG_VFSSEARCH="."
+      AC_MSG_RESULT([Can use Native Tclsh for Zip encoding])
+    ])
+
+    if test "x$ZIP_PROG" = "x" ; then
+        AC_MSG_CHECKING([for zip])
+        AC_CACHE_VAL(ac_cv_path_zip, [
+        search_path=`echo ${PATH} | sed -e 's/:/ /g'`
+        for dir in $search_path ; do
+            for j in `ls -r $dir/zip 2> /dev/null` \
+                `ls -r $dir/zip 2> /dev/null` ; do
+            if test x"$ac_cv_path_zip" = x ; then
+                if test -f "$j" ; then
+                ac_cv_path_zip=$j
+                break
+                fi
+            fi
+            done
+        done
+        ])
+        if test -f "$ac_cv_path_zip" ; then
+            ZIP_PROG="$ac_cv_path_zip "
+            AC_MSG_RESULT([$ZIP_PROG])
+            ZIP_PROG_OPTIONS="-rq"
+            ZIP_PROG_VFSSEARCH="."
+            AC_MSG_RESULT([Found INFO Zip in environment])
+            # Use standard arguments for zip
+        else
+            # It is not an error if an installed version of Zip can't be located.
+            # We can use the locally distributed minizip instead
+            ZIP_PROG="../minizip${EXEEXT_FOR_BUILD}"
+            ZIP_PROG_OPTIONS="-o -r"
+            ZIP_PROG_VFSSEARCH="."
+            ZIP_INSTALL_OBJS="minizip${EXEEXT_FOR_BUILD}"
+            AC_MSG_RESULT([No zip found on PATH building minizip])
+        fi
+    fi
+    AC_SUBST(ZIP_PROG)
+    AC_SUBST(ZIP_PROG_OPTIONS)
+    AC_SUBST(ZIP_PROG_VFSSEARCH)
+    AC_SUBST(ZIP_INSTALL_OBJS)
+])
+
 # Local Variables:
 # mode: autoconf
 # End:
diff --git a/unix/tcl.pc.in b/unix/tcl.pc.in
index 846cb11..ca932d2 100644
--- a/unix/tcl.pc.in
+++ b/unix/tcl.pc.in
@@ -4,6 +4,8 @@ prefix=@prefix@
 exec_prefix=@exec_prefix@
 libdir=@libdir@
 includedir=@includedir@
+libfile=@TCL_LIB_FILE@
+zipfile=@TCL_ZIP_FILE@
 
 Name: Tool Command Language
 Description: Tcl is a powerful, easy-to-learn dynamic programming language, suitable for a wide range of uses.
diff --git a/unix/tclAppInit.c b/unix/tclAppInit.c
index 9bbc88b..3587f35 100644
--- a/unix/tclAppInit.c
+++ b/unix/tclAppInit.c
@@ -79,6 +79,8 @@ main(
 
 #ifdef TCL_LOCAL_MAIN_HOOK
     TCL_LOCAL_MAIN_HOOK(&argc, &argv);
+#else
+    TclZipfs_AppHook(&argc, &argv);
 #endif
 
     Tcl_Main(argc, argv, TCL_LOCAL_APPINIT);
diff --git a/unix/tclConfig.sh.in b/unix/tclConfig.sh.in
index 1edee2f..743b5a5 100644
--- a/unix/tclConfig.sh.in
+++ b/unix/tclConfig.sh.in
@@ -39,6 +39,9 @@ TCL_SHARED_BUILD=@TCL_SHARED_BUILD@
 # The name of the Tcl library (may be either a .a file or a shared library):
 TCL_LIB_FILE='@TCL_LIB_FILE@'
 
+# The name of a zip containing the /library and /encodings (may be either a .zip file or a shared library):
+TCL_ZIP_FILE='@TCL_ZIP_FILE@'
+
 # Additional libraries to use when linking Tcl.
 TCL_LIBS='@TCL_LIBS@'
 
diff --git a/unix/tclEpollNotfy.c b/unix/tclEpollNotfy.c
index 8a083d8..2abfd47 100644
--- a/unix/tclEpollNotfy.c
+++ b/unix/tclEpollNotfy.c
@@ -88,7 +88,7 @@ typedef struct {
 
 LIST_HEAD(PlatformReadyFileHandlerList, FileHandler);
 typedef struct ThreadSpecificData {
-    FileHandler *triggerFilePtr; 
+    FileHandler *triggerFilePtr;
     FileHandler *firstFileHandlerPtr;
 				/* Pointer to head of file handler list. */
     struct PlatformReadyFileHandlerList firstReadyFileHandlerPtr;
@@ -114,9 +114,9 @@ typedef struct ThreadSpecificData {
 
 static Tcl_ThreadDataKey dataKey;
 
-void PlatformEventsControl(FileHandler *filePtr, ThreadSpecificData *tsdPtr, int op, int isNew);
+static void PlatformEventsControl(FileHandler *filePtr, ThreadSpecificData *tsdPtr, int op, int isNew);
 static void PlatformEventsFinalize(void);
-void PlatformEventsInit(void);
+static void PlatformEventsInit(void);
 static int PlatformEventsTranslate(struct epoll_event *event);
 static int PlatformEventsWait(struct epoll_event *events, size_t numEvents, struct timeval *timePtr);
 
diff --git a/unix/tclKqueueNotfy.c b/unix/tclKqueueNotfy.c
index c781ce2..6d685ad 100644
--- a/unix/tclKqueueNotfy.c
+++ b/unix/tclKqueueNotfy.c
@@ -104,9 +104,9 @@ typedef struct ThreadSpecificData {
 
 static Tcl_ThreadDataKey dataKey;
 
-void PlatformEventsControl(FileHandler *filePtr, ThreadSpecificData *tsdPtr, int op, int isNew);
+static void PlatformEventsControl(FileHandler *filePtr, ThreadSpecificData *tsdPtr, int op, int isNew);
 static void PlatformEventsFinalize(void);
-void PlatformEventsInit(void);
+static void PlatformEventsInit(void);
 static int PlatformEventsTranslate(struct kevent *eventPtr);
 static int PlatformEventsWait(struct kevent *events, size_t numEvents, struct timeval *timePtr);
 
diff --git a/unix/tclUnixChan.c b/unix/tclUnixChan.c
index ced684a..435579a 100644
--- a/unix/tclUnixChan.c
+++ b/unix/tclUnixChan.c
@@ -383,7 +383,7 @@ FileSeekProc(
      */
 
     oldLoc = TclOSseek(fsPtr->fd, (Tcl_SeekOffset) 0, SEEK_CUR);
-    if (oldLoc == Tcl_LongAsWide(-1)) {
+    if (oldLoc == -1) {
 	/*
 	 * Bad things are happening. Error out...
 	 */
@@ -398,14 +398,14 @@ FileSeekProc(
      * Check for expressability in our return type, and roll-back otherwise.
      */
 
-    if (newLoc > Tcl_LongAsWide(INT_MAX)) {
+    if (newLoc > INT_MAX) {
 	*errorCodePtr = EOVERFLOW;
 	TclOSseek(fsPtr->fd, (Tcl_SeekOffset) oldLoc, SEEK_SET);
 	return -1;
     } else {
-	*errorCodePtr = (newLoc == Tcl_LongAsWide(-1)) ? errno : 0;
+	*errorCodePtr = (newLoc == -1) ? errno : 0;
     }
-    return (int) Tcl_WideAsLong(newLoc);
+    return (int) newLoc;
 }
 
 /*
diff --git a/unix/tclUnixPort.h b/unix/tclUnixPort.h
index a90b471..57853c4 100644
--- a/unix/tclUnixPort.h
+++ b/unix/tclUnixPort.h
@@ -162,7 +162,7 @@ typedef off_t		Tcl_SeekOffset;
 #   include "../compat/unistd.h"
 #endif
 
-extern int TclUnixSetBlockingMode(int fd, int mode);
+MODULE_SCOPE int TclUnixSetBlockingMode(int fd, int mode);
 
 #include <utime.h>
 
@@ -707,14 +707,14 @@ typedef int socklen_t;
 #include <pwd.h>
 #include <grp.h>
 
-extern struct passwd *	TclpGetPwNam(const char *name);
-extern struct group *	TclpGetGrNam(const char *name);
-extern struct passwd *	TclpGetPwUid(uid_t uid);
-extern struct group *	TclpGetGrGid(gid_t gid);
-extern struct hostent *	TclpGetHostByName(const char *name);
-extern struct hostent *	TclpGetHostByAddr(const char *addr,
+MODULE_SCOPE struct passwd *	TclpGetPwNam(const char *name);
+MODULE_SCOPE struct group *	TclpGetGrNam(const char *name);
+MODULE_SCOPE struct passwd *	TclpGetPwUid(uid_t uid);
+MODULE_SCOPE struct group *	TclpGetGrGid(gid_t gid);
+MODULE_SCOPE struct hostent *	TclpGetHostByName(const char *name);
+MODULE_SCOPE struct hostent *	TclpGetHostByAddr(const char *addr,
 				    int length, int type);
-extern void *TclpMakeTcpClientChannelMode(
+MODULE_SCOPE void *TclpMakeTcpClientChannelMode(
 				    void *tcpSocket, int mode);
 
 #endif /* _TCLUNIXPORT */
diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c
index 980ab4d..2793d3b 100644
--- a/unix/tclUnixSock.c
+++ b/unix/tclUnixSock.c
@@ -1124,7 +1124,7 @@ TcpGetHandleProc(
  * TcpAsyncCallback --
  *
  *	Called by the event handler that TcpConnect sets up internally for
- *	[socket -async] to get notified when the asyncronous connection
+ *	[socket -async] to get notified when the asynchronous connection
  *	attempt has succeeded or failed.
  *
  * ----------------------------------------------------------------------
@@ -1157,7 +1157,7 @@ TcpAsyncCallback(
  *
  * Remarks:
  *	A single host name may resolve to more than one IP address, e.g. for
- *	an IPv4/IPv6 dual stack host. For handling asyncronously connecting
+ *	an IPv4/IPv6 dual stack host. For handling asynchronously connecting
  *	sockets in the background for such hosts, this function can act as a
  *	coroutine. On the first call, it sets up the control variables for the
  *	two nested loops over the local and remote addresses. Once the first
@@ -1165,7 +1165,7 @@ TcpAsyncCallback(
  *	event handler for that socket, and returns. When the callback occurs,
  *	control is transferred to the "reenter" label, right after the initial
  *	return and the loops resume as if they had never been interrupted.
- *	For syncronously connecting sockets, the loops work the usual way.
+ *	For synchronously connecting sockets, the loops work the usual way.
  *
  * ----------------------------------------------------------------------
  */
diff --git a/unix/tclUnixThrd.c b/unix/tclUnixThrd.c
index e1bc074..925f8b8 100644
--- a/unix/tclUnixThrd.c
+++ b/unix/tclUnixThrd.c
@@ -424,7 +424,7 @@ TclpInitUnlock(void)
  *	in finalization; it is hidden during creation of the objects.
  *
  *	This lock must be different than the initLock because the initLock is
- *	held during creation of syncronization objects.
+ *	held during creation of synchronization objects.
  *
  * Results:
  *	None.
@@ -516,7 +516,7 @@ Tcl_GetAllocMutex(void)
  *	None.
  *
  * Side effects:
- *	May block the current thread. The mutex is aquired when this returns.
+ *	May block the current thread. The mutex is acquired when this returns.
  *	Will allocate memory for a pthread_mutex_t and initialize this the
  *	first time this Tcl_Mutex is used.
  *
@@ -620,7 +620,7 @@ TclpFinalizeMutex(
  *	None.
  *
  * Side effects:
- *	May block the current thread. The mutex is aquired when this returns.
+ *	May block the current thread. The mutex is acquired when this returns.
  *	Will allocate memory for a pthread_mutex_t and initialize this the
  *	first time this Tcl_Mutex is used.
  *
diff --git a/win/Makefile.in b/win/Makefile.in
index 4e75b06..0f15152 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -137,6 +137,11 @@ DDEDOTVER		= @TCL_DDE_MAJOR_VERSION@.@TCL_DDE_MINOR_VERSION@
 REGVER			= @TCL_REG_MAJOR_VERSION@@TCL_REG_MINOR_VERSION@
 REGDOTVER		= @TCL_REG_MAJOR_VERSION@.@TCL_REG_MINOR_VERSION@
 
+TCL_ZIP_FILE		= @TCL_ZIP_FILE@
+TCL_VFS_PATH		= libtcl.vfs/tcl_library
+TCL_VFS_ROOT		= libtcl.vfs
+
+
 TCL_STUB_LIB_FILE	= @TCL_STUB_LIB_FILE@
 TCL_DLL_FILE		= @TCL_DLL_FILE@
 TCL_LIB_FILE		= @TCL_LIB_FILE@
@@ -196,6 +201,45 @@ SHELL		= @SHELL@
 RM		= rm -f
 COPY		= cp
 
+###
+# Tip 430 - ZipFS Modifications
+###
+
+TCL_ZIP_FILE		= @TCL_ZIP_FILE@
+TCL_VFS_PATH		= libtcl.vfs/tcl_library
+TCL_VFS_ROOT		= libtcl.vfs
+
+HOST_CC		        = @CC_FOR_BUILD@
+HOST_EXEEXT             = @EXEEXT_FOR_BUILD@
+HOST_OBJEXT             = @OBJEXT_FOR_BUILD@
+ZIPFS_BUILD	        = @ZIPFS_BUILD@
+NATIVE_ZIP		= @ZIP_PROG@
+ZIP_PROG_OPTIONS		= @ZIP_PROG_OPTIONS@
+ZIP_PROG_VFSSEARCH  = @ZIP_PROG_VFSSEARCH@
+SHARED_BUILD		= @SHARED_BUILD@
+INSTALL_MSGS            = @INSTALL_MSGS@
+INSTALL_LIBRARIES       = @INSTALL_LIBRARIES@
+
+# Minizip
+MINIZIP_OBJS = \
+        adler32.$(HOST_OBJEXT) \
+        compress.$(HOST_OBJEXT) \
+        crc32.$(HOST_OBJEXT) \
+        deflate.$(HOST_OBJEXT) \
+        infback.$(HOST_OBJEXT) \
+        inffast.$(HOST_OBJEXT) \
+        inflate.$(HOST_OBJEXT) \
+        inftrees.$(HOST_OBJEXT) \
+        ioapi.$(HOST_OBJEXT) \
+        iowin32.$(HOST_OBJEXT)  \
+        trees.$(HOST_OBJEXT) \
+        uncompr.$(HOST_OBJEXT) \
+        zip.$(HOST_OBJEXT) \
+        zutil.$(HOST_OBJEXT) \
+        minizip.$(HOST_OBJEXT)
+
+ZIP_INSTALL_OBJS =  @ZIP_INSTALL_OBJS@
+
 CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${TCL_SHLIB_CFLAGS} \
 -I"${ZLIB_DIR_NATIVE}" -I"${GENERIC_DIR_NATIVE}" \
 -DMP_PREC=4 -I"${TOMMATH_DIR_NATIVE}" -I"${WIN_DIR_NATIVE}" \
@@ -303,6 +347,7 @@ GENERIC_OBJS = \
 	tclUtf.$(OBJEXT) \
 	tclUtil.$(OBJEXT) \
 	tclVar.$(OBJEXT) \
+	tclZipfs.$(OBJEXT) \
 	tclZlib.$(OBJEXT)
 
 TOMMATH_OBJS = \
@@ -435,10 +480,21 @@ libraries:
 
 doc:
 
+tclzipfile: ${TCL_ZIP_FILE}
+
+${TCL_ZIP_FILE}:  ${ZIP_INSTALL_OBJS} ${DDE_DLL_FILE} ${REG_DLL_FILE}
+	rm -rf ${TCL_VFS_ROOT}
+	mkdir -p ${TCL_VFS_PATH}
+	$(COPY) -a $(TOP_DIR)/library/* ${TCL_VFS_PATH}
+	$(COPY) ${DDE_DLL_FILE} ${TCL_VFS_PATH}/dde
+	$(COPY) ${REG_DLL_FILE} ${TCL_VFS_PATH}/reg
+	cd  ${TCL_VFS_ROOT} ; ${NATIVE_ZIP} ${ZIP_PROG_OPTIONS} ../${TCL_ZIP_FILE} ${ZIP_PROG_VFSSEARCH}
+
 $(TCLSH): $(TCLSH_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES)
 	$(CC) $(CFLAGS) $(TCLSH_OBJS) $(TCL_LIB_FILE) $(TCL_STUB_LIB_FILE) $(LIBS) \
-        tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE)
+	tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE)
 	@VC_MANIFEST_EMBED_EXE@
+	cat ${TOOL_DIR}/empty.zip >> ${TCLSH}
 
 cat32.$(OBJEXT): cat.c
 	$(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME)
@@ -454,10 +510,13 @@ ${TCL_STUB_LIB_FILE}: ${STUB_OBJS}
 	@MAKE_STUB_LIB@ ${STUB_OBJS}
 	@POST_MAKE_LIB@
 
-${TCL_DLL_FILE}: ${TCL_OBJS} tcl.$(RES) @ZLIB_DLL_FILE@
+${TCL_DLL_FILE}: ${TCL_OBJS} tcl.$(RES) @ZLIB_DLL_FILE@ ${TCL_ZIP_FILE}
 	@$(RM) ${TCL_DLL_FILE} $(TCL_LIB_FILE)
 	@MAKE_DLL@ ${TCL_OBJS} tcl.$(RES) $(SHLIB_LD_LIBS)
 	@VC_MANIFEST_EMBED_DLL@
+ifeq (${ZIPFS_BUILD},1)
+	cat ${TCL_ZIP_FILE} >> ${TCL_DLL_FILE}
+endif
 
 ${TCL_LIB_FILE}: ${TCL_OBJS} ${DDE_OBJS} ${REG_OBJS}
 	@$(RM) ${TCL_LIB_FILE}
@@ -503,6 +562,17 @@ testMain.${OBJEXT}: tclAppInit.c
 tclMain2.${OBJEXT}: tclMain.c
 	$(CC) -c $(CC_SWITCHES) -DBUILD_tcl -DTCL_ASCII_MAIN @DEPARG@ $(CC_OBJNAME)
 
+# TIP #430, ZipFS Support
+tclZipfs.${OBJEXT}: $(GENERIC_DIR)/tclZipfs.c
+	$(CC) -c $(CC_SWITCHES) -DBUILD_tcl \
+	-DCFG_RUNTIME_PATH=\"$(bindir_native)\" \
+	-DCFG_RUNTIME_DLLFILE="\"$(TCL_DLL_FILE)\"" \
+	-DCFG_RUNTIME_ZIPFILE="\"$(TCL_ZIP_FILE)\"" \
+	-DCFG_RUNTIME_LIBDIR="\"$(bindir_native)\"" \
+	-DCFG_RUNTIME_SCRDIR="\"$(TCL_LIBRARY_NATIVE)\"" \
+	$(ZLIB_INCLUDE) -I$(ZLIB_DIR)/contrib/minizip  @DEPARG@ $(CC_OBJNAME)
+
+
 # TIP #59, embedding of configuration information into the binary library.
 #
 # Part of Tcl's configuration information are the paths where it was installed
@@ -524,6 +594,8 @@ tclPkgConfig.${OBJEXT}: tclPkgConfig.c
 		-DCFG_RUNTIME_SCRDIR=\"$(TCL_LIBRARY_NATIVE)\" \
 		-DCFG_RUNTIME_INCDIR=\"$(includedir_native)\" \
 		-DCFG_RUNTIME_DOCDIR=\"$(mandir_native)\" \
+		-DCFG_RUNTIME_DLLFILE="\"$(TCL_DLL_FILE)\"" \
+		-DCFG_RUNTIME_ZIPFILE="\"$(TCL_ZIP_FILE)\"" \
 		-DBUILD_tcl \
 		@DEPARG@ $(CC_OBJNAME)
 
@@ -550,6 +622,59 @@ tclWinPanic.${OBJEXT}: tclWinPanic.c
 .rc.$(RES):
 	$(RC) @RC_OUT@ $@ @RC_TYPE@ @RC_DEFINES@ @RC_INCLUDE@ "$(GENERIC_DIR_NATIVE)" @RC_INCLUDE@ "$(WIN_DIR_NATIVE)" @DEPARG@
 
+
+
+#--------------------------------------------------------------------------
+# Minizip implementation
+#--------------------------------------------------------------------------
+adler32.$(HOST_OBJEXT):
+	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/adler32.c
+
+compress.$(HOST_OBJEXT):
+	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/compress.c
+
+crc32.$(HOST_OBJEXT):
+	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/crc32.c
+
+deflate.$(HOST_OBJEXT):
+	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/deflate.c
+
+ioapi.$(HOST_OBJEXT):
+	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/ioapi.c
+
+iowin32.$(HOST_OBJEXT):
+	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/iowin32.c
+
+infback.$(HOST_OBJEXT):
+	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/infback.c
+
+inffast.$(HOST_OBJEXT):
+	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/inffast.c
+
+inflate.$(HOST_OBJEXT):
+	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/inflate.c
+
+inftrees.$(HOST_OBJEXT):
+	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/inftrees.c
+
+trees.$(HOST_OBJEXT):
+	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/trees.c
+
+uncompr.$(HOST_OBJEXT):
+	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/uncompr.c
+
+zip.$(HOST_OBJEXT):
+	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/zip.c
+
+zutil.$(HOST_OBJEXT):
+	$(HOST_CC) -o $@ -I$(ZLIB_DIR) -c $(ZLIB_DIR)/zutil.c
+
+minizip.$(HOST_OBJEXT):
+	$(HOST_CC) -o $@ -I$(ZLIB_DIR)  -I$(ZLIB_DIR)/contrib/minizip -c $(ZLIB_DIR)/contrib/minizip/minizip.c
+
+minizip${HOST_EXEEXT}: $(MINIZIP_OBJS)
+	$(HOST_CC) -o $@ $(MINIZIP_OBJS)
+
 # The following target generates the file generic/tclDate.c from the yacc
 # grammar found in generic/tclGetDate.y. This is only run by hand as yacc is
 # not available in all environments. The name of the .c file is different than
@@ -570,7 +695,15 @@ gentommath_h:
 		"$(TOMMATH_DIR_NATIVE)/tommath.h" \
 		> "$(GENERIC_DIR_NATIVE)/tclTomMath.h"
 
-install: all install-binaries install-libraries install-doc install-packages
+INSTALL_BASE_TARGETS = install-binaries $(INSTALL_LIBRARIES) $(INSTALL_MSGS) $(INSTALL_TZDATA)
+INSTALL_DOC_TARGETS = install-doc
+INSTALL_PACKAGE_TARGETS = install-packages
+INSTALL_DEV_TARGETS = install-headers
+INSTALL_EXTRA_TARGETS =
+INSTALL_TARGETS = $(INSTALL_BASE_TARGETS) $(INSTALL_DOC_TARGETS) $(INSTALL_DEV_TARGETS) \
+		  $(INSTALL_PACKAGE_TARGETS) $(INSTALL_EXTRA_TARGETS)
+
+install: $(INSTALL_TARGETS)
 
 install-binaries: binaries
 	@for i in "$(LIB_INSTALL_DIR)" "$(BIN_INSTALL_DIR)" ; \
@@ -625,6 +758,11 @@ install-binaries: binaries
 	    $(COPY) $(REG_LIB_FILE) $(LIB_INSTALL_DIR)/reg${REGDOTVER}; \
 	    fi
 
+install-libraries-zipfs-shared: libraries
+
+install-libraries-zipfs-static: install-libraries-zipfs-shared
+	$(INSTALL_DATA) ${TCL_ZIP_FILE} "$(LIB_INSTALL_DIR)"
+
 install-libraries: libraries install-tzdata install-msgs
 	@for i in "$$($(CYGPATH) $(prefix)/lib)" "$(INCLUDE_INSTALL_DIR)" \
 		$(SCRIPT_INSTALL_DIR); \
@@ -643,22 +781,13 @@ install-libraries: libraries install-tzdata install-msgs
 		else true; \
 		fi; \
 	    done;
-	@echo "Installing header files";
-	@for i in "$(GENERIC_DIR)/tcl.h" "$(GENERIC_DIR)/tclDecls.h" \
-		"$(GENERIC_DIR)/tclOO.h" "$(GENERIC_DIR)/tclOODecls.h" \
-		"$(GENERIC_DIR)/tclPlatDecls.h" \
-		"$(GENERIC_DIR)/tclTomMath.h" \
-		"$(GENERIC_DIR)/tclTomMathDecls.h"; \
-	    do \
-	    $(COPY) "$$i" "$(INCLUDE_INSTALL_DIR)"; \
-	    done;
 	@echo "Installing library files to $(SCRIPT_INSTALL_DIR)";
 	@for i in $(ROOT_DIR)/library/*.tcl $(ROOT_DIR)/library/tclIndex; \
 	    do \
 	    $(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)"; \
 	    done;
-	@echo "Installing package http 2.8.13 as a Tcl Module";
-	@$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.6/http-2.8.13.tm;
+	@echo "Installing package http 2.9.0 as a Tcl Module";
+	@$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.6/http-2.9.0.tm;
 	@echo "Installing library opt0.4 directory";
 	@for j in $(ROOT_DIR)/library/opt/*.tcl; \
 	    do \
@@ -689,6 +818,25 @@ install-msgs:
 
 install-doc: doc
 
+install-headers:
+	@for i in "$(INCLUDE_INSTALL_DIR)"; \
+	    do \
+	    if [ ! -d "$$i" ] ; then \
+		echo "Making directory $$i"; \
+		$(INSTALL_DATA_DIR) "$$i"; \
+		else true; \
+		fi; \
+	    done;
+	@echo "Installing header files to $(INCLUDE_INSTALL_DIR)/";
+	@for i in $(GENERIC_DIR)/tcl.h $(GENERIC_DIR)/tclDecls.h \
+		$(GENERIC_DIR)/tclOO.h $(GENERIC_DIR)/tclOODecls.h \
+		$(GENERIC_DIR)/tclPlatDecls.h \
+		$(GENERIC_DIR)/tclTomMath.h \
+		$(GENERIC_DIR)/tclTomMathDecls.h ; \
+	    do \
+	    $(COPY) $$i "$(INCLUDE_INSTALL_DIR)"; \
+	    done;
+
 # Optional target to install private headers
 install-private-headers: libraries
 	@for i in $(PRIVATE_INCLUDE_INSTALL_DIR); \
@@ -718,6 +866,7 @@ test-tcl: binaries $(TCLSH) $(CAT32) $(TEST_DLL_FILE)
 	TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
 	./$(TCLSH) "$(ROOT_DIR_NATIVE)/tests/all.tcl" $(TESTFLAGS) \
 	-load "package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest]; \
+	package ifneeded tcltests 0.1 \"[list source [file normalize $(ROOT_DIR_NATIVE)/tests/tcltests.tcl]];package provide tcltests 0.1\"; \
 	package ifneeded dde 1.4.0 [list load [file normalize ${DDE_DLL_FILE}] dde]; \
 	package ifneeded registry 1.3.2 [list load [file normalize ${REG_DLL_FILE}] registry]" | ./$(CAT32)
 
@@ -725,6 +874,7 @@ test-tcl: binaries $(TCLSH) $(CAT32) $(TEST_DLL_FILE)
 runtest: binaries $(TCLSH) $(TEST_DLL_FILE)
 	@TCL_LIBRARY="$(LIBRARY_DIR)"; export TCL_LIBRARY; \
 	./$(TCLSH) $(TESTFLAGS) -load "package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest]; \
+	package ifneeded tcltests 0.1 \"[list source [file normalize $(ROOT_DIR_NATIVE)/tests/tcltests.tcl]];package provide tcltests 0.1\"; \
 	package ifneeded dde 1.4.0 [list load [file normalize ${DDE_DLL_FILE}] dde]; \
 	package ifneeded registry 1.3.2 [list load [file normalize ${REG_DLL_FILE}] registry]" $(SCRIPT)
 
@@ -752,10 +902,13 @@ clean: cleanhelp clean-packages
 	$(RM) *.lib *.a *.exp *.dll *.$(RES) *.${OBJEXT} *~ \#* TAGS a.out
 	$(RM) $(TCLSH) $(CAT32)
 	$(RM) *.pch *.ilk *.pdb
+	$(RM) minizip${HOST_EXEEXT} *.${HOST_OBJEXT}
+	$(RM) *.zip
+	$(RMDIR) *.vfs
 
 distclean: distclean-packages clean
 	$(RM) Makefile config.status config.cache config.log tclConfig.sh \
-		tcl.hpj config.status.lineno
+		tcl.hpj config.status.lineno tclsh.exe.manifest
 
 #
 # Bundled package targets
@@ -884,5 +1037,6 @@ html-tk: $(TCLSH)
 .PHONY: gdb depend cleanhelp clean distclean packages install-packages
 .PHONY: test-packages clean-packages distclean-packages genstubs html
 .PHONY: html-tcl html-tk
+.PHONY: iinstall-libraries-zipfs-shared install-libraries-zipfs-static tclzipfile
 
 # DO NOT DELETE THIS LINE -- make depend depends on it.
diff --git a/win/configure b/win/configure
index 7ab33b0..8cecccc 100755
--- a/win/configure
+++ b/win/configure
@@ -699,6 +699,17 @@ VC_MANIFEST_EMBED_EXE
 VC_MANIFEST_EMBED_DLL
 LDFLAGS_DEFAULT
 CFLAGS_DEFAULT
+INSTALL_MSGS
+INSTALL_LIBRARIES
+TCL_ZIP_FILE
+ZIPFS_BUILD
+ZIP_INSTALL_OBJS
+ZIP_PROG_VFSSEARCH
+ZIP_PROG_OPTIONS
+ZIP_PROG
+TCLSH_PROG
+EXEEXT_FOR_BUILD
+CC_FOR_BUILD
 ZLIB_OBJS
 ZLIB_LIBS
 ZLIB_DLL_FILE
@@ -707,6 +718,7 @@ CFLAGS_OPTIMIZE
 CFLAGS_DEBUG
 DL_LIBS
 CYGPATH
+SHARED_BUILD
 SET_MAKE
 RC
 RANLIB
@@ -758,13 +770,15 @@ PACKAGE_VERSION
 PACKAGE_TARNAME
 PACKAGE_NAME
 PATH_SEPARATOR
-SHELL'
+SHELL
+OBJEXT_FOR_BUILD'
 ac_subst_files=''
 ac_user_opts='
 enable_option_checking
 with_encoding
 enable_shared
 enable_64bit
+enable_zipfs
 enable_symbols
 enable_embedded_manifest
 '
@@ -1386,6 +1400,7 @@ Optional Features:
   --enable-FEATURE[=ARG]  include FEATURE [ARG=yes]
   --enable-shared         build and link with shared libraries (default: on)
   --enable-64bit          enable 64bit support (where applicable)
+  --enable-zipfs          build with Zipfs support (default: on)
   --enable-symbols        build with debugging symbols (default: off)
   --enable-embedded-manifest
                           embed manifest if possible (default: yes)
@@ -3731,6 +3746,7 @@ $as_echo "#define STATIC_BUILD 1" >>confdefs.h
     fi
 
 
+
 #--------------------------------------------------------------------
 # The statements below define a collection of compile flags.  This
 # macro depends on the value of SHARED_BUILD, and should be called
@@ -4525,7 +4541,7 @@ if test "$tcl_ok" = "yes"; then :
 
   ZLIB_DLL_FILE=\${ZLIB_DLL_FILE}
 
-  if test "$do64bit" = "yes"; then :
+  if test "$do64bit" != "no"; then :
 
     if test "$GCC" == "yes"; then :
 
@@ -4660,6 +4676,223 @@ _ACEOF
 fi
 
 
+
+#--------------------------------------------------------------------
+#	Zipfs support - Tip 430
+#--------------------------------------------------------------------
+# Check whether --enable-zipfs was given.
+if test "${enable_zipfs+set}" = set; then :
+  enableval=$enable_zipfs; tcl_ok=$enableval
+else
+  tcl_ok=yes
+fi
+
+if test "$tcl_ok" = "yes" ; then
+    #
+    # Find a native compiler
+    #
+    # Put a plausible default for CC_FOR_BUILD in Makefile.
+if test -z "$CC_FOR_BUILD"; then
+  if test "x$cross_compiling" = "xno"; then
+    CC_FOR_BUILD='$(CC)'
+  else
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gcc" >&5
+$as_echo_n "checking for gcc... " >&6; }
+    if ${ac_cv_path_cc+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+
+	search_path=`echo ${PATH} | sed -e 's/:/ /g'`
+	for dir in $search_path ; do
+	    for j in `ls -r $dir/gcc 2> /dev/null` \
+		    `ls -r $dir/gcc 2> /dev/null` ; do
+		if test x"$ac_cv_path_cc" = x ; then
+		    if test -f "$j" ; then
+			ac_cv_path_cc=$j
+			break
+		    fi
+		fi
+	    done
+	done
+
+fi
+
+  fi
+fi
+
+# Also set EXEEXT_FOR_BUILD.
+if test "x$cross_compiling" = "xno"; then
+  EXEEXT_FOR_BUILD='$(EXEEXT)'
+  OBJEXT_FOR_BUILD='$(OBJEXT)'
+else
+  OBJEXT_FOR_BUILD='.no'
+  { $as_echo "$as_me:${as_lineno-$LINENO}: checking for build system executable suffix" >&5
+$as_echo_n "checking for build system executable suffix... " >&6; }
+if ${bfd_cv_build_exeext+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+  rm -f conftest*
+     echo 'int main () { return 0; }' > conftest.c
+     bfd_cv_build_exeext=
+     ${CC_FOR_BUILD} -o conftest conftest.c 1>&5 2>&5
+     for file in conftest.*; do
+       case $file in
+       *.c | *.o | *.obj | *.ilk | *.pdb) ;;
+       *) bfd_cv_build_exeext=`echo $file | sed -e s/conftest//` ;;
+       esac
+     done
+     rm -f conftest*
+     test x"${bfd_cv_build_exeext}" = x && bfd_cv_build_exeext=no
+fi
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $bfd_cv_build_exeext" >&5
+$as_echo "$bfd_cv_build_exeext" >&6; }
+  EXEEXT_FOR_BUILD=""
+  test x"${bfd_cv_build_exeext}" != xno && EXEEXT_FOR_BUILD=${bfd_cv_build_exeext}
+fi
+
+    #
+    # Find a native zip implementation
+    #
+
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for tclsh" >&5
+$as_echo_n "checking for tclsh... " >&6; }
+
+    if ${ac_cv_path_tclsh+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+
+	search_path=`echo ${PATH} | sed -e 's/:/ /g'`
+	for dir in $search_path ; do
+	    for j in `ls -r $dir/tclsh[8-9]*.exe 2> /dev/null` \
+		    `ls -r $dir/tclsh* 2> /dev/null` ; do
+		if test x"$ac_cv_path_tclsh" = x ; then
+		    if test -f "$j" ; then
+			ac_cv_path_tclsh=$j
+			break
+		    fi
+		fi
+	    done
+	done
+
+fi
+
+
+    if test -f "$ac_cv_path_tclsh" ; then
+	TCLSH_PROG="$ac_cv_path_tclsh"
+	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $TCLSH_PROG" >&5
+$as_echo "$TCLSH_PROG" >&6; }
+    else
+	# It is not an error if an installed version of Tcl can't be located.
+	TCLSH_PROG=""
+	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: No tclsh found on PATH" >&5
+$as_echo "No tclsh found on PATH" >&6; }
+    fi
+
+
+
+    ZIP_PROG=""
+    ZIP_PROG_OPTIONS=""
+    ZIP_PROG_VFSSEARCH=""
+    ZIP_INSTALL_OBJS=""
+    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for zip" >&5
+$as_echo_n "checking for zip... " >&6; }
+    # If our native tclsh processes the "install" command line option
+    # we can use it to mint zip files
+    if $TCLSH_PROG install; then :
+
+      ZIP_PROG=${TCLSH_PROG}
+      ZIP_PROG_OPTIONS="install mkzip"
+      ZIP_PROG_VFSSEARCH="."
+      { $as_echo "$as_me:${as_lineno-$LINENO}: result: Can use Native Tclsh for Zip encoding" >&5
+$as_echo "Can use Native Tclsh for Zip encoding" >&6; }
+
+fi
+
+    if test "x$ZIP_PROG" = "x" ; then
+        { $as_echo "$as_me:${as_lineno-$LINENO}: checking for zip" >&5
+$as_echo_n "checking for zip... " >&6; }
+        if ${ac_cv_path_zip+:} false; then :
+  $as_echo_n "(cached) " >&6
+else
+
+        search_path=`echo ${PATH} | sed -e 's/:/ /g'`
+        for dir in $search_path ; do
+            for j in `ls -r $dir/zip 2> /dev/null` \
+                `ls -r $dir/zip 2> /dev/null` ; do
+            if test x"$ac_cv_path_zip" = x ; then
+                if test -f "$j" ; then
+                ac_cv_path_zip=$j
+                break
+                fi
+            fi
+            done
+        done
+
+fi
+
+        if test -f "$ac_cv_path_zip" ; then
+            ZIP_PROG="$ac_cv_path_zip "
+            { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ZIP_PROG" >&5
+$as_echo "$ZIP_PROG" >&6; }
+            ZIP_PROG_OPTIONS="-rq"
+            ZIP_PROG_VFSSEARCH="."
+            { $as_echo "$as_me:${as_lineno-$LINENO}: result: Found INFO Zip in environment" >&5
+$as_echo "Found INFO Zip in environment" >&6; }
+            # Use standard arguments for zip
+        else
+            # It is not an error if an installed version of Zip can't be located.
+            # We can use the locally distributed minizip instead
+            ZIP_PROG="../minizip${EXEEXT_FOR_BUILD}"
+            ZIP_PROG_OPTIONS="-o -r"
+            ZIP_PROG_VFSSEARCH="."
+            ZIP_INSTALL_OBJS="minizip${EXEEXT_FOR_BUILD}"
+            { $as_echo "$as_me:${as_lineno-$LINENO}: result: No zip found on PATH building minizip" >&5
+$as_echo "No zip found on PATH building minizip" >&6; }
+        fi
+    fi
+
+
+
+
+
+	ZIPFS_BUILD=1
+	TCL_ZIP_FILE=libtcl_${TCL_MAJOR_VERSION}_${TCL_MINOR_VERSION}_${TCL_PATCH_LEVEL}.zip
+else
+	ZIPFS_BUILD=0
+	TCL_ZIP_FILE=
+fi
+# Do checking message here to not mess up interleaved configure output
+{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for building with zipfs" >&5
+$as_echo_n "checking for building with zipfs... " >&6; }
+if test "${ZIPFS_BUILD}" = 1; then
+    if test "${SHARED_BUILD}" = 0; then
+       ZIPFS_BUILD=2;
+
+$as_echo "#define ZIPFS_BUILD 2" >>confdefs.h
+
+       INSTALL_LIBRARIES=install-libraries-zipfs-static
+       { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+     else
+
+$as_echo "#define ZIPFS_BUILD 1" >>confdefs.h
+\
+       INSTALL_LIBRARIES=install-libraries-zipfs-shared
+       { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5
+$as_echo "yes" >&6; }
+    fi
+else
+{ $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5
+$as_echo "no" >&6; }
+INSTALL_LIBRARIES=install-libraries
+INSTALL_MSGS=install-msgs
+fi
+
+
+
+
+
+
 #--------------------------------------------------------------------
 # Perform additinal compiler tests.
 #--------------------------------------------------------------------
diff --git a/win/configure.ac b/win/configure.ac
index 179f151..7b63c61 100644
--- a/win/configure.ac
+++ b/win/configure.ac
@@ -122,7 +122,7 @@ AS_IF([test "${enable_shared+set}" = "set"], [
 ])
 AS_IF([test "$tcl_ok" = "yes"], [
   AC_SUBST(ZLIB_DLL_FILE,[\${ZLIB_DLL_FILE}])
-  AS_IF([test "$do64bit" = "yes"], [
+  AS_IF([test "$do64bit" != "no"], [
     AS_IF([test "$GCC" == "yes"],[
       AC_SUBST(ZLIB_LIBS,[\${ZLIB_DIR_NATIVE}/win64/libz.dll.a])
     ], [
@@ -168,6 +168,54 @@ AC_CHECK_TYPE([uintptr_t], [
     fi
 ])
 
+
+#--------------------------------------------------------------------
+#	Zipfs support - Tip 430
+#--------------------------------------------------------------------
+AC_ARG_ENABLE(zipfs,
+    AC_HELP_STRING([--enable-zipfs],
+	[build with Zipfs support (default: on)]),
+    [tcl_ok=$enableval], [tcl_ok=yes])
+if test "$tcl_ok" = "yes" ; then
+    #
+    # Find a native compiler
+    #
+    AX_CC_FOR_BUILD
+    #
+    # Find a native zip implementation
+    #
+    SC_PROG_TCLSH
+    SC_ZIPFS_SUPPORT
+	ZIPFS_BUILD=1
+	TCL_ZIP_FILE=libtcl_${TCL_MAJOR_VERSION}_${TCL_MINOR_VERSION}_${TCL_PATCH_LEVEL}.zip
+else
+	ZIPFS_BUILD=0
+	TCL_ZIP_FILE=
+fi
+# Do checking message here to not mess up interleaved configure output
+AC_MSG_CHECKING([for building with zipfs])
+if test "${ZIPFS_BUILD}" = 1; then
+    if test "${SHARED_BUILD}" = 0; then
+       ZIPFS_BUILD=2;
+       AC_DEFINE(ZIPFS_BUILD, 2, [Are we building with zipfs enabled?])
+       INSTALL_LIBRARIES=install-libraries-zipfs-static
+       AC_MSG_RESULT([yes])
+     else
+       AC_DEFINE(ZIPFS_BUILD, 1, [Are we building with zipfs enabled?])\
+       INSTALL_LIBRARIES=install-libraries-zipfs-shared
+       AC_MSG_RESULT([yes])
+    fi
+else
+AC_MSG_RESULT([no])
+INSTALL_LIBRARIES=install-libraries
+INSTALL_MSGS=install-msgs
+fi
+AC_SUBST(ZIPFS_BUILD)
+AC_SUBST(TCL_ZIP_FILE)
+AC_SUBST(INSTALL_LIBRARIES)
+AC_SUBST(INSTALL_MSGS)
+
+
 #--------------------------------------------------------------------
 # Perform additinal compiler tests.
 #--------------------------------------------------------------------
diff --git a/win/makefile.vc b/win/makefile.vc
index ceeaa02..1aae9a3 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -55,7 +55,7 @@
 #       c:\tcl_src\win\>nmake -f makefile.vc release

 #       c:\tcl_src\win\>nmake -f makefile.vc test

 #       c:\tcl_src\win\>nmake -f makefile.vc install INSTALLDIR=c:\progra~1\tcl

-#       c:\tcl_src\win\>nmake -f makefile.vc release OPTS=pdbs 

+#       c:\tcl_src\win\>nmake -f makefile.vc release OPTS=pdbs

 #       c:\tcl_src\win\>nmake -f makefile.vc release OPTS=symbols

 #

 

diff --git a/win/nmakehlp.c b/win/nmakehlp.c
index b759020..1655d48 100644
--- a/win/nmakehlp.c
+++ b/win/nmakehlp.c
@@ -686,10 +686,10 @@ SubstituteFile(
 BOOL FileExists(LPCTSTR szPath)
 {
 #ifndef INVALID_FILE_ATTRIBUTES
-    #define INVALID_FILE_ATTRIBUTES ((DWORD)-1) 
+    #define INVALID_FILE_ATTRIBUTES ((DWORD)-1)
 #endif
     DWORD pathAttr = GetFileAttributes(szPath);
-    return (pathAttr != INVALID_FILE_ATTRIBUTES && 
+    return (pathAttr != INVALID_FILE_ATTRIBUTES &&
 	    !(pathAttr & FILE_ATTRIBUTE_DIRECTORY));
 }
 
@@ -740,7 +740,7 @@ static int LocateDependencyHelper(const char *dir, const char *keypath)
 #if 0 /* This function is not available in Visual C++ 6 */
     /*
      * Use numerics 0 -> FindExInfoStandard,
-     * 1 -> FindExSearchLimitToDirectories, 
+     * 1 -> FindExSearchLimitToDirectories,
      * as these are not defined in Visual C++ 6
      */
     hSearch = FindFirstFileEx(path, 0, &finfo, 1, NULL, 0);
@@ -755,7 +755,7 @@ static int LocateDependencyHelper(const char *dir, const char *keypath)
     do {
 	int sublen;
 	/*
-	 * We need to check it is a directory despite the 
+	 * We need to check it is a directory despite the
 	 * FindExSearchLimitToDirectories in the above call. See SDK docs
 	 */
 	if ((finfo.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) == 0)
@@ -786,7 +786,7 @@ static int LocateDependencyHelper(const char *dir, const char *keypath)
  *          that is used to confirm it is the correct directory.
  *	The search path for the package directory is currently only
  *      the parent and grandparent of the current working directory.
- *      If found, the command prints 
+ *      If found, the command prints
  *         name_DIRPATH=<full path of located directory>
  *      and returns 0. If not found, does not print anything and returns 1.
  */
@@ -794,7 +794,7 @@ static int LocateDependency(const char *keypath)
 {
     int i, ret;
     static char *paths[] = {"..", "..\\..", "..\\..\\.."};
-    
+
     for (i = 0; i < (sizeof(paths)/sizeof(paths[0])); ++i) {
 	ret = LocateDependencyHelper(paths[i], keypath);
 	if (ret == 0)
diff --git a/win/tcl.m4 b/win/tcl.m4
index e2a2fb2..a678009 100644
--- a/win/tcl.m4
+++ b/win/tcl.m4
@@ -251,6 +251,7 @@ AC_DEFUN([SC_PATH_TKCONFIG], [
 #		TCL_BIN_DIR
 #		TCL_SRC_DIR
 #		TCL_LIB_FILE
+#		TCL_ZIP_FILE
 #
 #------------------------------------------------------------------------
 
@@ -283,6 +284,7 @@ AC_DEFUN([SC_LOAD_TCLCONFIG], [
     # eval is required to do the TCL_DBGX substitution
     #
 
+    eval "TCL_ZIP_FILE=\"${TCL_ZIP_FILE}\""
     eval "TCL_LIB_FILE=\"${TCL_LIB_FILE}\""
     eval "TCL_LIB_FLAG=\"${TCL_LIB_FLAG}\""
     eval "TCL_LIB_SPEC=\"${TCL_LIB_SPEC}\""
@@ -295,6 +297,7 @@ AC_DEFUN([SC_LOAD_TCLCONFIG], [
     AC_SUBST(TCL_BIN_DIR)
     AC_SUBST(TCL_SRC_DIR)
 
+    AC_SUBST(TCL_ZIP_FILE)
     AC_SUBST(TCL_LIB_FILE)
     AC_SUBST(TCL_LIB_FLAG)
     AC_SUBST(TCL_LIB_SPEC)
@@ -380,6 +383,7 @@ AC_DEFUN([SC_ENABLE_SHARED], [
 	SHARED_BUILD=0
 	AC_DEFINE(STATIC_BUILD, 1, [Is this a static build?])
     fi
+    AC_SUBST(SHARED_BUILD)
 ])
 
 #------------------------------------------------------------------------
@@ -1159,3 +1163,137 @@ print("manifest needed")
     AC_SUBST(VC_MANIFEST_EMBED_DLL)
     AC_SUBST(VC_MANIFEST_EMBED_EXE)
 ])
+
+#------------------------------------------------------------------------
+# SC_CC_FOR_BUILD
+#	For cross compiles, locate a C compiler that can generate native binaries.
+#
+# Arguments:
+#	none
+#
+# Results:
+#	Substitutes the following vars:
+#		CC_FOR_BUILD
+#		EXEEXT_FOR_BUILD
+#------------------------------------------------------------------------
+
+dnl Get a default for CC_FOR_BUILD to put into Makefile.
+AC_DEFUN([AX_CC_FOR_BUILD],
+[# Put a plausible default for CC_FOR_BUILD in Makefile.
+if test -z "$CC_FOR_BUILD"; then
+  if test "x$cross_compiling" = "xno"; then
+    CC_FOR_BUILD='$(CC)'
+  else
+    AC_MSG_CHECKING([for gcc])
+    AC_CACHE_VAL(ac_cv_path_cc, [
+	search_path=`echo ${PATH} | sed -e 's/:/ /g'`
+	for dir in $search_path ; do
+	    for j in `ls -r $dir/gcc 2> /dev/null` \
+		    `ls -r $dir/gcc 2> /dev/null` ; do
+		if test x"$ac_cv_path_cc" = x ; then
+		    if test -f "$j" ; then
+			ac_cv_path_cc=$j
+			break
+		    fi
+		fi
+	    done
+	done
+    ])
+  fi
+fi
+AC_SUBST(CC_FOR_BUILD)
+# Also set EXEEXT_FOR_BUILD.
+if test "x$cross_compiling" = "xno"; then
+  EXEEXT_FOR_BUILD='$(EXEEXT)'
+  OBJEXT_FOR_BUILD='$(OBJEXT)'
+else
+  OBJEXT_FOR_BUILD='.no'
+  AC_CACHE_CHECK([for build system executable suffix], bfd_cv_build_exeext,
+    [rm -f conftest*
+     echo 'int main () { return 0; }' > conftest.c
+     bfd_cv_build_exeext=
+     ${CC_FOR_BUILD} -o conftest conftest.c 1>&5 2>&5
+     for file in conftest.*; do
+       case $file in
+       *.c | *.o | *.obj | *.ilk | *.pdb) ;;
+       *) bfd_cv_build_exeext=`echo $file | sed -e s/conftest//` ;;
+       esac
+     done
+     rm -f conftest*
+     test x"${bfd_cv_build_exeext}" = x && bfd_cv_build_exeext=no])
+  EXEEXT_FOR_BUILD=""
+  test x"${bfd_cv_build_exeext}" != xno && EXEEXT_FOR_BUILD=${bfd_cv_build_exeext}
+fi
+AC_SUBST(EXEEXT_FOR_BUILD)])dnl
+AC_SUBST(OBJEXT_FOR_BUILD)])dnl
+
+
+
+#------------------------------------------------------------------------
+# SC_ZIPFS_SUPPORT
+#	Locate a zip encoder installed on the system path, or none.
+#
+# Arguments:
+#	none
+#
+# Results:
+#	Substitutes the following vars:
+#		ZIP_PROG
+#       ZIP_PROG_OPTIONS
+#       ZIP_PROG_VFSSEARCH
+#       ZIP_INSTALL_OBJS
+#------------------------------------------------------------------------
+
+AC_DEFUN([SC_ZIPFS_SUPPORT], [
+    ZIP_PROG=""
+    ZIP_PROG_OPTIONS=""
+    ZIP_PROG_VFSSEARCH=""
+    ZIP_INSTALL_OBJS=""
+    AC_MSG_CHECKING([for zip])
+    # If our native tclsh processes the "install" command line option
+    # we can use it to mint zip files
+    AS_IF([$TCLSH_PROG install],[
+      ZIP_PROG=${TCLSH_PROG}
+      ZIP_PROG_OPTIONS="install mkzip"
+      ZIP_PROG_VFSSEARCH="."
+      AC_MSG_RESULT([Can use Native Tclsh for Zip encoding])
+    ])
+
+    if test "x$ZIP_PROG" = "x" ; then
+        AC_MSG_CHECKING([for zip])
+        AC_CACHE_VAL(ac_cv_path_zip, [
+        search_path=`echo ${PATH} | sed -e 's/:/ /g'`
+        for dir in $search_path ; do
+            for j in `ls -r $dir/zip 2> /dev/null` \
+                `ls -r $dir/zip 2> /dev/null` ; do
+            if test x"$ac_cv_path_zip" = x ; then
+                if test -f "$j" ; then
+                ac_cv_path_zip=$j
+                break
+                fi
+            fi
+            done
+        done
+        ])
+        if test -f "$ac_cv_path_zip" ; then
+            ZIP_PROG="$ac_cv_path_zip "
+            AC_MSG_RESULT([$ZIP_PROG])
+            ZIP_PROG_OPTIONS="-rq"
+            ZIP_PROG_VFSSEARCH="."
+            AC_MSG_RESULT([Found INFO Zip in environment])
+            # Use standard arguments for zip
+        else
+            # It is not an error if an installed version of Zip can't be located.
+            # We can use the locally distributed minizip instead
+            ZIP_PROG="../minizip${EXEEXT_FOR_BUILD}"
+            ZIP_PROG_OPTIONS="-o -r"
+            ZIP_PROG_VFSSEARCH="."
+            ZIP_INSTALL_OBJS="minizip${EXEEXT_FOR_BUILD}"
+            AC_MSG_RESULT([No zip found on PATH building minizip])
+        fi
+    fi
+    AC_SUBST(ZIP_PROG)
+    AC_SUBST(ZIP_PROG_OPTIONS)
+    AC_SUBST(ZIP_PROG_VFSSEARCH)
+    AC_SUBST(ZIP_INSTALL_OBJS)
+])
diff --git a/win/tclAppInit.c b/win/tclAppInit.c
index ef9f98b..6444b21 100644
--- a/win/tclAppInit.c
+++ b/win/tclAppInit.c
@@ -35,8 +35,10 @@ extern Tcl_PackageInitProc Dde_Init;
 extern Tcl_PackageInitProc Dde_SafeInit;
 #endif
 
-#ifdef TCL_BROKEN_MAINARGS
+#if defined(__GNUC__) || defined(TCL_BROKEN_MAINARGS)
 int _CRT_glob = 0;
+#endif /* __GNUC__ || TCL_BROKEN_MAINARGS */
+#ifdef TCL_BROKEN_MAINARGS
 static void setargv(int *argcPtr, TCHAR ***argvPtr);
 #endif /* TCL_BROKEN_MAINARGS */
 
@@ -124,6 +126,9 @@ _tmain(
 
 #ifdef TCL_LOCAL_MAIN_HOOK
     TCL_LOCAL_MAIN_HOOK(&argc, &argv);
+#elif !defined(_WIN32) && !defined(UNICODE)
+    /* This doesn't work on Windows without UNICODE */
+    TclZipfs_AppHook(&argc, &argv);
 #endif
 
     Tcl_Main(argc, argv, TCL_LOCAL_APPINIT);
diff --git a/win/tclConfig.sh.in b/win/tclConfig.sh.in
index 8aa25f8..5dc6833 100644
--- a/win/tclConfig.sh.in
+++ b/win/tclConfig.sh.in
@@ -41,6 +41,9 @@ TCL_SHARED_BUILD=@TCL_SHARED_BUILD@
 # The name of the Tcl library (may be either a .a file or a shared library):
 TCL_LIB_FILE='@TCL_LIB_FILE@'
 
+# The name of a zip containing the /library and /encodings (may be either a .zip file or a shared library):
+TCL_ZIP_FILE='@TCL_ZIP_FILE@'
+
 # Flag to indicate whether shared libraries need export files.
 TCL_NEEDS_EXP_FILE=@TCL_NEEDS_EXP_FILE@
 
diff --git a/win/tclWin32Dll.c b/win/tclWin32Dll.c
index 599c126..60edbab 100644
--- a/win/tclWin32Dll.c
+++ b/win/tclWin32Dll.c
@@ -471,14 +471,28 @@ Tcl_WinUtfToTChar(
     Tcl_DString *dsPtr)		/* Uninitialized or free DString in which the
 				 * converted string is stored. */
 {
-    TCHAR *wp;
+    TCHAR *wp, *p;
     int size = MultiByteToWideChar(CP_UTF8, 0, string, len, 0, 0);
 
     Tcl_DStringInit(dsPtr);
     Tcl_DStringSetLength(dsPtr, 2*size+2);
-    wp = (TCHAR *)Tcl_DStringValue(dsPtr);
+    p = wp = (TCHAR *)Tcl_DStringValue(dsPtr);
     MultiByteToWideChar(CP_UTF8, 0, string, len, wp, size+1);
     if (len == -1) --size; /* account for 0-byte at string end */
+
+    /* It turns out that MultiByteToWideChar() cannot handle the 'modified'
+     * UTF-8 as used by Tcl. Every sequence of 0xC0 followed by 0x80 will
+     * be translated to two 0xfffd characters. This results in a test-failure
+     * of the registry-6.20 test-case. The simplest solution is to search for
+     * those two 0xfffd characters and replace them by a \u0000 character. */
+    while (p < wp + size - 1) {
+	if (p[0] == 0xfffd && p[1] == 0xfffd) {
+	    memmove(p+1, p+2, sizeof(TCHAR) * (p - wp + size - 2));
+	    p[0] = '\0';
+	    ++p; --size;
+	}
+	++p;
+    }
     Tcl_DStringSetLength(dsPtr, 2*size);
     wp[size] = 0;
     return wp;
@@ -493,17 +507,27 @@ Tcl_WinTCharToUtf(
 				 * converted string is stored. */
 {
     char *p;
-    int size;
+    int size, i = 0;
 
     if (len > 0) {
 	len /= 2;
     }
     size = WideCharToMultiByte(CP_UTF8, 0, string, len, 0, 0, NULL, NULL);
     Tcl_DStringInit(dsPtr);
-    Tcl_DStringSetLength(dsPtr, size+1);
+    Tcl_DStringSetLength(dsPtr, size+8); /* Add some spare, in case of NULL-bytes */
     p = (char *)Tcl_DStringValue(dsPtr);
     WideCharToMultiByte(CP_UTF8, 0, string, len, p, size, NULL, NULL);
     if (len == -1) --size; /* account for 0-byte at string end */
+    while (i < size) {
+	if (!p[i]) {
+	    /* Output contains '\0'-byte, but Tcl expect two-bytes: C0 80 */
+	    memmove(p+i+2, p+i+1, size-i-1);
+	    memcpy(p + i++, "\xC0\x80", 2);
+	    Tcl_DStringSetLength(dsPtr, ++size + 1);
+	    p = (char *)Tcl_DStringValue(dsPtr);
+	}
+	++i;
+    }
     Tcl_DStringSetLength(dsPtr, size);
     p[size] = 0;
     return p;
@@ -536,7 +560,7 @@ TclWinCPUID(
 
 #if defined(HAVE_INTRIN_H) && defined(_WIN64)
 
-    __cpuid(regsPtr, index);
+    __cpuid((int *)regsPtr, index);
     status = TCL_OK;
 
 #elif defined(__GNUC__)
diff --git a/win/tclWinChan.c b/win/tclWinChan.c
index 8ffb31f..8c47be6 100644
--- a/win/tclWinChan.c
+++ b/win/tclWinChan.c
@@ -554,8 +554,8 @@ FileWideSeekProc(
 	moveMethod = FILE_END;
     }
 
-    newPosHigh = Tcl_WideAsLong(offset >> 32);
-    newPos = SetFilePointer(infoPtr->handle, Tcl_WideAsLong(offset),
+    newPosHigh = (LONG)(offset >> 32);
+    newPos = SetFilePointer(infoPtr->handle, (LONG)offset,
 	    &newPosHigh, moveMethod);
     if (newPos == (LONG) INVALID_SET_FILE_POINTER) {
 	DWORD winError = GetLastError();
@@ -567,7 +567,7 @@ FileWideSeekProc(
 	}
     }
     return (((Tcl_WideInt)((unsigned)newPos))
-	    | (Tcl_LongAsWide(newPosHigh) << 32));
+	    | ((Tcl_WideInt)newPosHigh << 32));
 }
 
 /*
@@ -613,8 +613,8 @@ FileTruncateProc(
      * Move to where we want to truncate
      */
 
-    newPosHigh = Tcl_WideAsLong(length >> 32);
-    newPos = SetFilePointer(infoPtr->handle, Tcl_WideAsLong(length),
+    newPosHigh = (LONG)(length >> 32);
+    newPos = SetFilePointer(infoPtr->handle, (LONG)length,
 	    &newPosHigh, FILE_BEGIN);
     if (newPos == (LONG) INVALID_SET_FILE_POINTER) {
 	DWORD winError = GetLastError();
diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c
index 92643cf..f8b67a3 100644
--- a/win/tclWinConsole.c
+++ b/win/tclWinConsole.c
@@ -1360,11 +1360,7 @@ TclWinOpenConsoleChannel(
 
     Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto");
     Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "\032 {}");
-#ifdef UNICODE
     Tcl_SetChannelOption(NULL, infoPtr->channel, "-encoding", "unicode");
-#else
-    Tcl_SetChannelOption(NULL, infoPtr->channel, "-encoding", encoding);
-#endif
     return infoPtr->channel;
 }
 
diff --git a/win/tclWinDde.c b/win/tclWinDde.c
index 381db65..52bcd42 100644
--- a/win/tclWinDde.c
+++ b/win/tclWinDde.c
@@ -18,15 +18,6 @@
 #include <dde.h>
 #include <ddeml.h>
 
-#ifndef UNICODE
-#   undef CP_WINUNICODE
-#   define CP_WINUNICODE CP_WINANSI
-#   undef Tcl_WinTCharToUtf
-#   define Tcl_WinTCharToUtf(a,b,c) Tcl_ExternalToUtfDString(NULL,a,b,c)
-#   undef Tcl_WinUtfToTChar
-#   define Tcl_WinUtfToTChar(a,b,c) Tcl_UtfToExternalDString(NULL,a,b,c)
-#endif
-
 #if !defined(NDEBUG)
     /* test POKE server Implemented for debug mode only */
 #   undef CBF_FAIL_POKES
@@ -1432,11 +1423,7 @@ DdeObjCmd(
     Initialize();
 
     if (firstArg != 1) {
-#ifdef UNICODE
 	serviceName = Tcl_GetUnicodeFromObj(objv[firstArg], &length);
-#else
-	serviceName = Tcl_GetStringFromObj(objv[firstArg], &length);
-#endif
     } else {
 	length = 0;
     }
@@ -1449,11 +1436,7 @@ DdeObjCmd(
     }
 
     if ((index != DDE_SERVERNAME) && (index != DDE_EVAL)) {
-#ifdef UNICODE
 	topicName = (TCHAR *) Tcl_GetUnicodeFromObj(objv[firstArg + 1], &length);
-#else
-	topicName = Tcl_GetStringFromObj(objv[firstArg + 1], &length);
-#endif
 	if (length == 0) {
 	    topicName = NULL;
 	} else {
@@ -1467,11 +1450,7 @@ DdeObjCmd(
 	serviceName = DdeSetServerName(interp, serviceName, flags,
 		handlerPtr);
 	if (serviceName != NULL) {
-#ifdef UNICODE
 	    Tcl_SetObjResult(interp, Tcl_NewUnicodeObj((Tcl_UniChar *) serviceName, -1));
-#else
-	    Tcl_SetObjResult(interp, Tcl_NewStringObj(serviceName, -1));
-#endif
 	} else {
 	    Tcl_ResetResult(interp);
 	}
@@ -1530,13 +1509,8 @@ DdeObjCmd(
 	break;
     }
     case DDE_REQUEST: {
-#ifdef UNICODE
 	const TCHAR *itemString = (TCHAR *) Tcl_GetUnicodeFromObj(objv[firstArg + 2],
 		&length);
-#else
-	const TCHAR *itemString = Tcl_GetStringFromObj(objv[firstArg + 2],
-		&length);
-#endif
 
 	if (length == 0) {
 	    Tcl_SetObjResult(interp,
@@ -1590,13 +1564,8 @@ DdeObjCmd(
 	break;
     }
     case DDE_POKE: {
-#ifdef UNICODE
 	const TCHAR *itemString = (TCHAR *) Tcl_GetUnicodeFromObj(objv[firstArg + 2],
 		&length);
-#else
-	const TCHAR *itemString = Tcl_GetStringFromObj(objv[firstArg + 2],
-		&length);
-#endif
 	BYTE *dataString;
 
 	if (length == 0) {
diff --git a/win/tclWinError.c b/win/tclWinError.c
index 5d4423b..bce81fa 100644
--- a/win/tclWinError.c
+++ b/win/tclWinError.c
@@ -391,7 +391,7 @@ tclWinDebugPanic(
 
     if (IsDebuggerPresent()) {
 	WCHAR msgString[TCL_MAX_WARN_LEN];
-	char buf[TCL_MAX_WARN_LEN * TCL_UTF_MAX];
+	char buf[TCL_MAX_WARN_LEN * 3];
 
 	vsnprintf(buf, sizeof(buf), format, argList);
 	msgString[TCL_MAX_WARN_LEN-1] = L'\0';
diff --git a/win/tclWinFile.c b/win/tclWinFile.c
index 0595e6c..dfeeef1 100644
--- a/win/tclWinFile.c
+++ b/win/tclWinFile.c
@@ -567,7 +567,6 @@ WinReadLinkDirectory(
 	 */
 
 	offset = 0;
-#ifdef UNICODE
 	if (reparseBuffer->MountPointReparseBuffer.PathBuffer[0] == L'\\') {
 	    /*
 	     * Check whether this is a mounted volume.
@@ -629,7 +628,6 @@ WinReadLinkDirectory(
 		offset = 4;
 	    }
 	}
-#endif /* UNICODE */
 
 	Tcl_WinTCharToUtf((const TCHAR *)
 		reparseBuffer->MountPointReparseBuffer.PathBuffer,
@@ -800,7 +798,7 @@ tclWinDebugPanic(
 {
 #define TCL_MAX_WARN_LEN 1024
     va_list argList;
-    char buf[TCL_MAX_WARN_LEN * TCL_UTF_MAX];
+    char buf[TCL_MAX_WARN_LEN * 3];
     WCHAR msgString[TCL_MAX_WARN_LEN];
 
     va_start(argList, format);
@@ -859,7 +857,7 @@ TclpFindExecutable(
 				 * ignore. */
 {
     WCHAR wName[MAX_PATH];
-    char name[MAX_PATH * TCL_UTF_MAX];
+    char name[MAX_PATH * 3];
 
     /*
      * Under Windows we ignore argv0, and return the path for the file used to
@@ -871,17 +869,7 @@ TclpFindExecutable(
 	Tcl_SetPanicProc(tclWinDebugPanic);
     }
 
-#ifdef UNICODE
     GetModuleFileNameW(NULL, wName, MAX_PATH);
-#else
-    GetModuleFileNameA(NULL, name, sizeof(name));
-
-    /*
-     * Convert to WCHAR to get out of ANSI codepage
-     */
-
-    MultiByteToWideChar(CP_ACP, 0, name, -1, wName, MAX_PATH);
-#endif
     WideCharToMultiByte(CP_UTF8, 0, wName, -1, name, sizeof(name), NULL, NULL);
     TclWinNoBackslash(name);
     TclSetObjNameOfExecutable(Tcl_NewStringObj(name, -1), NULL);
@@ -1452,9 +1440,9 @@ TclpGetUserHome(
     domain = Tcl_UtfFindFirst(name, '@');
     if (domain == NULL) {
 	const char *ptr;
-	
+
 	/* no domain - firstly check it's the current user */
-	if ( (ptr = TclpGetUserName(&ds)) != NULL 
+	if ( (ptr = TclpGetUserName(&ds)) != NULL
 	  && strcasecmp(name, ptr) == 0
 	) {
 	    /* try safest and fastest way to get current user home */
@@ -1477,7 +1465,7 @@ TclpGetUserHome(
 	Tcl_DStringInit(&ds);
 	wName = Tcl_UtfToUniCharDString(name, nameLen, &ds);
 	while (NetUserGetInfo(wDomain, wName, 1, (LPBYTE *) &uiPtr) != 0) {
-	    /* 
+	    /*
 	     * user does not exists - if domain was not specified,
 	     * try again using current domain.
 	     */
@@ -1592,7 +1580,7 @@ NativeAccess(
 	return 0;
     }
 
-    /* 
+    /*
      * If it's not a directory (assume file), do several fast checks:
      */
     if (!(attr & FILE_ATTRIBUTE_DIRECTORY)) {
@@ -1646,7 +1634,6 @@ NativeAccess(
      * what permissions the OS has set for a file.
      */
 
-#ifdef UNICODE
     {
 	SECURITY_DESCRIPTOR *sdPtr = NULL;
 	unsigned long size;
@@ -1809,7 +1796,6 @@ NativeAccess(
 	}
 
     }
-#endif /* !UNICODE */
     return 0;
 }
 
@@ -2023,7 +2009,8 @@ NativeStat(
      */
 
     fileHandle = CreateFile(nativePath, GENERIC_READ,
-	    FILE_SHARE_READ | FILE_SHARE_WRITE, NULL, OPEN_EXISTING,
+	    FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE,
+	    NULL, OPEN_EXISTING,
 	    FILE_FLAG_BACKUP_SEMANTICS | FILE_FLAG_OPEN_REPARSE_POINT, NULL);
 
     if (fileHandle != INVALID_HANDLE_VALUE) {
diff --git a/win/tclWinInit.c b/win/tclWinInit.c
index b77a580..2ce19ce 100644
--- a/win/tclWinInit.c
+++ b/win/tclWinInit.c
@@ -107,7 +107,6 @@ static ProcessGlobalValue sourceLibraryDir =
 	{0, 0, NULL, NULL, InitializeSourceLibraryDir, NULL, NULL};
 
 static void		AppendEnvironment(Tcl_Obj *listPtr, const char *lib);
-static int		ToUtf(const WCHAR *wSrc, char *dst);
 
 /*
  *---------------------------------------------------------------------------
@@ -257,7 +256,7 @@ AppendEnvironment(
 {
     int pathc;
     WCHAR wBuf[MAX_PATH];
-    char buf[MAX_PATH * TCL_UTF_MAX];
+    char buf[MAX_PATH * 3];
     Tcl_Obj *objPtr;
     Tcl_DString ds;
     const char **pathv;
@@ -286,12 +285,8 @@ AppendEnvironment(
      * this is a unicode string.
      */
 
-    if (GetEnvironmentVariableW(L"TCL_LIBRARY", wBuf, MAX_PATH) == 0) {
-	buf[0] = '\0';
-	GetEnvironmentVariableA("TCL_LIBRARY", buf, MAX_PATH);
-    } else {
-	ToUtf(wBuf, buf);
-    }
+    GetEnvironmentVariableW(L"TCL_LIBRARY", wBuf, MAX_PATH);
+    WideCharToMultiByte(CP_UTF8, 0, wBuf, -1, buf, MAX_PATH * 3, NULL, NULL);
 
     if (buf[0] != '\0') {
 	objPtr = Tcl_NewStringObj(buf, -1);
@@ -350,14 +345,11 @@ InitializeDefaultLibraryDir(
 {
     HMODULE hModule = TclWinGetTclInstance();
     WCHAR wName[MAX_PATH + LIBRARY_SIZE];
-    char name[(MAX_PATH + LIBRARY_SIZE) * TCL_UTF_MAX];
+    char name[(MAX_PATH + LIBRARY_SIZE) * 3];
     char *end, *p;
 
-    if (GetModuleFileNameW(hModule, wName, MAX_PATH) == 0) {
-	GetModuleFileNameA(hModule, name, MAX_PATH);
-    } else {
-	ToUtf(wName, name);
-    }
+    GetModuleFileNameW(hModule, wName, MAX_PATH);
+    WideCharToMultiByte(CP_UTF8, 0, wName, -1, name, MAX_PATH * 3, NULL, NULL);
 
     end = strrchr(name, '\\');
     *end = '\0';
@@ -401,14 +393,11 @@ InitializeSourceLibraryDir(
 {
     HMODULE hModule = TclWinGetTclInstance();
     WCHAR wName[MAX_PATH + LIBRARY_SIZE];
-    char name[(MAX_PATH + LIBRARY_SIZE) * TCL_UTF_MAX];
+    char name[(MAX_PATH + LIBRARY_SIZE) * 3];
     char *end, *p;
 
-    if (GetModuleFileNameW(hModule, wName, MAX_PATH) == 0) {
-	GetModuleFileNameA(hModule, name, MAX_PATH);
-    } else {
-	ToUtf(wName, name);
-    }
+    GetModuleFileNameW(hModule, wName, MAX_PATH);
+    WideCharToMultiByte(CP_UTF8, 0, wName, -1, name, MAX_PATH * 3, NULL, NULL);
 
     end = strrchr(name, '\\');
     *end = '\0';
@@ -429,38 +418,6 @@ InitializeSourceLibraryDir(
 /*
  *---------------------------------------------------------------------------
  *
- * ToUtf --
- *
- *	Convert a char string to a UTF string.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	None.
- *
- *---------------------------------------------------------------------------
- */
-
-static int
-ToUtf(
-    const WCHAR *wSrc,
-    char *dst)
-{
-    char *start;
-
-    start = dst;
-    while (*wSrc != '\0') {
-	dst += Tcl_UniCharToUtf(*wSrc, dst);
-	wSrc++;
-    }
-    *dst = '\0';
-    return (int) (dst - start);
-}
-
-/*
- *---------------------------------------------------------------------------
- *
  * TclpSetInitialEncodings --
  *
  *	Based on the locale, determine the encoding of the operating system
@@ -646,7 +603,7 @@ TclpSetVariables(
  * TclpFindVariable --
  *
  *	Locate the entry in environ for a given name. On Unix this routine is
- *	case sensitive, on Windows this matches mioxed case.
+ *	case sensitive, on Windows this matches mixed case.
  *
  * Results:
  *	The return value is the index in environ of an entry with the name
diff --git a/win/tclWinNotify.c b/win/tclWinNotify.c
index 28c8445..b34fc4f 100644
--- a/win/tclWinNotify.c
+++ b/win/tclWinNotify.c
@@ -36,7 +36,6 @@ typedef struct {
     int pending;		/* Alert message pending, this field is locked
 				 * by the notifierMutex. */
     HWND hwnd;			/* Messaging window. */
-    int timeout;		/* Current timeout value. */
     int timerActive;		/* 1 if interval timer is running. */
 } ThreadSpecificData;
 
@@ -309,11 +308,10 @@ Tcl_SetTimer(
 		timeout = 1;
 	    }
 	}
-	tsdPtr->timeout = timeout;
 	if (timeout != 0) {
 	    tsdPtr->timerActive = 1;
 	    SetTimer(tsdPtr->hwnd, INTERVAL_TIMER,
-		    (unsigned long) tsdPtr->timeout, NULL);
+		    timeout, NULL);
 	} else {
 	    tsdPtr->timerActive = 0;
 	    KillTimer(tsdPtr->hwnd, INTERVAL_TIMER);
diff --git a/win/tclWinPanic.c b/win/tclWinPanic.c
index d23ffcd..a71f506 100644
--- a/win/tclWinPanic.c
+++ b/win/tclWinPanic.c
@@ -35,7 +35,7 @@ Tcl_ConsolePanic(
 #define TCL_MAX_WARN_LEN 26000
     va_list argList;
     WCHAR msgString[TCL_MAX_WARN_LEN];
-    char buf[TCL_MAX_WARN_LEN * TCL_UTF_MAX];
+    char buf[TCL_MAX_WARN_LEN * 3];
     HANDLE handle = GetStdHandle(STD_ERROR_HANDLE);
     DWORD dummy;
 
diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c
index a357412..bd95ea4 100644
--- a/win/tclWinPipe.c
+++ b/win/tclWinPipe.c
@@ -869,7 +869,7 @@ TclpGetPid(
 
     Tcl_MutexLock(&pipeMutex);
     for (infoPtr = procList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
-	if (infoPtr->dwProcessId == (DWORD) pid) {
+	if (infoPtr->dwProcessId == (DWORD) (size_t) pid) {
 	    Tcl_MutexUnlock(&pipeMutex);
 	    return infoPtr->dwProcessId;
 	}
@@ -941,7 +941,7 @@ TclpCreateProcess(
     PROCESS_INFORMATION procInfo;
     SECURITY_ATTRIBUTES secAtts;
     HANDLE hProcess, h, inputHandle, outputHandle, errorHandle;
-    char execPath[MAX_PATH * TCL_UTF_MAX];
+    char execPath[MAX_PATH * 3];
     WinFile *filePtr;
 
     PipeInit();
@@ -1163,7 +1163,7 @@ TclpCreateProcess(
     WaitForInputIdle(procInfo.hProcess, 5000);
     CloseHandle(procInfo.hThread);
 
-    *pidPtr = (Tcl_Pid) procInfo.dwProcessId;
+    *pidPtr = (Tcl_Pid) (size_t) procInfo.dwProcessId;
     if (*pidPtr != 0) {
 	TclWinAddProcess(procInfo.hProcess, procInfo.dwProcessId);
     }
@@ -1272,7 +1272,7 @@ ApplicationType(
 
     /*
      * Look for the program as an external program. First try the name as it
-     * is, then try adding .com, .exe, and .bat, in that order, to the name,
+     * is, then try adding .com, .exe, .bat and .cmd, in that order, to the name,
      * looking for an executable.
      *
      * Using the raw SearchPath() function doesn't do quite what is necessary.
@@ -1391,7 +1391,7 @@ ApplicationType(
 	return APPL_NONE;
     }
 
-    if ((applType == APPL_DOS) || (applType == APPL_WIN3X)) {
+    if (applType == APPL_WIN3X) {
 	/*
 	 * Replace long path name of executable with short path name for
 	 * 16-bit applications. Otherwise the application may not be able to
@@ -1425,6 +1425,86 @@ ApplicationType(
  *----------------------------------------------------------------------
  */
 
+static const char *
+BuildCmdLineBypassBS(
+    const char *current,
+    const char **bspos
+) {
+    /* mark first backslash possition */
+    if (!*bspos) {
+	*bspos = current;
+    }
+    do {
+	current++;
+    } while (*current == '\\');
+    return current;
+}
+
+static void
+QuoteCmdLineBackslash(
+    Tcl_DString *dsPtr,
+    const char *start,
+    const char *current,
+    const char *bspos
+) {
+    if (!bspos) {
+	if (current > start) { /* part before current (special) */
+	    Tcl_DStringAppend(dsPtr, start, (int) (current - start));
+	}
+    } else {
+    	if (bspos > start) { /* part before first backslash */
+	    Tcl_DStringAppend(dsPtr, start, (int) (bspos - start));
+	}
+	while (bspos++ < current) { /* each backslash twice */
+	    TclDStringAppendLiteral(dsPtr, "\\\\");
+	}
+    }
+}
+
+static const char *
+QuoteCmdLinePart(
+    Tcl_DString *dsPtr,
+    const char *start,
+    const char *special,
+    const char *specMetaChars,
+    const char **bspos
+) {
+    if (!*bspos) {
+	/* rest before special (before quote) */
+	QuoteCmdLineBackslash(dsPtr, start, special, NULL);
+	start = special;
+    } else {
+	/* rest before first backslash and backslashes into new quoted block */
+	QuoteCmdLineBackslash(dsPtr, start, *bspos, NULL);
+	start = *bspos;
+    }
+    /*
+     * escape all special chars enclosed in quotes like `"..."`, note that here we
+     * don't must escape `\` (with `\`), because it's outside of the main quotes,
+     * so `\` remains `\`, but important - not at end of part, because results as
+     * before the quote,  so `%\%\` should be escaped as `"%\%"\\`).
+     */
+    TclDStringAppendLiteral(dsPtr, "\""); /* opening escape quote-char */
+    do {
+    	*bspos = NULL;
+	special++;
+	if (*special == '\\') {
+	    /* bypass backslashes (and mark first backslash possition)*/
+	    special = BuildCmdLineBypassBS(special, bspos);
+	    if (*special == '\0') break;
+	}
+    } while (*special && strchr(specMetaChars, *special));
+    if (!*bspos) {
+	/* unescaped rest before quote */
+	QuoteCmdLineBackslash(dsPtr, start, special, NULL);
+    } else {
+	/* unescaped rest before first backslash (rather belongs to the main block) */
+	QuoteCmdLineBackslash(dsPtr, start, *bspos, NULL);
+    }
+    TclDStringAppendLiteral(dsPtr, "\""); /* closing escape quote-char */
+    return special;
+}
+
 static void
 BuildCommandLine(
     const char *executable,	/* Full path of executable (including
@@ -1434,10 +1514,22 @@ BuildCommandLine(
     Tcl_DString *linePtr)	/* Initialized Tcl_DString that receives the
 				 * command line (TCHAR). */
 {
-    const char *arg, *start, *special;
-    int quote, i;
+    const char *arg, *start, *special, *bspos;
+    int quote = 0, i;
     Tcl_DString ds;
 
+    /* characters to enclose in quotes if unpaired quote flag set */
+    const static char *specMetaChars = "&|^<>!()%";
+    /* characters to enclose in quotes in any case (regardless unpaired-flag) */
+    const static char *specMetaChars2 = "%";
+
+    /* Quote flags:
+     *   CL_ESCAPE   - escape argument;
+     *   CL_QUOTE    - enclose in quotes;
+     *   CL_UNPAIRED - previous arguments chain contains unpaired quote-char;
+     */
+    enum {CL_ESCAPE = 1, CL_QUOTE = 2, CL_UNPAIRED = 4};
+
     Tcl_DStringInit(&ds);
 
     /*
@@ -1457,61 +1549,98 @@ BuildCommandLine(
 	    TclDStringAppendLiteral(&ds, " ");
 	}
 
-	quote = 0;
+	quote &= ~(CL_ESCAPE|CL_QUOTE); /* reset escape flags */
+	bspos = NULL;
 	if (arg[0] == '\0') {
-	    quote = 1;
+	    quote = CL_QUOTE;
 	} else {
 	    int count;
-	    Tcl_UniChar ch = 0;
-
-	    for (start = arg; *start != '\0'; start += count) {
-		count = TclUtfToUniChar(start, &ch);
-		if (Tcl_UniCharIsSpace(ch)) {	/* INTL: ISO space. */
-		    quote = 1;
+	    Tcl_UniChar ch;
+	    for (start = arg;
+		*start != '\0' &&
+		    (quote & (CL_ESCAPE|CL_QUOTE)) != (CL_ESCAPE|CL_QUOTE);
+		start += count
+	    ) {
+		count = Tcl_UtfToUniChar(start, &ch);
+		if (count > 1) continue;
+		if (Tcl_UniCharIsSpace(ch)) {
+		    quote |= CL_QUOTE; /* quote only */
+		    if (bspos) { /* if backslash found - escape & quote */
+			quote |= CL_ESCAPE;
+			break;
+		    }
+		    continue;
+		}
+		if (strchr(specMetaChars, *start)) {
+		    quote |= (CL_ESCAPE|CL_QUOTE); /*escape & quote */
 		    break;
 		}
+		if (*start == '"') {
+		    quote |= CL_ESCAPE; /* escape only */
+		    continue;
+		}
+		if (*start == '\\') {
+		    bspos = start;
+		    if (quote & CL_QUOTE) { /* if quote - escape & quote */
+			quote |= CL_ESCAPE;
+			break;
+		    }
+		    continue;
+		}
 	    }
+	    bspos = NULL;
 	}
-	if (quote) {
+	if (quote & CL_QUOTE) {
+	    /* start of argument (main opening quote-char) */
 	    TclDStringAppendLiteral(&ds, "\"");
 	}
-	start = arg;
-	for (special = arg; ; ) {
-	    if ((*special == '\\') && (special[1] == '\\' ||
-		    special[1] == '"' || (quote && special[1] == '\0'))) {
-		Tcl_DStringAppend(&ds, start, (int) (special - start));
-		start = special;
-		while (1) {
-		    special++;
-		    if (*special == '"' || (quote && *special == '\0')) {
-			/*
-			 * N backslashes followed a quote -> insert N * 2 + 1
-			 * backslashes then a quote.
-			 */
-
-			Tcl_DStringAppend(&ds, start,
-				(int) (special - start));
-			break;
-		    }
-		    if (*special != '\\') {
-			break;
-		    }
+	if (!(quote & CL_ESCAPE)) {
+	    /* nothing to escape */
+	    Tcl_DStringAppend(&ds, arg, -1);
+	} else {
+	    start = arg;
+	    for (special = arg; *special != '\0'; ) {
+		/* position of `\` is important before quote or at end (equal `\"` because quoted) */
+		if (*special == '\\') {
+		    /* bypass backslashes (and mark first backslash possition)*/
+		    special = BuildCmdLineBypassBS(special, &bspos);
+		    if (*special == '\0') break;
 		}
-		Tcl_DStringAppend(&ds, start, (int) (special - start));
-		start = special;
-	    }
-	    if (*special == '"') {
-		Tcl_DStringAppend(&ds, start, (int) (special - start));
-		TclDStringAppendLiteral(&ds, "\\\"");
-		start = special + 1;
-	    }
-	    if (*special == '\0') {
-		break;
+		/* ["] */
+		if (*special == '"') {
+		    quote ^= CL_UNPAIRED; /* invert unpaired flag - observe unpaired quotes */
+		    /* add part before (and escape backslashes before quote) */
+		    QuoteCmdLineBackslash(&ds, start, special, bspos);
+		    bspos = NULL;
+		    /* escape using backslash */
+		    TclDStringAppendLiteral(&ds, "\\\"");
+		    start = ++special;
+		    continue;
+		}
+		/* unpaired (escaped) quote causes special handling on meta-chars */
+		if ((quote & CL_UNPAIRED) && strchr(specMetaChars, *special)) {
+		    special = QuoteCmdLinePart(&ds, start, special, specMetaChars, &bspos);
+		    /* start to current or first backslash */
+		    start = !bspos ? special : bspos;
+		    continue;
+		}
+		/* special case for % - should be enclosed always (paired also) */
+		if (strchr(specMetaChars2, *special)) {
+		    special = QuoteCmdLinePart(&ds, start, special, specMetaChars2, &bspos);
+		    /* start to current or first backslash */
+		    start = !bspos ? special : bspos;
+		    continue;
+		}
+		/* other not special (and not meta) character */
+		bspos = NULL; /* reset last backslash possition (not interesting) */
+		special++;
 	    }
-	    special++;
+	    /* rest of argument (and escape backslashes before closing main quote) */
+	    QuoteCmdLineBackslash(&ds, start, special,
+	    	(quote & CL_QUOTE) ? bspos : NULL);
 	}
-	Tcl_DStringAppend(&ds, start, (int) (special - start));
-	if (quote) {
+	if (quote & CL_QUOTE) {
+	    /* end of argument (main closing quote-char) */
 	    TclDStringAppendLiteral(&ds, "\"");
 	}
     }
@@ -2347,7 +2476,7 @@ Tcl_WaitPid(
     prevPtrPtr = &procList;
     for (infoPtr = procList; infoPtr != NULL;
 	    prevPtrPtr = &infoPtr->nextPtr, infoPtr = infoPtr->nextPtr) {
-	 if (infoPtr->dwProcessId == (DWORD) pid) {
+	 if (infoPtr->dwProcessId == (DWORD) (size_t) pid) {
 	    *prevPtrPtr = infoPtr->nextPtr;
 	    break;
 	}
diff --git a/win/tclWinReg.c b/win/tclWinReg.c
index de48b9b..95ab499 100644
--- a/win/tclWinReg.c
+++ b/win/tclWinReg.c
@@ -22,13 +22,6 @@
 #endif
 #include <stdlib.h>
 
-#ifndef UNICODE
-#   undef Tcl_WinTCharToUtf
-#   define Tcl_WinTCharToUtf(a,b,c)	Tcl_ExternalToUtfDString(NULL,a,b,c)
-#   undef Tcl_WinUtfToTChar
-#   define Tcl_WinUtfToTChar(a,b,c)	Tcl_UtfToExternalDString(NULL,a,b,c)
-#endif /* !UNICODE */
-
 /*
  * Ensure that we can say which registry is being accessed.
  */
diff --git a/win/tclWinSock.c b/win/tclWinSock.c
index 1c004838..f872163 100644
--- a/win/tclWinSock.c
+++ b/win/tclWinSock.c
@@ -738,8 +738,8 @@ WaitForConnect(
 	}
 
 	/*
-	 * A non blocking socket waiting for an asyncronous connect returns
-	 * directly the error EWOULDBLOCK.
+	 * A non blocking socket waiting for an asynchronous connect
+	 * returns directly the error EWOULDBLOCK
 	 */
 
 	if (GOT_BITS(statePtr->flags, TCP_NONBLOCKING)) {
@@ -1690,9 +1690,9 @@ TcpGetHandleProc(
  *
  *	This might be called in 3 circumstances:
  *	-   By a regular socket command
- *	-   By the event handler to continue an asynchroneous connect
+ *	-   By the event handler to continue an asynchronously connect
  *	-   By a blocking socket function (gets/puts) to terminate the
- *	    connect synchroneously
+ *	    connect synchronously
  *
  * Results:
  *      TCL_OK, if the socket was successfully connected or an asynchronous
@@ -1704,7 +1704,7 @@ TcpGetHandleProc(
  *
  * Remarks:
  *	A single host name may resolve to more than one IP address, e.g. for
- *	an IPv4/IPv6 dual stack host. For handling asyncronously connecting
+ *	an IPv4/IPv6 dual stack host. For handling asynchronously connecting
  *	sockets in the background for such hosts, this function can act as a
  *	coroutine. On the first call, it sets up the control variables for the
  *	two nested loops over the local and remote addresses. Once the first
@@ -1712,7 +1712,7 @@ TcpGetHandleProc(
  *	event handler for that socket, and returns. When the callback occurs,
  *	control is transferred to the "reenter" label, right after the initial
  *	return and the loops resume as if they had never been interrupted.
- *	For syncronously connecting sockets, the loops work the usual way.
+ *	For synchronously connecting sockets, the loops work the usual way.
  *
  *----------------------------------------------------------------------
  */
@@ -1816,7 +1816,7 @@ TcpConnect(
 	    }
 
 	    /*
-	     * For asyncroneous connect set the socket in nonblocking mode
+	     * For asynchroneous connect set the socket in nonblocking mode
 	     * and activate connect notification
 	     */
 
@@ -1930,8 +1930,8 @@ TcpConnect(
 	    }
 
 	    /*
-	     * Clear the tsd socket list pointer if we did not wait for the
-	     * FD_CONNECT asynchronously.
+	     * Clear the tsd socket list pointer if we did not wait for
+	     * the FD_CONNECT asynchroneously
 	     */
 
 	    tsdPtr->pendingTcpState = NULL;
@@ -2014,7 +2014,7 @@ TcpConnect(
 	}
 
 	/*
-	 * Error message on syncroneous connect
+	 * Error message on synchroneous connect
 	 */
 
 	if (interp != NULL) {
diff --git a/win/tclWinThrd.c b/win/tclWinThrd.c
index 5ea407e..d169ebb 100644
--- a/win/tclWinThrd.c
+++ b/win/tclWinThrd.c
@@ -241,7 +241,7 @@ TclpThreadCreate(
 
 	/*
 	 * The only purpose of this is to decrement the reference count so the
-	 * OS resources will be reaquired when the thread closes.
+	 * OS resources will be reacquired when the thread closes.
 	 */
 
 	CloseHandle(tHandle);
@@ -399,7 +399,7 @@ TclpInitUnlock(void)
  *	mutexes, condition variables, and thread local storage keys.
  *
  *	This lock must be different than the initLock because the initLock is
- *	held during creation of syncronization objects.
+ *	held during creation of synchronization objects.
  *
  * Results:
  *	None.
@@ -549,7 +549,7 @@ static void		FinalizeConditionEvent(ClientData data);
  *	None.
  *
  * Side effects:
- *	May block the current thread. The mutex is aquired when this returns.
+ *	May block the current thread. The mutex is acquired when this returns.
  *
  *----------------------------------------------------------------------
  */
@@ -649,7 +649,7 @@ TclpFinalizeMutex(
  *	None.
  *
  * Side effects:
- *	May block the current thread. The mutex is aquired when this returns.
+ *	May block the current thread. The mutex is acquired when this returns.
  *	Will allocate memory for a HANDLE and initialize this the first time
  *	this Tcl_Condition is used.
  *