Added documentation

object/class mutation.

.fossil-settings/binary-glob

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

.fossil-settings/crnl-glob

@@ -1,19 +0,0 @@
-compat/zlib/contrib/dotzlib/DotZLib/UnitTests.cs
-compat/zlib/contrib/vstudio/readme.txt
-compat/zlib/contrib/vstudio/*/zlib.rc
-compat/zlib/win32/*.txt
-compat/zlib/win64/*.txt
-libtommath/*.dsp
-libtommath/*.sln
-libtommath/*.vcproj
-tools/tcl.hpj.in
-tools/tcl.wse.in
-win/buildall.vc.bat
-win/coffbase.txt
-win/makefile.vc
-win/rules.vc
-win/rules-ext.vc
-win/targets.vc
-win/tcl.dsp
-win/tcl.dsw
-win/tcl.hpj.in

ChangeLog.2007

@@ -1426,7 +1426,7 @@
 	initialization assumptions of the TIP 280 code in CompileWord().
 
 	* generic/tclCompExpr.c:	Suppress the attempt to convert to
-	numeric when pre-compiling a constant expresion indicates an error.
+	numeric when pre-compiling a constant expression indicates an error.
 
 2007-08-22  Miguel Sofer  <msofer@users.sf.net>
 

compat/fixstrtod.c

@@ -1,36 +0,0 @@
-/*
- * fixstrtod.c --
- *
- *	Source code for the "fixstrtod" procedure.  This procedure is
- *	used in place of strtod under Solaris 2.4, in order to fix
- *	a bug where the "end" pointer gets set incorrectly.
- *
- * Copyright (c) 1995 Sun Microsystems, Inc.
- *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- */
-
-#include <stdio.h>
-
-#undef strtod
-
-/*
- * Declare strtod explicitly rather than including stdlib.h, since in
- * somes systems (e.g. SunOS 4.1.4) stdlib.h doesn't declare strtod.
- */
-
-extern double strtod(char *, char **);
-
-double
-fixstrtod(
-    char *string,
-    char **endPtr)
-{
-    double d;
-    d = strtod(string, endPtr);
-    if ((endPtr != NULL) && (*endPtr != string) && ((*endPtr)[-1] == 0)) {
-	*endPtr -= 1;
-    }
-    return d;
-}

compat/stdlib.h

@@ -29,7 +29,6 @@ extern char *		malloc(unsigned int numBytes);
 extern void		qsort(void *base, int n, int size, int (*compar)(
 			    const void *element1, const void *element2));
 extern char *		realloc(char *ptr, unsigned int numBytes);
-extern double		strtod(const char *string, char **endPtr);
 extern long		strtol(const char *string, char **endPtr, int base);
 extern unsigned long	strtoul(const char *string, char **endPtr, int base);
 

compat/strtod.c

@@ -1,252 +0,0 @@
-/*
- * strtod.c --
- *
- *	Source code for the "strtod" library procedure.
- *
- * Copyright (c) 1988-1993 The Regents of the University of California.
- * Copyright (c) 1994 Sun Microsystems, Inc.
- *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- */
-
-#include "tclInt.h"
-
-#ifndef TRUE
-#define TRUE 1
-#define FALSE 0
-#endif
-#ifndef NULL
-#define NULL 0
-#endif
-
-static const int maxExponent = 511;	/* Largest possible base 10 exponent.  Any
-				 * exponent larger than this will already
-				 * produce underflow or overflow, so there's
-				 * no need to worry about additional digits.
-				 */
-static const double powersOf10[] = {	/* Table giving binary powers of 10.  Entry */
-    10.,			/* is 10^2^i.  Used to convert decimal */
-    100.,			/* exponents into floating-point numbers. */
-    1.0e4,
-    1.0e8,
-    1.0e16,
-    1.0e32,
-    1.0e64,
-    1.0e128,
-    1.0e256
-};
-
-/*
- *----------------------------------------------------------------------
- *
- * strtod --
- *
- *	This procedure converts a floating-point number from an ASCII
- *	decimal representation to internal double-precision format.
- *
- * Results:
- *	The return value is the double-precision floating-point
- *	representation of the characters in string.  If endPtr isn't
- *	NULL, then *endPtr is filled in with the address of the
- *	next character after the last one that was part of the
- *	floating-point number.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-double
-strtod(
-    const char *string,		/* A decimal ASCII floating-point number,
-				 * optionally preceded by white space. Must
-				 * have form "-I.FE-X", where I is the integer
-				 * part of the mantissa, F is the fractional
-				 * part of the mantissa, and X is the
-				 * exponent. Either of the signs may be "+",
-				 * "-", or omitted. Either I or F may be
-				 * omitted, or both. The decimal point isn't
-				 * necessary unless F is present. The "E" may
-				 * actually be an "e". E and X may both be
-				 * omitted (but not just one). */
-    char **endPtr)		/* If non-NULL, store terminating character's
-				 * address here. */
-{
-    int sign, expSign = FALSE;
-    double fraction, dblExp;
-    const double *d;
-    register const char *p;
-    register int c;
-    int exp = 0;		/* Exponent read from "EX" field. */
-    int fracExp = 0;		/* Exponent that derives from the fractional
-				 * part. Under normal circumstatnces, it is
-				 * the negative of the number of digits in F.
-				 * However, if I is very long, the last digits
-				 * of I get dropped (otherwise a long I with a
-				 * large negative exponent could cause an
-				 * unnecessary overflow on I alone). In this
-				 * case, fracExp is incremented one for each
-				 * dropped digit. */
-    int mantSize;		/* Number of digits in mantissa. */
-    int decPt;			/* Number of mantissa digits BEFORE decimal
-				 * point. */
-    const char *pExp;		/* Temporarily holds location of exponent in
-				 * string. */
-
-    /*
-     * Strip off leading blanks and check for a sign.
-     */
-
-    p = string;
-    while (isspace(UCHAR(*p))) {
-	p += 1;
-    }
-    if (*p == '-') {
-	sign = TRUE;
-	p += 1;
-    } else {
-	if (*p == '+') {
-	    p += 1;
-	}
-	sign = FALSE;
-    }
-
-    /*
-     * Count the number of digits in the mantissa (including the decimal
-     * point), and also locate the decimal point.
-     */
-
-    decPt = -1;
-    for (mantSize = 0; ; mantSize += 1)
-    {
-	c = *p;
-	if (!isdigit(c)) {
-	    if ((c != '.') || (decPt >= 0)) {
-		break;
-	    }
-	    decPt = mantSize;
-	}
-	p += 1;
-    }
-
-    /*
-     * Now suck up the digits in the mantissa. Use two integers to collect 9
-     * digits each (this is faster than using floating-point). If the mantissa
-     * has more than 18 digits, ignore the extras, since they can't affect the
-     * value anyway.
-     */
-
-    pExp  = p;
-    p -= mantSize;
-    if (decPt < 0) {
-	decPt = mantSize;
-    } else {
-	mantSize -= 1;		/* One of the digits was the point. */
-    }
-    if (mantSize > 18) {
-	fracExp = decPt - 18;
-	mantSize = 18;
-    } else {
-	fracExp = decPt - mantSize;
-    }
-    if (mantSize == 0) {
-	fraction = 0.0;
-	p = string;
-	goto done;
-    } else {
-	int frac1, frac2;
-
-	frac1 = 0;
-	for ( ; mantSize > 9; mantSize -= 1) {
-	    c = *p;
-	    p += 1;
-	    if (c == '.') {
-		c = *p;
-		p += 1;
-	    }
-	    frac1 = 10*frac1 + (c - '0');
-	}
-	frac2 = 0;
-	for (; mantSize > 0; mantSize -= 1) {
-	    c = *p;
-	    p += 1;
-	    if (c == '.') {
-		c = *p;
-		p += 1;
-	    }
-	    frac2 = 10*frac2 + (c - '0');
-	}
-	fraction = (1.0e9 * frac1) + frac2;
-    }
-
-    /*
-     * Skim off the exponent.
-     */
-
-    p = pExp;
-    if ((*p == 'E') || (*p == 'e')) {
-	p += 1;
-	if (*p == '-') {
-	    expSign = TRUE;
-	    p += 1;
-	} else {
-	    if (*p == '+') {
-		p += 1;
-	    }
-	    expSign = FALSE;
-	}
-	if (!isdigit(UCHAR(*p))) {
-	    p = pExp;
-	    goto done;
-	}
-	while (isdigit(UCHAR(*p))) {
-	    exp = exp * 10 + (*p - '0');
-	    p += 1;
-	}
-    }
-    if (expSign) {
-	exp = fracExp - exp;
-    } else {
-	exp = fracExp + exp;
-    }
-
-    /*
-     * Generate a floating-point number that represents the exponent. Do this
-     * by processing the exponent one bit at a time to combine many powers of
-     * 2 of 10. Then combine the exponent with the fraction.
-     */
-
-    if (exp < 0) {
-	expSign = TRUE;
-	exp = -exp;
-    } else {
-	expSign = FALSE;
-    }
-    if (exp > maxExponent) {
-	exp = maxExponent;
-	errno = ERANGE;
-    }
-    dblExp = 1.0;
-    for (d = powersOf10; exp != 0; exp >>= 1, ++d) {
-	if (exp & 01) {
-	    dblExp *= *d;
-	}
-    }
-    if (expSign) {
-	fraction /= dblExp;
-    } else {
-	fraction *= dblExp;
-    }
-
-  done:
-    if (endPtr != NULL) {
-	*endPtr = (char *) p;
-    }
-
-    if (sign) {
-	return -fraction;
-    }
-    return fraction;
-}

compat/zlib/contrib/minizip/minizip.c

@@ -27,7 +27,7 @@
         #endif
 #endif
 
-#ifdef __APPLE__
+#if defined(__APPLE__) || defined(IOAPI_NO_64)
 // In darwin and perhaps other BSD variants off_t is a 64 bit value, hence no need for specific 64 bit functions
 #define FOPEN_FUNC(filename, mode) fopen(filename, mode)
 #define FTELLO_FUNC(stream) ftello(stream)
@@ -359,7 +359,7 @@ void addFileToZip(zipFile zf, const char *filenameinzip, const char *password, i
 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];
+    char newname[512];
 
     tinydir_open_sorted(&dir, filenameinzip);
 

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 Tcl_RegisterCommandTypeName, Tcl_GetCommandTypeName \- 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

doc/Thread.3

@@ -45,7 +45,9 @@ int
 .AP Tcl_Condition *condPtr in
 A condition variable, which must be associated with a mutex lock.
 .AP Tcl_Mutex *mutexPtr in
-A mutex lock.
+.VS TIP509
+A recursive mutex lock.
+.VE TIP509
 .AP "const Tcl_Time" *timePtr in
 A time limit on the condition wait.  NULL to wait forever.
 Note that a polling value of 0 seconds does not make much sense.
@@ -140,8 +142,12 @@ of code by calling \fBTcl_MutexLock\fR and \fBTcl_MutexUnlock\fR.
 If one thread holds a mutex, any other thread calling \fBTcl_MutexLock\fR will
 block until \fBTcl_MutexUnlock\fR is called.
 A mutex can be destroyed after its use by calling \fBTcl_MutexFinalize\fR.
-The result of locking a mutex twice from the same thread is undefined.
-On some platforms it will result in a deadlock.
+.VS TIP509
+Mutexes are reentrant: they can be locked several times from the same
+thread. However there must be exactly one call to
+\fBTcl_MutexUnlock\fR for each call to \fBTcl_MutexLock\fR in order
+for a thread to release a mutex completely.
+.VE TIP509
 The \fBTcl_MutexLock\fR, \fBTcl_MutexUnlock\fR and \fBTcl_MutexFinalize\fR
 procedures are defined as empty macros if not compiling with threads enabled.
 For declaration of mutexes the \fBTCL_DECLARE_MUTEX\fR macro should be used.

doc/cd.n

@@ -41,3 +41,7 @@ current one:
 filename(n), glob(n), pwd(n)
 .SH KEYWORDS
 working directory
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:

doc/clock.n

@@ -886,40 +886,46 @@ The \fIinputString\fR argument consists of zero or more specifications of the
 following form:
 .TP
 \fItime\fR
-A time of day, which is of the form: \fBhh?:mm?:ss?? ?meridian? ?zone?\fR
-or \fBhhmm ?meridian? ?zone?\fR
-If no meridian is specified, \fBhh\fR is interpreted on
+.
+A time of day, which is of the form:
+.QW "\fIhh\fR?\fB:\fImm\fR?\fB:\fIss\fR?? ?\fImeridian\fR? ?\fIzone\fR?"
+or
+.QW "\fBhhmm \fR?\fBmeridian\fR? ?\fBzone\fR?" .
+If no \fImeridian\fR is specified, \fIhh\fR is interpreted on
 a 24-hour clock.
 .TP
 \fIdate\fR
+.
 A specific month and day with optional year.  The
 acceptable formats are
-.QW "\fBmm/dd\fR?\fB/yy\fR?" ,
-.QW "\fBmonthname dd\fR?\fB, yy\fR?" ,
-.QW "\fBday, dd monthname \fR?\fByy\fR?" ,
-.QW "\fBdd monthname yy\fR" ,
-.QW "?\fBCC\fR?\fByymmdd\fR" ,
+.QW "\fImm\fB/\fIdd\fR?\fB/\fIyy\fR?" ,
+.QW "\fImonthname dd\fR?\fB, \fIyy\fR?" ,
+.QW "\fIday\fB, \fIdd monthname \fR?\fIyy\fR?" ,
+.QW "\fIdd monthname yy\fR" ,
+.QW "?\fICC\fR?\fIyymmdd\fR" ,
 and
-.QW "\fBdd-monthname-\fR?\fBCC\fR?\fByy\fR" .
+.QW "\fIdd\fB-\fImonthname\fB-\fR?\fICC\fR?\fIyy\fR" .
 The default year is the current year.  If the year is less
 than 100, we treat the years 00-68 as 2000-2068 and the years 69-99
 as 1969-1999.  Not all platforms can represent the years 38-70, so
 an error may result if these years are used.
 .TP
 \fIISO 8601 point-in-time\fR
+.
 An ISO 8601 point-in-time specification, such as
 .QW \fICCyymmdd\fBT\fIhhmmss\fR,
 where \fBT\fR is the literal
 .QW T ,
 .QW "\fICCyymmdd hhmmss\fR" ,
 or
-.QW \fICCyymmdd\fBT\fIhh:mm:ss\fR .
+.QW \fICCyymmdd\fBT\fIhh\fB:\fImm\fB:\fIss\fR .
 Note that only these three formats are accepted.
 The command does \fInot\fR accept the full range of point-in-time
 specifications specified in ISO8601.  Other formats can be recognized by
 giving an explicit \fB\-format\fR option to the \fBclock scan\fR command.
 .TP
 \fIrelative time\fR
+.
 A specification relative to the current time.  The format is \fBnumber
 unit\fR. Acceptable units are \fByear\fR, \fBfortnight\fR,
 \fBmonth\fR, \fBweek\fR, \fBday\fR,

doc/cookiejar.n

@@ -0,0 +1,217 @@
+'\"
+'\" Copyright (c) 2014-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 "cookiejar" n 0.1 http "Tcl Bundled Packages"
+.so man.macros
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+cookiejar \- Implementation of the Tcl http package cookie jar protocol
+.SH SYNOPSIS
+.nf
+\fBpackage require\fR \fBcookiejar\fR ?\fB0.1\fR?
+
+\fB::http::cookiejar configure\fR ?\fIoptionName\fR? ?\fIoptionValue\fR?
+\fB::http::cookiejar create\fR \fIname\fR ?\fIfilename\fR?
+\fB::http::cookiejar new\fR ?\fIfilename\fR?
+
+\fIcookiejar\fR \fBdestroy\fR
+\fIcookiejar\fR \fBforceLoadDomainData\fR
+\fIcookiejar\fR \fBgetCookies\fR \fIprotocol host path\fR
+\fIcookiejar\fR \fBstoreCookie\fR \fIoptions\fR
+\fIcookiejar\fR \fBlookup\fR ?\fIhost\fR? ?\fIkey\fR?
+.fi
+.SH DESCRIPTION
+.PP
+The cookiejar package provides an implementation of the http package's cookie
+jar protocol using an SQLite database. It provides one main command,
+\fB::http::cookiejar\fR, which is a TclOO class that should be instantiated to
+create a cookie jar that manages a particular HTTP session.
+.PP
+The database management policy can be controlled at the package level by the
+\fBconfigure\fR method on the \fB::http::cookiejar\fR class object:
+.TP
+\fB::http::cookiejar configure\fR ?\fIoptionName\fR? ?\fIoptionValue\fR?
+.
+If neither \fIoptionName\fR nor \fIoptionValue\fR are supplied, this returns a
+copy of the configuration as a Tcl dictionary. If just \fIoptionName\fR is
+supplied, just the value of the named option is returned. If both
+\fIoptionName\fR and \fIoptionValue\fR are given, the named option is changed
+to be the given value.
+.RS
+.PP
+Supported options are:
+.TP
+\fB\-domainfile \fIfilename\fR
+.
+A file (defaulting to within the cookiejar package) with a description of the
+list of top-level domains (e.g., \fB.com\fR or \fB.co.jp\fR). Such domains
+\fImust not\fR accept cookies set upon them. Note that the list of such
+domains is both security-sensitive and \fInot\fR constant and should be
+periodically refetched. Cookie jars maintain their own cache of the domain
+list.
+.TP
+\fB\-domainlist \fIurl\fR
+.
+A URL to fetch the list of top-level domains (e.g., \fB.com\fR or
+\fB.co.jp\fR) from.  Such domains \fImust not\fR accept cookies set upon
+them. Note that the list of such domains is both security-sensitive and
+\fInot\fR constant and should be periodically refetched. Cookie jars maintain
+their own cache of the domain list.
+.TP
+\fB\-domainrefresh \fIintervalMilliseconds\fR
+.
+The number of milliseconds between checks of the \fI\-domainlist\fR for new
+domains.
+.TP
+\fB\-loglevel \fIlevel\fR
+.
+The logging level of this package. The logging level must be (in order of
+decreasing verbosity) one of \fBdebug\fR, \fBinfo\fR, \fBwarn\fR, or
+\fBerror\fR.
+.TP
+\fB\-offline \fIflag\fR
+.
+Allows the cookie managment engine to be placed into offline mode. In offline
+mode, the list of domains is read immediately from the file configured in the
+\fB\-domainfile\fR option, and the \fB\-domainlist\fR option is not used; it
+also makes the \fB\-domainrefresh\fR option be effectively ignored.
+.TP
+\fB\-purgeold \fIintervalMilliseconds\fR
+.
+The number of milliseconds between checks of the database for expired
+cookies; expired cookies are deleted.
+.TP
+\fB\-retain \fIcookieCount\fR
+.
+The maximum number of cookies to retain in the database.
+.TP
+\fB\-vacuumtrigger \fIdeletionCount\fR
+.
+A count of the number of persistent cookie deletions to go between vacuuming
+the database.
+.RE
+.PP
+Cookie jar instances may be made with any of the standard TclOO instance
+creation methods (\fBcreate\fR or \fRnew\fR).
+.TP
+\fB::http::cookiejar new\fR ?\fIfilename\fR?
+.
+If a \fIfilename\fR argument is provided, it is the name of a file containing
+an SQLite database that will contain the persistent cookies maintained by the
+cookie jar; the database will be created if the file does not already
+exist. If \fIfilename\fR is not supplied, the database will be held entirely within
+memory, which effectively forces all cookies within it to be session cookies.
+.SS "INSTANCE METHODS"
+.PP
+The following methods are supported on the instances:
+.TP
+\fIcookiejar\fR \fBdestroy\fR
+.
+This is the standard TclOO destruction method. It does \fInot\fR delete the
+SQLite database if it is written to disk. Callers are responsible for ensuring
+that the cookie jar is not in use by the http package at the time of
+destruction.
+.TP
+\fIcookiejar\fR \fBforceLoadDomainData\fR
+.
+This method causes the cookie jar to immediately load (and cache) the domain
+list data. The domain list will be loaded from the \fB\-domainlist\fR
+configured a the package level if that is enabled, and otherwise will be
+obtained from the \fB\-domainfile\fR configured at the package level.
+.TP
+\fIcookiejar\fR \fBgetCookies\fR \fIprotocol host path\fR
+.
+This method obtains the cookies for a particular HTTP request. \fIThis
+implements the http cookie jar protocol.\fR
+.TP
+\fIcookiejar\fR \fBpolicyAllow\fR \fIoperation domain path\fR
+.
+This method is called by the \fBstoreCookie\fR method to get a decision on
+whether to allow \fIoperation\fR to be performed for the \fIdomain\fR and
+\fIpath\fR. This is checked immediately before the database is updated but
+after the built-in security checks are done, and should return a boolean
+value; if the value is false, the operation is rejected and the database is
+not modified. The supported \fIoperation\fRs are:
+.RS
+.TP
+\fBdelete\fR
+.
+The \fIdomain\fR is seeking to delete a cookie.
+.TP
+\fBsession\fR
+.
+The \fIdomain\fR is seeking to create or update a session cookie.
+.TP
+\fBset\fR
+.
+The \fIdomain\fR is seeking to create or update a persistent cookie (with a
+defined lifetime).
+.PP
+The default implementation of this method just returns true, but subclasses of
+this class may impose their own rules.
+.RE
+.TP
+\fIcookiejar\fR \fBstoreCookie\fR \fIoptions\fR
+.
+This method stores a single cookie from a particular HTTP response. Cookies
+that fail security checks are ignored. \fIThis implements the http cookie jar
+protocol.\fR
+.TP
+\fIcookiejar\fR \fBlookup\fR ?\fIhost\fR? ?\fIkey\fR?
+.
+This method looks a cookie by exact host (or domain) matching. If neither
+\fIhost\fR nor \fIkey\fR are supplied, the list of hosts for which a cookie is
+stored is returned. If just \fIhost\fR (which may be a hostname or a domain
+name) is supplied, the list of cookie keys stored for that host is returned.
+If both \fIhost\fR and \fIkey\fR are supplied, the value for that key is
+returned; it is an error if no such host or key match exactly.
+.SH "EXAMPLES"
+.PP
+The simplest way of using a cookie jar is to just permanently configure it at
+the start of the application.
+.PP
+.CS
+package require http
+\fBpackage require cookiejar\fR
+
+set cookiedb ~/.tclcookies.db
+http::configure -cookiejar [\fBhttp::cookiejar new\fR $cookiedb]
+
+# No further explicit steps are required to use cookies
+set tok [http::geturl http://core.tcl.tk/]
+.CE
+.PP
+To only allow a particular domain to use cookies, perhaps because you only
+want to enable a particular host to create and manipulate sessions, create a
+subclass that imposes that policy.
+.PP
+.CS
+package require http
+\fBpackage require cookiejar\fR
+
+oo::class create MyCookieJar {
+    superclass \fBhttp::cookiejar\fR
+
+    method \fBpolicyAllow\fR {operation domain path} {
+        return [expr {$domain eq "my.example.com"}]
+    }
+}
+
+set cookiedb ~/.tclcookies.db
+http::configure -cookiejar [MyCookieJar new $cookiedb]
+
+# No further explicit steps are required to use cookies
+set tok [http::geturl http://core.tcl.tk/]
+.CE
+.SH "SEE ALSO"
+http(n), oo::class(n), sqlite3(n)
+.SH KEYWORDS
+cookie, internet, security policy, www
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:

doc/eof.n

@@ -59,3 +59,7 @@ while {1} {
 file(n), open(n), close(n), fblocked(n), Tcl_StandardChannels(3)
 .SH KEYWORDS
 channel, end of file
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:

doc/exit.n

@@ -49,3 +49,7 @@ if {[catch {main} msg options]} {
 exec(n)
 .SH KEYWORDS
 abort, exit, process
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:

doc/fblocked.n

@@ -65,3 +65,7 @@ vwait forever
 gets(n), open(n), read(n), socket(n), Tcl_StandardChannels(3)
 .SH KEYWORDS
 blocking, nonblocking
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:

doc/fileevent.n

@@ -154,3 +154,7 @@ fconfigure(n), gets(n), interp(n), puts(n), read(n), Tcl_StandardChannels(3)
 .SH KEYWORDS
 asynchronous I/O, blocking, channel, event handler, nonblocking, readable,
 script, writable.
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:

doc/filename.n

@@ -176,3 +176,7 @@ file(n), glob(n)
 .SH KEYWORDS
 current directory, absolute file name, relative file name,
 volume-relative file name, portability
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:

doc/flush.n

@@ -43,3 +43,7 @@ puts "Hello there, $name!"
 file(n), open(n), socket(n), Tcl_StandardChannels(3)
 .SH KEYWORDS
 blocking, buffer, channel, flush, nonblocking, output
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:

doc/foreach.n

@@ -102,3 +102,7 @@ for(n), while(n), break(n), continue(n)
 
 .SH KEYWORDS
 foreach, iteration, list, loop
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:

doc/global.n

@@ -56,3 +56,7 @@ proc accum {string} {
 namespace(n), upvar(n), variable(n)
 .SH KEYWORDS
 global, namespace, procedure, variable
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:

doc/history.n

@@ -100,3 +100,7 @@ the \fBevent\fR operation to retrieve some event,
 and the \fBadd\fR operation to add it to history and execute it.
 .SH KEYWORDS
 event, history, record
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:

doc/http.n

@@ -13,10 +13,10 @@
 .SH NAME
 http \- Client-side implementation of the HTTP/1.1 protocol
 .SH SYNOPSIS
-\fBpackage require http ?2.8?\fR
+\fBpackage require http\fI ?\fB2.8\fR?
 .\" See Also -useragent option documentation in body!
 .sp
-\fB::http::config ?\fI\-option value\fR ...?
+\fB::http::config\fR ?\fI\-option value\fR ...?
 .sp
 \fB::http::geturl \fIurl\fR ?\fI\-option value\fR ...?
 .sp
@@ -99,6 +99,15 @@ comma-separated list of mime type patterns that you are
 willing to receive.  For example,
 .QW "image/gif, image/jpeg, text/*" .
 .TP
+\fB\-cookiejar\fR \fIcommand\fR
+.VS TIP406
+The cookie store for the package to use to manage HTTP cookies.
+\fIcommand\fR is a command prefix list; if the empty list (the
+default value) is used, no cookies will be sent by requests or stored
+from responses. The command indicated by \fIcommand\fR, if supplied,
+must obey the \fBCOOKIE JAR PROTOCOL\fR described below.
+.VE TIP406
+.TP
 \fB\-pipeline\fR \fIboolean\fR
 .
 Specifies whether HTTP/1.1 transactions on a persistent socket will be
@@ -770,6 +779,108 @@ Subsequent GET and HEAD requests in a failed pipeline will also be retried.
 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.
+.VS TIP406
+.SH "COOKIE JAR PROTOCOL"
+.PP
+Cookies are short key-value pairs used to implement sessions within the
+otherwise-stateless HTTP protocol. (See RFC 6265 for details; Tcl does not
+implement the Cookie2 protocol as that is rarely seen in the wild.)
+.PP
+Cookie storage managment commands \(em
+.QW "cookie jars"
+\(em must support these subcommands which form the HTTP cookie storage
+management protocol. Note that \fIcookieJar\fR below does not have to be a
+command name; it is properly a command prefix (a Tcl list of words that will
+be expanded in place) and admits many possible implementations.
+.PP
+Though not formally part of the protocol, it is expected that particular
+values of \fIcookieJar\fR will correspond to sessions; it is up to the caller
+of \fB::http::config\fR to decide what session applies and to manage the
+deletion of said sessions when they are no longer desired (which should be
+when they not configured as the current cookie jar).
+.TP
+\fIcookieJar \fBgetCookies \fIprotocol host requestPath\fR
+.
+This command asks the cookie jar what cookies should be supplied for a
+particular request. It should take the \fIprotocol\fR (typically \fBhttp\fR or
+\fBhttps\fR), \fIhost\fR name and \fIrequestPath\fR (parsed from the \fIurl\fR
+argument to \fB::http::geturl\fR) and return a list of cookie keys and values
+that describe the cookies to supply to the remote host. The list must have an
+even number of elements.
+.RS
+.PP
+There should only ever be at most one cookie with a particular key for any
+request (typically the one with the most specific \fIhost\fR/domain match and
+most specific \fIrequestPath\fR/path match), but there may be many cookies
+with different names in any request.
+.RE
+.TP
+\fIcookieJar \fBstoreCookie \fIcookieDictionary\fR
+.
+This command asks the cookie jar to store a particular cookie that was
+returned by a request; the result of this command is ignored. The cookie
+(which will have been parsed by the http package) is described by a
+dictionary, \fIcookieDictionary\fR, that may have the following keys:
+.RS
+.TP
+\fBdomain\fR
+.
+This is always present. Its value describes the domain hostname \fIor
+prefix\fR that the cookie should be returned for.  The checking of the domain
+against the origin (below) should be careful since sites that issue cookies
+should only do so for domains related to themselves. Cookies that do not obey
+a relevant origin matching rule should be ignored.
+.TP
+\fBexpires\fR
+.
+This is optional. If present, the cookie is intended to be a persistent cookie
+and the value of the option is the Tcl timestamp (in seconds from the same
+base as \fBclock seconds\fR) of when the cookie expires (which may be in the
+past, which should result in the cookie being deleted immediately). If absent,
+the cookie is intended to be a session cookie that should be not persisted
+beyond the lifetime of the cookie jar.
+.TP
+\fBhostonly\fR
+.
+This is always present. Its value is a boolean that describes whether the
+cookie is a single host cookie (true) or a domain-level cookie (false).
+.TP
+\fBhttponly\fR
+.
+This is always present. Its value is a boolean that is true when the site
+wishes the cookie to only ever be used with HTTP (or HTTPS) traffic.
+.TP
+\fBkey\fR
+.
+This is always present. Its value is the \fIkey\fR of the cookie, which is
+part of the information that must be return when sending this cookie back in a
+future request.
+.TP
+\fBorigin\fR
+.
+This is always present. Its value describes where the http package believes it
+received the cookie from, which may be useful for checking whether the
+cookie's domain is valid.
+.TP
+\fBpath\fR
+.
+This is always present. Its value describes the path prefix of requests to the
+cookie domain where the cookie should be returned.
+.TP
+\fBsecure\fR
+.
+This is always present. Its value is a boolean that is true when the cookie
+should only used on requests sent over secure channels (typically HTTPS).
+.TP
+\fBvalue\fR
+.
+This is always present. Its value is the value of the cookie, which is part of
+the information that must be return when sending this cookie back in a future
+request.
+.PP
+Other keys may always be ignored; they have no meaning in this protocol.
+.RE
+.VE TIP406
 .SH EXAMPLE
 .PP
 This example creates a procedure to copy a URL to a file while printing a

doc/idna.n

@@ -0,0 +1,88 @@
+'\"
+'\" Copyright (c) 2014-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 "idna" n 0.1 http "Tcl Bundled Packages"
+.so man.macros
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+tcl::idna \- Support for normalization of Internationalized Domain Names
+.SH SYNOPSIS
+.nf
+package require tcl::idna 1.0
+
+\fBtcl::idna decode\fR \fIhostname\fR
+\fBtcl::idna encode\fR \fIhostname\fR
+\fBtcl::idna puny decode\fR \fIstring\fR ?\fIcase\fR?
+\fBtcl::idna puny encode\fR \fIstring\fR ?\fIcase\fR?
+\fBtcl::idna version\fR
+.fi
+.SH DESCRIPTION
+This package provides an implementation of the punycode scheme used in
+Internationalised Domain Names, and some access commands. (See RFC 3492 for a
+description of punycode.)
+.TP
+\fBtcl::idna decode\fR \fIhostname\fR
+.
+This command takes the name of a host that potentially contains
+punycode-encoded character sequences, \fIhostname\fR, and returns the hostname
+as might be displayed to the user. Note that there are often UNICODE
+characters that have extremely similar glyphs, so care should be taken with
+displaying hostnames to users.
+.TP
+\fBtcl::idna encode\fR \fIhostname\fR
+.
+This command takes the name of a host as might be displayed to the user,
+\fIhostname\fR, and returns the version of the hostname with characters not
+permitted in basic hostnames encoded with punycode.
+.TP
+\fBtcl::idna puny\fR \fIsubcommand ...\fR
+.
+This command provides direct access to the basic punycode encoder and
+decoder. It supports two \fIsubcommand\fRs:
+.RS
+.TP
+\fBtcl::idna puny decode\fR \fIstring\fR ?\fIcase\fR?
+.
+This command decodes the punycode-encoded string, \fIstring\fR, and returns
+the result. If \fIcase\fR is provided, it is a boolean to make the case be
+folded to upper case (if \fIcase\fR is true) or lower case (if \fIcase\fR is
+false) during the decoding process; if omitted, no case transformation is
+applied.
+.TP
+\fBtcl::idna puny encode\fR \fIstring\fR ?\fIcase\fR?
+.
+This command encodes the string, \fIstring\fR, and returns the
+punycode-encoded version of the string. If \fIcase\fR is provided, it is a
+boolean to make the case be folded to upper case (if \fIcase\fR is true) or
+lower case (if \fIcase\fR is false) during the encoding process; if omitted,
+no case transformation is applied.
+.RE
+.TP
+\fBtcl::idna version\fR
+.
+This returns the version of the \fBtcl::idna\fR package.
+.SH "EXAMPLE"
+.PP
+This is an example of how punycoding of a string works:
+.PP
+.CS
+package require tcl::idna
+
+puts [\fBtcl::idna puny encode\fR "abc\(->def"]
+#    prints: \fIabcdef-kn2c\fR
+puts [\fBtcl::idna puny decode\fR "abcdef-kn2c"]
+#    prints: \fIabc\(->def\fR
+.CE
+'\" TODO: show how it handles a real domain name
+.SH "SEE ALSO"
+http(n), cookiejar(n)
+.SH KEYWORDS
+internet, www
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:

doc/interp.n

@@ -236,7 +236,7 @@ attempts are silently ignored. This is needed to maintain the
 consistency of the underlying interpreter's state.
 .RE
 .TP
-\fBinterp\fR \fBdelete \fR?\fIpath ...?\fR
+\fBinterp\fR \fBdelete \fR?\fIpath ...\fR?
 .
 Deletes zero or more interpreters given by the optional \fIpath\fR
 arguments, and for each interpreter, it also deletes its slaves. The

doc/join.n

@@ -42,3 +42,7 @@ set data {1 {2 3} 4 {5 {6 7} 8}}
 list(n), lappend(n), split(n)
 .SH KEYWORDS
 element, join, list, separator
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:

doc/lindex.n

@@ -13,7 +13,7 @@
 .SH NAME
 lindex \- Retrieve an element from a list
 .SH SYNOPSIS
-\fBlindex \fIlist ?index ...?\fR
+\fBlindex \fIlist\fR ?\fIindex ...\fR?
 .BE
 .SH DESCRIPTION
 .PP

doc/llength.n

@@ -53,3 +53,7 @@ list(n), lappend(n), lindex(n), linsert(n), lsearch(n),
 lset(n), lsort(n), lrange(n), lreplace(n)
 .SH KEYWORDS
 element, list, length
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:

doc/lrange.n

@@ -76,3 +76,7 @@ lset(n), lreplace(n), lsort(n),
 string(n)
 .SH KEYWORDS
 element, list, range, sublist
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:

doc/lrepeat.n

@@ -33,6 +33,9 @@ is identical to \fBlist element ...\fR.
 .CE
 .SH "SEE ALSO"
 list(n), lappend(n), linsert(n), llength(n), lset(n)
-
 .SH KEYWORDS
 element, index, list
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:

doc/lreplace.n

@@ -17,7 +17,7 @@ lreplace \- Replace elements in a list with new elements
 .BE
 .SH DESCRIPTION
 .PP
-\fBlreplace\fR returns a new list formed by replacing one or more elements of
+\fBlreplace\fR returns a new list formed by replacing zero or more elements of
 \fIlist\fR with the \fIelement\fR arguments.
 \fIfirst\fR and \fIlast\fR are index values specifying the first and
 last elements of the range to replace.
@@ -27,36 +27,26 @@ supporting simple index arithmetic and indices relative to the
 end of the list.
 0 refers to the first element of the
 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.
+If either \fIfirst\fR or \fIlast\fR is less than zero, it is considered
+to refer to before the first element of the list. This allows \fBlreplace\fR
+to prepend elements to \fIlist\fR.
 .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.
+If either \fIfirst\fR or \fIlast\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 \fBlreplace\fR to
+append elements to \fIlist\fR.
 .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
+will be inserted into the list before the element 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
+The \fIelement\fR arguments specify zero or more new elements to
 be added to the list in place of those that were deleted.
 Each \fIelement\fR argument will become a separate element of
 the list.  If no \fIelement\fR arguments are specified, then the elements
-between \fIfirst\fR and \fIlast\fR are simply deleted.  If \fIlist\fR
-is empty, any \fIelement\fR arguments are added to the end of the list.
+between \fIfirst\fR and \fIlast\fR are simply deleted.
 .SH EXAMPLES
 .PP
 Replacing an element of a list with another:
@@ -93,7 +83,7 @@ proc lremove {listVariable value} {
 .CE
 .PP
 .VS TIP505
-Adding elements to the end of the list; note that \fBend+2\fR will initially
+Appending elements to 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

doc/packagens.n

@@ -48,3 +48,7 @@ At least one \fB\-load\fR or \fB\-source\fR parameter must be given.
 package(n)
 .SH KEYWORDS
 auto-load, index, package, version
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:

doc/pid.n

@@ -43,6 +43,9 @@ close $pipeline
 
 .SH "SEE ALSO"
 exec(n), open(n)
-
 .SH KEYWORDS
 file, pipeline, process identifier
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:

doc/platform.n

@@ -12,7 +12,7 @@
 platform \- System identification support code and utilities
 .SH SYNOPSIS
 .nf
-\fBpackage require platform ?1.0.10?\fR
+\fBpackage require platform\fR ?\fB1.0.10\fR?
 .sp
 \fBplatform::generic\fR
 \fBplatform::identify\fR

doc/platform_shell.n

@@ -12,7 +12,7 @@
 platform::shell \- System identification support code and utilities
 .SH SYNOPSIS
 .nf
-\fBpackage require platform::shell ?1.1.4?\fR
+\fBpackage require platform::shell\fR ?\fB1.1.4\fR?
 .sp
 \fBplatform::shell::generic \fIshell\fR
 \fBplatform::shell::identify \fIshell\fR
@@ -55,3 +55,7 @@ This command returns the contents of \fBtcl_platform(platform)\fR for
 the specified Tcl shell.
 .SH KEYWORDS
 operating system, cpu architecture, platform, architecture
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:

doc/prefix.n

@@ -12,9 +12,9 @@
 tcl::prefix \- facilities for prefix matching
 .SH SYNOPSIS
 .nf
-\fB::tcl::prefix all\fR \fItable\fR \fIstring\fR
-\fB::tcl::prefix longest\fR \fItable\fR \fIstring\fR
-\fB::tcl::prefix match\fR \fI?option ...?\fR \fItable\fR \fIstring\fR
+\fB::tcl::prefix all\fR \fItable string\fR
+\fB::tcl::prefix longest\fR \fItable string\fR
+\fB::tcl::prefix match\fR ?\fIoption ...\fR? \fItable string\fR
 .fi
 .BE
 .SH DESCRIPTION
@@ -22,17 +22,17 @@ tcl::prefix \- facilities for prefix matching
 This document describes commands looking up a prefix in a list of strings.
 The following commands are supported:
 .TP
-\fB::tcl::prefix all\fR \fItable\fR \fIstring\fR
+\fB::tcl::prefix all\fR \fItable string\fR
 .
 Returns a list of all elements in \fItable\fR that begin with the prefix
 \fIstring\fR.
 .TP
-\fB::tcl::prefix longest\fR \fItable\fR \fIstring\fR
+\fB::tcl::prefix longest\fR \fItable string\fR
 .
 Returns the longest common prefix of all elements in \fItable\fR that
 begin with the prefix \fIstring\fR.
 .TP
-\fB::tcl::prefix match\fR ?\fIoptions\fR? \fItable\fR \fIstring\fR
+\fB::tcl::prefix match\fR ?\fIoptions\fR? \fItable string\fR
 .
 If \fIstring\fR equals one element in \fItable\fR or is a prefix to exactly
 one element, the matched element is returned. If not, the result depends

doc/process.n

@@ -16,11 +16,31 @@ tcl::process \- Subprocess management
 .SH DESCRIPTION
 .PP
 This command provides a way to manage subprocesses created by the \fBopen\fR
-and \fBexec\fR commands. The legal \fIoptions\fR (which may be abbreviated) are:
+and \fBexec\fR commands, as identified by the process identifiers (PIDs) of
+those subprocesses. The legal \fIoptions\fR (which may be abbreviated) are:
+.TP
+\fB::tcl::process autopurge\fR ?\fIflag\fR?
+.
+Automatic purge facility. If \fIflag\fR is specified as a boolean value then
+it activates or deactivate autopurge. In all cases it returns the current
+status as a boolean value. When autopurge is active,
+\fBTcl_ReapDetachedProcs\fR is called each time the \fBexec\fR command is
+executed or a pipe channel created by \fBopen\fR is closed. When autopurge is
+inactive, \fB::tcl::process\fR purge must be called explicitly. By default
+autopurge is active.
 .TP
 \fB::tcl::process list\fR
 .
-Returns the list of subprocess PIDs.
+Returns the list of subprocess PIDs. This includes all currently executing
+subprocesses and all terminated subprocesses that have not yet had their
+corresponding process table entries purged.
+.TP
+\fB::tcl::process purge\fR ?\fIpids\fR?
+.
+Cleans up all data associated with terminated subprocesses. If \fIpids\fR is
+specified as a list of PIDs then the command only cleanup data for the matching
+subprocesses if they exist, and raises an error otherwise. If a process listed is
+still active, this command does nothing to that process.
 .TP
 \fB::tcl::process status\fR ?\fIswitches\fR? ?\fIpids\fR?
 .
@@ -29,62 +49,48 @@ Returns a dictionary mapping subprocess PIDs to their respective status. If
 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:
-.QW "{code ?\fImsg errorCode\fR?}" ,
+.QW "\fB{\fIcode\fR ?\fImsg errorCode\fR?\fB}\fR" ,
 where:
 .RS
 .TP
-\fBcode\fR\0
+\fIcode\fR\0
 .
-is a standard Tcl return code,
+is a standard Tcl return code, i.e., \fB0\fR for TCL_OK and \fB1\fR
+for TCL_ERROR,
 .TP
-\fBmsg\fR\0
+\fImsg\fR\0
 .
 is the human-readable error message,
 .TP
-\fBerrorCode\fR\0
+\fIerrorCode\fR\0
 .
 uses the same format as the \fBerrorCode\fR global variable
-.RE
+.PP
 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
+terminated processes (i.e. those where the \fIcode\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).
-.RS
 .PP
 Additionally, \fB::tcl::process status\fR accepts the following switches:
 .TP
 \fB\-wait\fR\0
 .
 By default the command returns immediately (the underlying \fBTcl_WaitPid\fR is
-called with the \fBWNOHANG\fR flag set) unless this switch is set. If \fBpids\fR
+called with the \fBWNOHANG\fR flag set) unless this switch is set. If \fIpids\fR
 is specified as a list of PIDs then the command waits until the status of the
-matching subprocesses are available. If \fBpids\fR is not specified then it
-waits for all known subprocesses.
+matching subprocesses are available. If \fIpids\fR was not specified, this
+command will wait for all known subprocesses.
 .TP
 \fB\-\|\-\fR
 .
 Marks the end of switches.  The argument following this one will
 be treated as the first \fIarg\fR even if it starts with a \fB\-\fR.
 .RE
-.TP
-\fB::tcl::process purge ?\fIpids\fR?
-.
-Cleans up all data associated with terminated subprocesses. If \fBpids\fR is
-specified as a list of PIDs then the command only cleanup data for the matching
-subprocesses if they exist, and raises an error otherwise. If the process is
-still active then it does nothing.
-.TP
-\fB::tcl::process autopurge ?\fIflag\fR?
-.
-Automatic purge facility. If \fBflag\fR is specified as a boolean value then it
-activates or deactivate autopurge. In all cases it returns the current status as
-a boolean value. When autopurge is active, \fBTcl_ReapDetachedProcs\fR is called
-each time the exec command is executed or a pipe channel created by open is
-closed. When autopurge is inactive, \fB::tcl::process\fR purge must be called
-explicitly. By default autopurge is active.
-.RE
 .SH "EXAMPLES"
 .PP
+These show the use of \fB::tcl::process\fR. Some of the results from
+\fB::tcl::process status\fR are split over multiple lines for readability.
+.PP
 .CS
 \fB::tcl::process autopurge\fR
      \fI\(-> true\fR
@@ -102,7 +108,12 @@ set pid2 [pid $chan]
      \fI\(-> 123 456 789 1011\fR
 
 \fB::tcl::process status\fR
-     \fI\(-> 123 0 456 {1 "child killed: write on pipe with no readers" {CHILDKILLED 456 SIGPIPE "write on pipe with no readers"}} 789 {1 "child suspended: background tty read" {CHILDSUSP 789 SIGTTIN "background tty read"}} 1011 {}\fR
+     \fI\(-> 123 0
+       456 {1 "child killed: write on pipe with no readers" {
+         CHILDKILLED 456 SIGPIPE "write on pipe with no readers"}}
+       789 {1 "child suspended: background tty read" {
+         CHILDSUSP 789 SIGTTIN "background tty read"}}
+       1011 {}\fR
 
 \fB::tcl::process status\fR 123
      \fI\(-> 123 0\fR
@@ -111,10 +122,17 @@ set pid2 [pid $chan]
      \fI\(-> 1011 {}\fR
 
 \fB::tcl::process status\fR -wait
-     \fI\(-> 123 0 456 {1 "child killed: write on pipe with no readers" {CHILDKILLED 456 SIGPIPE "write on pipe with no readers"}} 789 {1 "child suspended: background tty read" {CHILDSUSP 789 SIGTTIN "background tty read"}} 1011 {1 "child process exited abnormally" {CHILDSTATUS 1011 -1}}\fR
+     \fI\(-> 123 0
+       456 {1 "child killed: write on pipe with no readers" {
+         CHILDKILLED 456 SIGPIPE "write on pipe with no readers"}}
+       789 {1 "child suspended: background tty read" {
+         CHILDSUSP 789 SIGTTIN "background tty read"}}
+       1011 {1 "child process exited abnormally" {
+         CHILDSTATUS 1011 -1}}\fR
 
 \fB::tcl::process status\fR 1011
-     \fI\(-> 1011 {1 "child process exited abnormally" {CHILDSTATUS 1011 -1}}\fR
+     \fI\(-> 1011 {1 "child process exited abnormally" {
+         CHILDSTATUS 1011 -1}}\fR
 
 \fB::tcl::process purge\fR
 exec command1 1 2 3 &
@@ -123,7 +141,8 @@ exec command1 1 2 3 &
      \fI\(-> 1213\fR
 .CE
 .SH "SEE ALSO"
-exec(n), open(n), Tcl_DetachPids(3), Tcl_WaitPid(3), Tcl_ReapDetachedProcs(3)
+exec(n), open(n), pid(n),
+Tcl_DetachPids(3), Tcl_WaitPid(3), Tcl_ReapDetachedProcs(3)
 .SH "KEYWORDS"
 background, child, detach, process, wait
 '\" Local Variables:

doc/puts.n

@@ -96,3 +96,7 @@ close $chan
 file(n), fileevent(n), Tcl_StandardChannels(3)
 .SH KEYWORDS
 channel, newline, output, write
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:

doc/pwd.n

@@ -37,3 +37,7 @@ cd $savedDir
 file(n), cd(n), glob(n), filename(n)
 .SH KEYWORDS
 working directory
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:

doc/rename.n

@@ -43,3 +43,7 @@ proc ::source args {
 namespace(n), proc(n)
 .SH KEYWORDS
 command, delete, namespace, rename
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:

doc/set.n

@@ -73,3 +73,7 @@ practice instead of doing double-dereferencing):
 expr(n), global(n), namespace(n), proc(n), trace(n), unset(n), upvar(n), variable(n)
 .SH KEYWORDS
 read, write, variable
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:

doc/source.n

@@ -69,3 +69,7 @@ foreach scriptFile {foo.tcl bar.tcl} {
 file(n), cd(n), encoding(n), info(n)
 .SH KEYWORDS
 file, script
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:

doc/string.n

@@ -12,7 +12,7 @@
 .SH NAME
 string \- Manipulate strings
 .SH SYNOPSIS
-\fBstring \fIoption arg \fR?\fIarg ...?\fR
+\fBstring \fIoption arg \fR?\fIarg ...\fR?
 .BE
 .SH DESCRIPTION
 .PP
@@ -20,7 +20,7 @@ Performs one of several string operations, depending on \fIoption\fR.
 The legal \fIoption\fRs (which may be abbreviated) are:
 .TP
 \fBstring cat\fR ?\fIstring1\fR? ?\fIstring2...\fR?
-.VS 8.6.2
+.
 Concatenate the given \fIstring\fRs just like placing them directly
 next to each other and return the resulting compound string.  If no
 \fIstring\fRs are present, the result is an empty string.
@@ -32,7 +32,6 @@ of a concatenation without resorting to \fBreturn\fR \fB\-level 0\fR,
 and is more efficient than building a list of arguments and using
 \fBjoin\fR with an empty join string.
 .RE
-.VE
 .TP
 \fBstring compare\fR ?\fB\-nocase\fR? ?\fB\-length\fI length\fR? \fIstring1 string2\fR
 .
@@ -111,17 +110,24 @@ Any character with a value less than \eu0080 (those that are in the
 Any of the forms allowed to \fBTcl_GetBoolean\fR.
 .IP \fBcontrol\fR 12
 Any Unicode control character.
+.IP \fBdict\fR 12
+.VS TIP501
+Any proper dict structure, with optional surrounding whitespace. In
+case of improper dict structure, 0 is returned and the \fIvarname\fR
+will contain the index of the
+.QW element
+where the dict parsing fails, or \-1 if this cannot be determined.
+.VE TIP501
 .IP \fBdigit\fR 12
 Any Unicode digit character.  Note that this includes characters
 outside of the [0\-9] range.
 .IP \fBdouble\fR 12
 Any of the forms allowed to \fBTcl_GetDoubleFromObj\fR.
 .IP \fBentier\fR 12
-.VS 8.6
+.
 Any of the valid string formats for an integer value of arbitrary size
 in Tcl, with optional surrounding whitespace. The formats accepted are
 exactly those accepted by the C routine \fBTcl_GetBignumFromObj\fR.
-.VE
 .IP \fBfalse\fR 12
 Any of the forms allowed to \fBTcl_GetBoolean\fR where the value is
 false.

doc/tcltest.n

@@ -8,7 +8,7 @@
 '\" See the file "license.terms" for information on usage and redistribution
 '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 '\"
-.TH "tcltest" n 2.3 tcltest "Tcl Bundled Packages"
+.TH "tcltest" n 2.5 tcltest "Tcl Bundled Packages"
 .so man.macros
 .BS
 '\" Note:  do not modify the .SH NAME line immediately below!
@@ -16,7 +16,7 @@
 tcltest \- Test harness support code and utilities
 .SH SYNOPSIS
 .nf
-\fBpackage require tcltest\fR ?\fB2.3\fR?
+\fBpackage require tcltest\fR ?\fB2.5\fR?
 
 \fBtcltest::test \fIname description\fR ?\fI\-option value ...\fR?
 \fBtcltest::test \fIname description\fR ?\fIconstraints\fR? \fIbody result\fR
@@ -454,6 +454,7 @@ The valid options for \fBtest\fR are summarized:
         ?\fB\-output \fIexpectedOutput\fR?
         ?\fB\-errorOutput \fIexpectedError\fR?
         ?\fB\-returnCodes \fIcodeList\fR?
+        ?\fB\-errorCode \fIexpectedErrorCode\fR?
         ?\fB\-match \fImode\fR?
 .CE
 .PP
@@ -577,6 +578,15 @@ return codes known to \fBreturn\fR, in both numeric and symbolic
 form, including extended return codes, are acceptable elements in
 the \fIexpectedCodeList\fR.  Default value is
 .QW "\fBok return\fR" .
+.TP
+\fB\-errorCode \fIexpectedErrorCode\fR
+.
+The optional \fB\-errorCode\fR attribute supplies \fIexpectedErrorCode\fR,
+a glob pattern that should match the error code reported from evaluation of the
+\fB\-body\fR script.  If evaluation of the \fB\-body\fR script returns
+a code not matching \fIexpectedErrorCode\fR, the test fails.  Default value is
+.QW "\fB*\fR" .
+If \fB\-returnCodes\fR does not include \fBerror\fR it is set to \fBerror\fR.
 .PP
 To pass, a test must successfully evaluate its \fB\-setup\fR, \fB\-body\fR,
 and \fB\-cleanup\fR scripts.  The return code of the \fB\-body\fR script and

doc/tell.n

@@ -46,3 +46,7 @@ if {[read $chan 6] eq "foobar"} {
 file(n), open(n), close(n), gets(n), seek(n), Tcl_StandardChannels(3)
 .SH KEYWORDS
 access position, channel, seeking
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:

doc/trace.n

@@ -20,7 +20,8 @@ trace \- Monitor variable accesses, command usages and command executions
 This command causes Tcl commands to be executed whenever certain operations are
 invoked.  The legal \fIoption\fRs (which may be abbreviated) are:
 .TP
-\fBtrace add \fItype name ops ?args?\fR
+\fBtrace add \fItype name ops\fR ?\fIargs\fR?
+.
 Where \fItype\fR is \fBcommand\fR, \fBexecution\fR, or \fBvariable\fR.
 .RS
 .TP

doc/unknown.n

@@ -89,3 +89,7 @@ proc \fBunknown\fR args {
 info(n), proc(n), interp(n), library(n), namespace(n)
 .SH KEYWORDS
 error, non-existent command, unknown
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:

doc/update.n

@@ -63,3 +63,7 @@ while {!$done} {
 after(n), interp(n)
 .SH KEYWORDS
 asynchronous I/O, event, flush, handler, idle, update
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:

doc/while.n

@@ -63,3 +63,7 @@ set lineCount 0
 break(n), continue(n), for(n), foreach(n)
 .SH KEYWORDS
 boolean, loop, test, while
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:

doc/zipfs.3

@@ -10,61 +10,109 @@
 .so man.macros
 .BS
 .SH NAME
-TclZipfs_AppHook, Tclzipfs_Mount, Tclzipfs_Unmount,  \- handle ZIP files as VFS
+TclZipfs_AppHook, Tclzipfs_Mount, TclZipfs_MountBuffer, Tclzipfs_Unmount \- handle ZIP files as Tcl virtual filesystems
 .SH SYNOPSIS
 .nf
+int
+\fBTclZipfs_AppHook(\fIargcPtr, argvPtr\fR)
 .sp
 int
-\fBTclZipfs_AppHook(\fIint *argc, char ***argv\fR)
+\fBTclzipfs_Mount\fR(\fIinterp, mountpoint, zipname, password\fR)
 .sp
 int
-\fBTclzipfs_Mount\fR(\fIinterp, mntpt, zipname, passwd\fR)
+\fBTclZipfs_MountBuffer\fR(\fIinterp, mountpoint, data, dataLen, copy\fR)
 .sp
 int
-\fBTclzipfs_Unmount\fR(\fIinterp, zipname\fR)
+\fBTclzipfs_Unmount\fR(\fIinterp, mountpoint\fR)
+.fi
 .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
+.AS Tcl_Interp *mountpoint in
+.AP "int" *argcPtr in
+Pointer to a variable holding the number of command line arguments from
+\fBmain\fR().
+.AP "char" ***argvPtr in
+Pointer to an array of strings containing the command line arguments to
+\fBmain\fR().
 .AP Tcl_Interp *interp in
-Interpreter in which the zip file system is mounted.  The interpreter's result is
+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.
+Name of a ZIP file. Must not be NULL when either mounting or unmounting a ZIP.
+.AP "const char" *mountpoint in
+Name of a mount point, which must be a legal Tcl file or directory name. May
+be NULL to query current mount points.
+.AP "const char" *password in
+An (optional) password. Use NULL if no password is wanted to read the file.
+.AP "unsigned char" *data in
+A data buffer to mount. The data buffer must hold the contents of a ZIP
+archive, and must not be NULL.
+.AP size_t dataLen in
+The number of bytes in the supplied data buffer argument, \fIdata\fR.
+.AP int copy in
+If non-zero, the ZIP archive in the data buffer will be internally copied
+before mounting, allowing the data buffer to be disposed once
+\fBTclZipfs_MountBuffer\fR returns. If zero, the caller guarantees that the
+buffer will be valid to read from for the duration of the mount.
 .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.
+\fBTclZipfs_AppHook\fR is a utility function to perform standard application
+initialization procedures, taking into account available ZIP archives as
+follows:
+.IP [1]
+If the current application has a mountable ZIP archive, that archive is
+mounted under \fIZIPFS_VOLUME\fB/app\fR as a read-only Tcl virtual file
+system. \fIZIPFS_VOLUME\fR is usually \fB//zipfs:\fR on all platforms, but
+\fBzipfs:\fR may also be used on Windows (due to differences in the
+platform's filename parsing).
+.IP [2]
+If a file named \fBmain.tcl\fR is located in the root directory of that file
+system (i.e., at \fIZIPROOT\fB/app/main.tcl\fR after the ZIP archive is
+mounted as described above) it is treated as the startup script for the
+process.
+.IP [3]
+If the file \fIZIPROOT\fB/app/tcl_library/init.tcl\fR is present, the
+\fBtcl_library\fR global variable in the initial Tcl interpreter is set to
+\fIZIPROOT\fB/app/tcl_library\fR.
+.IP [4]
+If the directory \fBtcl_library\fR was not found in the main application
+mount, the system will then search for it as either a VFS attached to the
+application dynamic library, or as a zip archive named
+\fBlibtcl_\fImajor\fB_\fIminor\fB_\fIpatchlevel\fB.zip\fR either in the
+present working directory or in the standard Tcl install location. (For
+example, the Tcl 8.7.2 release would be searched for in a file
+\fBlibtcl_8_7_2.zip\fR.) That archive, if located, is also mounted read-only.
 .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.
+On Windows, \fBTclZipfs_AppHook\fR has a slightly different signature, since
+it uses WCHAR in stead of char. As a result, it requires your application to
+be compiled with the UNICODE preprocessor symbol defined (e.g., via the
+\fB-DUNICODE\fR compiler flag).
 .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.
+The result of \fBTclZipfs_AppHook\fR is a Tcl result code (e.g., \fBTCL_OK\fR
+when the function is successful). The function \fImay\fR modify the variables
+pointed to by \fIargcPtr\fR and \fIargvPtr\fR to remove arguments; the
+current implementation does not do so, but callers \fIshould not\fR assume
+that this will be true in the future.
 .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.
+\fBTclzipfs_Mount\fR mounts the ZIP archive \fIzipname\fR on the mount point
+given in \fImountpoint\fR using the optional ZIP password \fIpassword\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.  The result of this call is a standard Tcl result
+code.
 .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.
+\fBTclzipfs_MountBuffer\fR mounts the ZIP archive in the buffer pointed to by
+\fIdata\fR on the mount point given in \fImountpoint\fR. The ZIP archive is
+assumed to be not password protected.  Errors during that process are reported
+in the interpreter \fIinterp\fR. The \fIcopy\fR argument determines whether
+the buffer is internally copied before mounting or not. The result of this
+call is a standard Tcl result code.
+.PP
+\fBTclzipfs_Unmount\fR undoes the effect of \fBTclzipfs_Mount\fR, i.e., it
+unmounts the mounted ZIP file system that was mounted from \fIzipname\fR (at
+\fImountpoint\fR). Errors are reported in the interpreter \fIinterp\fR.  The
+result of this call is a standard Tcl result code.
+.SH "SEE ALSO"
+zipfs(n)
 .SH KEYWORDS
 compress, filesystem, zip

doc/zipfs.n

@@ -16,108 +16,238 @@ zipfs \- Mount and work with ZIP files within Tcl
 .nf
 \fBpackage require zipfs \fR?\fB1.0\fR?
 .sp
+\fBzipfs canonical\fR ?\fImntpnt\fR? \fIfilename\fR ?\fIZIPFS\fR?
 \fBzipfs exists\fR \fIfilename\fR
-\fBzipfs find\fR \fIdir\fR
+\fBzipfs find\fR \fIdirectoryName\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 list\fR ?(\fB\-glob\fR|\fB\-regexp\fR)? ?\fIpattern\fR?
+\fBzipfs lmkimg\fR \fIoutfile inlist\fR ?\fIpassword infile\fR?
+\fBzipfs lmkzip\fR \fIoutfile inlist\fR ?\fIpassword\fR?
+\fBzipfs mkimg\fR \fIoutfile indir\fR ?\fIstrip\fR? ?\fIpassword\fR? ?\fIinfile\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 mkzip\fR \fIoutfile indir\fR ?\fIstrip\fR? ?\fIpassword\fR?
+\fBzipfs mount\fR ?\fImountpoint\fR? ?\fIzipfile\fR? ?\fIpassword\fR?
 \fBzipfs root\fR
 \fBzipfs unmount\fR \fImountpoint\fR
 .fi
+'\" The following subcommand is *UNDOCUMENTED*
+'\" \fBzipfs mount_data\fR ?\fImountpoint\fR? ?\fIdata\fR?
 .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.
+The \fBzipfs\fR command (the sole public command provided by the built-in
+package with the same name) provides Tcl with the ability to mount the
+contents of a ZIP archive file as a virtual file system. ZIP archives support
+simple encryption, sufficient to prevent casual inspection of their contents
+but not able to prevent access by even a moderately determined attacker.
+.TP
+\fBzipfs canonical\fR ?\fImountpoint\fR? \fIfilename\fR ?\fIinZipfs\fR?
+.
+This takes the name of a file, \fIfilename\fR, and produces where it would be
+mapped into a zipfs mount as its result. If specified, \fImountpoint\fR says
+within which mount the mapping will be done; if omitted, the main root of the
+zipfs system is used. The \fIinZipfs\fR argument is a an optional boolean
+which controls whether to fully canonicalise the name; it defaults to true.
 .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
+\fBzipfs find\fR \fIdirectoryName\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.
+Recursively lists files including and below the directory \fIdirectoryName\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.
+Return information about the given \fIfile\fR in the mounted zipfs.  The
+information consists of:
 .RS
+.IP (1)
+the name of the ZIP archive file that contains the file,
+.IP (2)
+the size of the file after decompressions,
+.IP (3)
+the compressed size of the file, and
+.IP (4)
+the offset of the compressed data in the ZIP archive file.
 .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.
+Note: querying the mount point gives the start of the zip data as the offset
+in (4), which can be used to truncate the zip information from an executable.
 .RE
 .TP
-\fBzipfs list\fR \fB?(-glob|-regexp)?\fR \fI?pattern?\fR
+\fBzipfs list\fR ?(\fB\-glob\fR|\fB\-regexp\fR)? ?\fIpattern\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
+Return a list of all files in the mounted zipfs, or just those matching
+\fIpattern\fR (optionally controlled by the option parameters).  The order of
+the names in the list is arbitrary.
 .TP
 \fBzipfs mount ?\fImountpoint\fR? ?\fIzipfile\fR? ?\fIpassword\fR?
 .
-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.
+The \fBzipfs mount\fR command mounts a ZIP archive file as a Tcl virtual
+filesystem at \fImountpoint\fR.  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.
+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.
+.PP
+\fBNB:\fR because the current working directory is a concept maintained by the
+operating system, using \fBcd\fR into a mounted archive will only work in the
+current process, and then not entirely consistently (e.g., if a shared library
+uses direct access to the OS rather than through Tcl's filesystem API, it will
+not see the current directory as being inside the mount and will not be able
+to access the files inside the mount).
 .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:/
+for the current platform. On Windows, this value is
+.QW \fBzipfs:/\fR .
+On Unix, this value is
+.QW \fB//zipfs:/\fR .
 .RE
 .TP
 \fBzipfs unmount \fImountpoint\fR
 .
 Unmounts a previously mounted ZIP archive mounted to \fImountpoint\fR.
+.SS "ZIP CREATION COMMANDS"
+This package also provides several commands to aid the creation of ZIP
+archives as Tcl applications.
+.TP
+\fBzipfs mkzip\fR \fIoutfile indir\fR ?\fIstrip\fR? ?\fIpassword\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.  When stripping, it is common to remove either
+the whole source directory name or the name of its parent directory.
+.RS
+.PP
+\fBCaution:\fR 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 mkimg\fR \fIoutfile indir\fR ?\fIstrip\fR? ?\fIpassword\fR? ?\fIinfile\fR?
+.
+Creates an image (potentially a new executable file) similar to \fBzipfs
+mkzip\fR; see that command for a description of most parameters to this
+command, as they behave identically here.
+.RS
+.PP
+If the \fIinfile\fR parameter is specified, this file is prepended in front of
+the ZIP archive, otherwise the file returned by \fBinfo nameofexecutable\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
+(see \fBzipfs mkkey\fR) is placed between the image and ZIP chunks of the
+output file and the contents of the ZIP chunk are protected with that
+password.
+.PP
+If there is a file, \fBmain.tcl\fR, in the root directory of the resulting
+archive and the image file that the archive is attached to is a \fBtclsh\fR
+(or \fBwish\fR) instance (true by default, but depends on your configuration),
+then the resulting image is an executable that will \fBsource\fR the script in
+that \fBmain.tcl\fR after mounting the ZIP archive, and will \fBexit\fR once
+that script has been executed.
+.PP
+\fBCaution:\fR highly experimental, not usable on Android, only partially
+tested on Linux and Windows.
+.RE
+.TP
+\fBzipfs mkkey\fR \fIpassword\fR
+.
+Given 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 lmkimg\fR \fIoutfile inlist\fR ?\fIpassword infile\fR?
+.
+This command is like \fBzipfs mkimg\fR, but instead of an input directory,
+\fIinlist\fR must be a Tcl list where the odd elements are the names of files
+to be copied into the archive in the image, and the even elements are their
+respective names within that archive.
+.TP
+\fBzipfs lmkzip\fR \fIoutfile inlist\fR ?\fIpassword\fR?
+.
+This command is like \fBzipfs mkzip\fR, but instead of an input directory,
+\fIinlist\fR must be a Tcl list where the odd elements are the names of files
+to be copied into the archive, and the even elements are their respective
+names within that archive.
+.SH "EXAMPLES"
+.PP
+Mounting an ZIP archive as an application directory and running code out of it
+before unmounting it again:
+.PP
+.CS
+set zip myApp.zip
+set base [file join [\fbzipfs root\fR] myApp]
+
+\fBzipfs mount\fR $base $zip
+# $base now has the contents of myApp.zip
+
+source [file join $base app.tcl]
+# use the contents, load libraries from it, etc...
+
+\fBzipfs unmount\fR $zip
+.CE
+.PP
+Creating a ZIP archive, given that a directory exists containing the content
+to put in the archive. Note that the source directory is given twice, in order
+to strip the exterior directory name from each filename in the archive.
+.PP
+.CS
+set sourceDirectory [file normalize myApp]
+set targetZip myApp.zip
+
+\fBzipfs mkzip\fR $targetZip $sourceDirectory $sourceDirectory
+.CE
+.PP
+Encryption can be applied to ZIP archives by providing a password when
+building the ZIP and when mounting it.
+.PP
+.CS
+set zip myApp.zip
+set sourceDir [file normalize myApp]
+set password "hunter2"
+set base [file join [\fbzipfs root\fR] myApp]
+
+# Create with password
+\fBzipfs mkzip\fR $targetZip $sourceDir $sourceDir $password
+
+# Mount with password
+\fBzipfs mount\fR $base $zip $password
+.CE
+.PP
+When creating an executable image with a password, the password is placed
+within the executable in a shrouded form so that the application can read
+files inside the embedded ZIP archive yet casual inspection cannot read it.
+.PP
+.CS
+set appDir [file normalize myApp]
+set img "myApp.bin"
+set password "hunter2"
+
+# Create some simple content to define a basic application
+file mkdir $appDir
+set f [open $appDir/main.tcl]
+puts $f {
+    puts "Hi. This is [info script]"
+}
+close $f
+
+# Create the executable
+\fBzipfs mkimg\fR $img $appDir $appDir $password
+
+# Launch the executable, printing its output to stdout
+exec $img >@stdout
+#    prints: \fIHi. This is //zipfs:/app/main.tcl\fR
+.CE
 .SH "SEE ALSO"
-tclsh(1), file(n), zlib(n)
+tclsh(1), file(n), zipfs(3), zlib(n)
 .SH "KEYWORDS"
 compress, filesystem, zip
 '\" Local Variables:

generic/tcl.decls

@@ -2332,27 +2332,38 @@ declare 631 {
 
 # TIP #430
 declare 632 {
-    int TclZipfs_Mount(
-    Tcl_Interp *interp,
-    const char *mntpt,
-    const char *zipname,
-    const char *passwd)
+    int TclZipfs_Mount(Tcl_Interp *interp, const char *mountPoint,
+	    const char *zipname, const char *passwd)
 }
 declare 633 {
-    int TclZipfs_Unmount(Tcl_Interp *interp, const char *zipname)
+    int TclZipfs_Unmount(Tcl_Interp *interp, const char *mountPoint)
 }
 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)
+    int TclZipfs_MountBuffer(Tcl_Interp *interp, const char *mountPoint,
+	    unsigned char *data, size_t datalen, int copy)
 }
 
+# TIP #445
+declare 636 {
+    void Tcl_FreeIntRep(Tcl_Obj *objPtr)
+}
+declare 637 {
+    char *Tcl_InitStringRep(Tcl_Obj *objPtr, const char *bytes,
+	    unsigned int numBytes)
+}
+declare 638 {
+    Tcl_ObjIntRep *Tcl_FetchIntRep(Tcl_Obj *objPtr, const Tcl_ObjType *typePtr)
+}
+declare 639 {
+    void Tcl_StoreIntRep(Tcl_Obj *objPtr, const Tcl_ObjType *typePtr,
+	    const Tcl_ObjIntRep *irPtr)
+}
+declare 640 {
+    int Tcl_HasStringRep(Tcl_Obj *objPtr)
+}
 # ----- BASELINE -- FOR -- 8.7.0 ----- #
 
 ##############################################################################

generic/tcl.h

@@ -224,7 +224,7 @@ extern "C" {
  * to be included in a shared library, then it should have the DLLEXPORT
  * storage class. If is being declared for use by a module that is going to
  * link against the shared library, then it should have the DLLIMPORT storage
- * class. If the symbol is beind declared for a static build or for use from a
+ * class. If the symbol is being declared for a static build or for use from a
  * stub library, then the storage class should be empty.
  *
  * The convention is that a macro called BUILD_xxxx, where xxxx is the name of
@@ -750,6 +750,29 @@ typedef struct Tcl_ObjType {
 				 * old type. Returns TCL_ERROR on failure. */
 } Tcl_ObjType;
 
+/*
+ * The following structure stores an internal representation (intrep) for
+ * a Tcl value. An intrep is associated with an Tcl_ObjType when both
+ * are stored in the same Tcl_Obj.  The routines of the Tcl_ObjType govern
+ * the handling of the intrep.
+ */
+
+typedef union Tcl_ObjIntRep {	/* The internal representation: */
+    long longValue;		/*   - an long integer value. */
+    double doubleValue;		/*   - a double-precision floating value. */
+    void *otherValuePtr;	/*   - another, type-specific value, */
+				/*     not used internally any more. */
+    Tcl_WideInt wideValue;	/*   - an integer value >= 64bits */
+    struct {			/*   - internal rep as two pointers. */
+	void *ptr1;		
+	void *ptr2;
+    } twoPtrValue;
+    struct {			/*   - internal rep as a pointer and a long, */
+	void *ptr;		/*     not used internally any more. */
+	unsigned long value;
+    } ptrAndLongRep;
+} Tcl_ObjIntRep;
+
 /*
  * One of the following structures exists for each object in the Tcl system.
  * An object stores a value as either a string, some internal representation,
@@ -775,27 +798,7 @@ typedef struct Tcl_Obj {
 				 * corresponds to the type of the object's
 				 * internal rep. NULL indicates the object has
 				 * no internal rep (has no type). */
-    union {			/* The internal representation: */
-	long longValue;		/*   - an long integer value. */
-	double doubleValue;	/*   - a double-precision floating value. */
-	void *otherValuePtr;	/*   - another, type-specific value, not used
-				 *     internally any more. */
-	Tcl_WideInt wideValue;	/*   - a long long value. */
-	struct {		/*   - internal rep as two pointers.
-				 *     Many uses in Tcl, including a bignum's
-				 *     tightly packed fields, where the alloc,
-				 *     used and signum flags are packed into
-				 *     ptr2 with everything else hung off
-				 *     ptr1. */
-	    void *ptr1;
-	    void *ptr2;
-	} twoPtrValue;
-	struct {		/*   - internal rep as a pointer and a long,
-				 *     not used internally any more. */
-	    void *ptr;
-	    unsigned long value;
-	} ptrAndLongRep;
-    } internalRep;
+    Tcl_ObjIntRep internalRep;	/* The internal representation: */
 } Tcl_Obj;
 
 /*
@@ -2333,6 +2336,13 @@ typedef int (Tcl_ArgvGenFuncProc)(ClientData clientData, Tcl_Interp *interp,
 #define TCL_TCPSERVER_REUSEADDR (1<<0)
 #define TCL_TCPSERVER_REUSEPORT (1<<1)
 
+/*
+ * Constants for special int-typed values, see TIP #494
+ */
+
+#define TCL_IO_FAILURE	(-1)
+#define TCL_AUTO_LENGTH	(-1)
+
 /*
  *----------------------------------------------------------------------------
  * Single public declaration for NRE.

generic/tclAssembly.c

@@ -32,6 +32,7 @@
 #include "tclInt.h"
 #include "tclCompile.h"
 #include "tclOOInt.h"
+#include <assert.h>
 
 /*
  * Structure that represents a range of instructions in the bytecode.
@@ -271,15 +272,12 @@ static void		CompileEmbeddedScript(AssemblyEnv*, Tcl_Token*,
 			    const TalInstDesc*);
 static int		DefineLabel(AssemblyEnv* envPtr, const char* label);
 static void		DeleteMirrorJumpTable(JumptableInfo* jtPtr);
-static void		DupAssembleCodeInternalRep(Tcl_Obj* src,
-			    Tcl_Obj* dest);
 static void		FillInJumpOffsets(AssemblyEnv*);
 static int		CreateMirrorJumpTable(AssemblyEnv* assemEnvPtr,
 			    Tcl_Obj* jumpTable);
 static int		FindLocalVar(AssemblyEnv* envPtr,
 			    Tcl_Token** tokenPtrPtr);
 static int		FinishAssembly(AssemblyEnv*);
-static void		FreeAssembleCodeInternalRep(Tcl_Obj *objPtr);
 static void		FreeAssemblyEnv(AssemblyEnv*);
 static int		GetBooleanOperand(AssemblyEnv*, Tcl_Token**, int*);
 static int		GetListIndexOperand(AssemblyEnv*, Tcl_Token**, int*);
@@ -318,6 +316,9 @@ static void		UnstackExpiredCatches(CompileEnv*, BasicBlock*, int,
  * Tcl_ObjType that describes bytecode emitted by the assembler.
  */
 
+static Tcl_FreeInternalRepProc	FreeAssembleCodeInternalRep;
+static Tcl_DupInternalRepProc	DupAssembleCodeInternalRep;
+
 static const Tcl_ObjType assembleCodeType = {
     "assemblecode",
     FreeAssembleCodeInternalRep, /* freeIntRepProc */
@@ -847,15 +848,15 @@ CompileAssembleObj(
     const char* source;		/* String representation of the source code */
     int sourceLen;		/* Length of the source code in bytes */
 
-
     /*
      * Get the expression ByteCode from the object. If it exists, make sure it
      * is valid in the current context.
      */
 
-    if (objPtr->typePtr == &assembleCodeType) {
+    ByteCodeGetIntRep(objPtr, &assembleCodeType, codePtr);
+
+    if (codePtr) {
 	namespacePtr = iPtr->varFramePtr->nsPtr;
-	codePtr = objPtr->internalRep.twoPtrValue.ptr1;
 	if (((Interp *) *codePtr->interpHandle == iPtr)
 		&& (codePtr->compileEpoch == iPtr->compileEpoch)
 		&& (codePtr->nsPtr == namespacePtr)
@@ -869,7 +870,7 @@ CompileAssembleObj(
 	 * Not valid, so free it and regenerate.
 	 */
 
-	TclFreeIntRep(objPtr);
+	Tcl_StoreIntRep(objPtr, &assembleCodeType, NULL);
     }
 
     /*
@@ -4332,7 +4333,10 @@ static void
 FreeAssembleCodeInternalRep(
     Tcl_Obj *objPtr)
 {
-    ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;
+    ByteCode *codePtr;
+
+    ByteCodeGetIntRep(objPtr, &assembleCodeType, codePtr);
+    assert(codePtr != NULL);
 
     TclReleaseByteCode(codePtr);
 }

generic/tclBasic.c

@@ -105,6 +105,7 @@ TCL_DECLARE_MUTEX(commandTypeLock);
  * Static functions in this file:
  */
 
+static Tcl_ObjCmdProc   BadEnsembleSubcommand;
 static char *		CallCommandTraces(Interp *iPtr, Command *cmdPtr,
 			    const char *oldName, const char *newName,
 			    int flags);
@@ -125,7 +126,6 @@ static Tcl_ObjCmdProc	ExprBinaryFunc;
 static Tcl_ObjCmdProc	ExprBoolFunc;
 static Tcl_ObjCmdProc	ExprCeilFunc;
 static Tcl_ObjCmdProc	ExprDoubleFunc;
-static Tcl_ObjCmdProc	ExprEntierFunc;
 static Tcl_ObjCmdProc	ExprFloorFunc;
 static Tcl_ObjCmdProc	ExprIntFunc;
 static Tcl_ObjCmdProc	ExprIsqrtFunc;
@@ -206,6 +206,24 @@ typedef struct {
  * expansion for itself rather than needing the generic layer to take care of
  * it for it. Defined in tclInt.h. */
 
+/*
+ * The following struct states that the command it talks about (a subcommand
+ * of one of Tcl's built-in ensembles) is unsafe and must be hidden when an
+ * interpreter is made safe. (TclHideUnsafeCommands accesses an array of these
+ * structs.) Alas, we can't sensibly just store the information directly in
+ * the commands.
+ */
+
+typedef struct {
+    const char *ensembleNsName; /* The ensemble's name within ::tcl. NULL for
+                                 * the end of the list of commands to hide. */
+    const char *commandName;    /* The name of the command within the
+                                 * ensemble. If this is NULL, we want to also
+                                 * make the overall command be hidden, an ugly
+                                 * hack because it is expected by security
+                                 * policies in the wild. */
+} UnsafeEnsembleInfo;
+
 /*
  * The built-in commands, and the functions that implement them:
  */
@@ -306,6 +324,68 @@ static const CmdInfo builtInCmds[] = {
     {NULL,		NULL,			NULL,			NULL,	0}
 };
 
+/*
+ * Information about which pieces of ensembles to hide when making an
+ * interpreter safe:
+ */
+
+static const UnsafeEnsembleInfo unsafeEnsembleCommands[] = {
+    /* [encoding] has two unsafe commands. Assumed by older security policies
+     * to be overall unsafe; it isn't but... */
+    {"encoding", NULL},
+    {"encoding", "dirs"},
+    {"encoding", "system"},
+    /* [file] has MANY unsafe commands! Assumed by older security policies to
+     * be overall unsafe; it isn't but... */
+    {"file", NULL},
+    {"file", "atime"},
+    {"file", "attributes"},
+    {"file", "copy"},
+    {"file", "delete"},
+    {"file", "dirname"},
+    {"file", "executable"},
+    {"file", "exists"},
+    {"file", "extension"},
+    {"file", "isdirectory"},
+    {"file", "isfile"},
+    {"file", "link"},
+    {"file", "lstat"},
+    {"file", "mtime"},
+    {"file", "mkdir"},
+    {"file", "nativename"},
+    {"file", "normalize"},
+    {"file", "owned"},
+    {"file", "readable"},
+    {"file", "readlink"},
+    {"file", "rename"},
+    {"file", "rootname"},
+    {"file", "size"},
+    {"file", "stat"},
+    {"file", "tail"},
+    {"file", "tempfile"},
+    {"file", "type"},
+    {"file", "volumes"},
+    {"file", "writable"},
+    /* [info] has two unsafe commands */
+    {"info", "cmdtype"},
+    {"info", "nameofexecutable"},
+    /* [tcl::process] has ONLY unsafe commands! */
+    {"process", "list"},
+    {"process", "status"},
+    {"process", "purge"},
+    {"process", "autopurge"},
+    /* [zipfs] has MANY unsafe commands! */
+    {"zipfs", "lmkimg"},
+    {"zipfs", "lmkzip"},
+    {"zipfs", "mkimg"},
+    {"zipfs", "mkkey"},
+    {"zipfs", "mkzip"},
+    {"zipfs", "mount"},
+    {"zipfs", "mount_data"},
+    {"zipfs", "unmount"},
+    {NULL, NULL}
+};
+
 /*
  * Math functions. All are safe.
  */
@@ -327,7 +407,7 @@ static const BuiltinFuncDef BuiltinFuncTable[] = {
     { "cos",	ExprUnaryFunc,	(ClientData) cos	},
     { "cosh",	ExprUnaryFunc,	(ClientData) cosh	},
     { "double",	ExprDoubleFunc,	NULL			},
-    { "entier",	ExprEntierFunc,	NULL			},
+    { "entier",	ExprIntFunc,	NULL			},
     { "exp",	ExprUnaryFunc,	(ClientData) exp	},
     { "floor",	ExprFloorFunc,	NULL			},
     { "fmod",	ExprBinaryFunc,	(ClientData) fmod	},
@@ -1135,6 +1215,7 @@ TclHideUnsafeCommands(
     Tcl_Interp *interp)		/* Hide commands in this interpreter. */
 {
     register const CmdInfo *cmdInfoPtr;
+    register const UnsafeEnsembleInfo *unsafePtr;
 
     if (interp == NULL) {
 	return TCL_ERROR;
@@ -1144,11 +1225,82 @@ TclHideUnsafeCommands(
 	    Tcl_HideCommand(interp, cmdInfoPtr->name, cmdInfoPtr->name);
 	}
     }
-    TclMakeEncodingCommandSafe(interp); /* Ugh! */
-    TclMakeFileCommandSafe(interp);     /* Ugh! */
+
+    for (unsafePtr = unsafeEnsembleCommands;
+            unsafePtr->ensembleNsName; unsafePtr++) {
+        if (unsafePtr->commandName) {
+            /*
+             * Hide an ensemble subcommand.
+             */
+
+            Tcl_Obj *cmdName = Tcl_ObjPrintf("::tcl::%s::%s",
+                    unsafePtr->ensembleNsName, unsafePtr->commandName);
+            Tcl_Obj *hideName = Tcl_ObjPrintf("tcl:%s:%s",
+                    unsafePtr->ensembleNsName, unsafePtr->commandName);
+
+            if (TclRenameCommand(interp, TclGetString(cmdName),
+                        "___tmp") != TCL_OK
+                    || Tcl_HideCommand(interp, "___tmp",
+                            TclGetString(hideName)) != TCL_OK) {
+                Tcl_Panic("problem making '%s %s' safe: %s",
+                        unsafePtr->ensembleNsName, unsafePtr->commandName,
+                        Tcl_GetString(Tcl_GetObjResult(interp)));
+            }
+            Tcl_CreateObjCommand(interp, TclGetString(cmdName),
+                    BadEnsembleSubcommand, (ClientData) unsafePtr, NULL);
+            TclDecrRefCount(cmdName);
+            TclDecrRefCount(hideName);
+        } else {
+            /*
+             * Hide an ensemble main command (for compatibility).
+             */
+
+            if (Tcl_HideCommand(interp, unsafePtr->ensembleNsName,
+                    unsafePtr->ensembleNsName) != TCL_OK) {
+                Tcl_Panic("problem making '%s' safe: %s",
+                        unsafePtr->ensembleNsName,
+                        Tcl_GetString(Tcl_GetObjResult(interp)));
+            }
+        }
+    }
+
     return TCL_OK;
 }
 
+/*
+ *----------------------------------------------------------------------
+ *
+ * BadEnsembleSubcommand --
+ *
+ *	Command used to act as a backstop implementation when subcommands of
+ *	ensembles are unsafe (the real implementations of the subcommands are
+ *	hidden). The clientData is description of what was hidden.
+ *
+ * Results:
+ *	A standard Tcl result (always a TCL_ERROR).
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+BadEnsembleSubcommand(
+    ClientData clientData,
+    Tcl_Interp *interp,
+    int objc,
+    Tcl_Obj *const objv[])
+{
+    const UnsafeEnsembleInfo *infoPtr = clientData;
+
+    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+            "not allowed to invoke subcommand %s of %s",
+            infoPtr->commandName, infoPtr->ensembleNsName));
+    Tcl_SetErrorCode(interp, "TCL", "SAFE", "SUBCOMMAND", NULL);
+    return TCL_ERROR;
+}
+
 /*
  *--------------------------------------------------------------
  *
@@ -3715,9 +3867,14 @@ OldMathFuncProc(
 	valuePtr = objv[j];
 	result = Tcl_GetDoubleFromObj(NULL, valuePtr, &d);
 #ifdef ACCEPT_NAN
-	if ((result != TCL_OK) && (valuePtr->typePtr == &tclDoubleType)) {
-	    d = valuePtr->internalRep.doubleValue;
-	    result = TCL_OK;
+	if (result != TCL_OK) {
+	    const Tcl_ObjIntRep *irPtr
+		    = Tcl_FetchIntRep(valuePtr, &tclDoubleType);
+
+	    if (irPtr) {
+		d = irPtr->doubleValue;
+		result = TCL_OK;
+	    }
 	}
 #endif
 	if (result != TCL_OK) {
@@ -5999,7 +6156,7 @@ TclArgumentGet(
      * up by the caller. It knows better than us.
      */
 
-    if ((obj->bytes == NULL) || TclListObjIsCanonical(obj)) {
+    if (!TclHasStringRep(obj) || TclListObjIsCanonical(obj)) {
 	return;
     }
 
@@ -6620,7 +6777,7 @@ Tcl_ExprLongObj(
 	resultPtr = Tcl_NewBignumObj(&big);
 	/* FALLTHROUGH */
     }
-    case TCL_NUMBER_WIDE:
+    case TCL_NUMBER_INT:
     case TCL_NUMBER_BIG:
 	result = TclGetLongFromObj(interp, resultPtr, ptr);
 	break;
@@ -7276,9 +7433,13 @@ ExprCeilFunc(
     }
     code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
 #ifdef ACCEPT_NAN
-    if ((code != TCL_OK) && (objv[1]->typePtr == &tclDoubleType)) {
-	Tcl_SetObjResult(interp, objv[1]);
-	return TCL_OK;
+    if (code != TCL_OK) {
+	const Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(objv[1], &tclDoubleType);
+
+	if (irPtr) {
+	    Tcl_SetObjResult(interp, objv[1]);
+	    return TCL_OK;
+	}
     }
 #endif
     if (code != TCL_OK) {
@@ -7312,9 +7473,13 @@ ExprFloorFunc(
     }
     code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
 #ifdef ACCEPT_NAN
-    if ((code != TCL_OK) && (objv[1]->typePtr == &tclDoubleType)) {
-	Tcl_SetObjResult(interp, objv[1]);
-	return TCL_OK;
+    if (code != TCL_OK) {
+	const Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(objv[1], &tclDoubleType);
+
+	if (irPtr) {
+	    Tcl_SetObjResult(interp, objv[1]);
+	    return TCL_OK;
+	}
     }
 #endif
     if (code != TCL_OK) {
@@ -7448,9 +7613,13 @@ ExprSqrtFunc(
     }
     code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
 #ifdef ACCEPT_NAN
-    if ((code != TCL_OK) && (objv[1]->typePtr == &tclDoubleType)) {
-	Tcl_SetObjResult(interp, objv[1]);
-	return TCL_OK;
+    if (code != TCL_OK) {
+	const Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(objv[1], &tclDoubleType);
+
+	if (irPtr) {
+	    Tcl_SetObjResult(interp, objv[1]);
+	    return TCL_OK;
+	}
     }
 #endif
     if (code != TCL_OK) {
@@ -7491,10 +7660,14 @@ ExprUnaryFunc(
     }
     code = Tcl_GetDoubleFromObj(interp, objv[1], &d);
 #ifdef ACCEPT_NAN
-    if ((code != TCL_OK) && (objv[1]->typePtr == &tclDoubleType)) {
-	d = objv[1]->internalRep.doubleValue;
-	Tcl_ResetResult(interp);
-	code = TCL_OK;
+    if (code != TCL_OK) {
+	const Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(objv[1], &tclDoubleType);
+
+	if (irPtr) {
+	    d = irPtr->doubleValue;
+	    Tcl_ResetResult(interp);
+	    code = TCL_OK;
+	}
     }
 #endif
     if (code != TCL_OK) {
@@ -7551,10 +7724,14 @@ ExprBinaryFunc(
     }
     code = Tcl_GetDoubleFromObj(interp, objv[1], &d1);
 #ifdef ACCEPT_NAN
-    if ((code != TCL_OK) && (objv[1]->typePtr == &tclDoubleType)) {
-	d1 = objv[1]->internalRep.doubleValue;
-	Tcl_ResetResult(interp);
-	code = TCL_OK;
+    if (code != TCL_OK) {
+	const Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(objv[1], &tclDoubleType);
+
+	if (irPtr) {
+	    d1 = irPtr->doubleValue;
+	    Tcl_ResetResult(interp);
+	    code = TCL_OK;
+	}
     }
 #endif
     if (code != TCL_OK) {
@@ -7562,10 +7739,14 @@ ExprBinaryFunc(
     }
     code = Tcl_GetDoubleFromObj(interp, objv[2], &d2);
 #ifdef ACCEPT_NAN
-    if ((code != TCL_OK) && (objv[2]->typePtr == &tclDoubleType)) {
-	d2 = objv[2]->internalRep.doubleValue;
-	Tcl_ResetResult(interp);
-	code = TCL_OK;
+    if (code != TCL_OK) {
+	const Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(objv[1], &tclDoubleType);
+
+	if (irPtr) {
+	    d2 = irPtr->doubleValue;
+	    Tcl_ResetResult(interp);
+	    code = TCL_OK;
+	}
     }
 #endif
     if (code != TCL_OK) {
@@ -7596,20 +7777,22 @@ ExprAbsFunc(
 	return TCL_ERROR;
     }
 
-    if (type == TCL_NUMBER_WIDE) {
+    if (type == TCL_NUMBER_INT) {
 	Tcl_WideInt l = *((const Tcl_WideInt *) ptr);
 
 	if (l > (Tcl_WideInt)0) {
 	    goto unChanged;
 	} else if (l == (Tcl_WideInt)0) {
-	    const char *string = objv[1]->bytes;
-	    if (string) {
-		while (*string != '0') {
-		    if (*string == '-') {
+	    if (TclHasStringRep(objv[1])) {
+		int numBytes;
+		const char *bytes = TclGetStringFromObj(objv[1], &numBytes);
+
+		while (numBytes) {
+		    if (*bytes == '-') {
 			Tcl_SetObjResult(interp, Tcl_NewLongObj(0));
 			return TCL_OK;
 		    }
-		    string++;
+		    bytes++; numBytes--;
 		}
 	    }
 	    goto unChanged;
@@ -7705,7 +7888,7 @@ ExprDoubleFunc(
     }
     if (Tcl_GetDoubleFromObj(interp, objv[1], &dResult) != TCL_OK) {
 #ifdef ACCEPT_NAN
-	if (objv[1]->typePtr == &tclDoubleType) {
+	if (Tcl_FetchIntRep(objv[1], &tclDoubleType)) {
 	    Tcl_SetObjResult(interp, objv[1]);
 	    return TCL_OK;
 	}
@@ -7717,7 +7900,7 @@ ExprDoubleFunc(
 }
 
 static int
-ExprEntierFunc(
+ExprIntFunc(
     ClientData clientData,	/* Ignored. */
     Tcl_Interp *interp,		/* The interpreter in which to execute the
 				 * function. */
@@ -7772,25 +7955,6 @@ ExprEntierFunc(
     return TCL_ERROR;
 }
 
-static int
-ExprIntFunc(
-    ClientData clientData,	/* Ignored. */
-    Tcl_Interp *interp,		/* The interpreter in which to execute the
-				 * function. */
-    int objc,			/* Actual parameter count. */
-    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);
-    TclGetWideBitsFromObj(NULL, objPtr, &wResult);
-    Tcl_SetObjResult(interp, Tcl_NewLongObj((long)wResult));
-    return TCL_OK;
-}
-
 static int
 ExprWideFunc(
     ClientData clientData,	/* Ignored. */
@@ -7801,7 +7965,7 @@ ExprWideFunc(
 {
     Tcl_WideInt wResult;
 
-    if (ExprEntierFunc(NULL, interp, objc, objv) != TCL_OK) {
+    if (ExprIntFunc(NULL, interp, objc, objv) != TCL_OK) {
 	return TCL_ERROR;
     }
     TclGetWideBitsFromObj(NULL, Tcl_GetObjResult(interp), &wResult);

generic/tclBinary.c

@@ -15,6 +15,7 @@
 #include "tommath.h"
 
 #include <math.h>
+#include <assert.h>
 
 /*
  * The following constants are used by GetFormatSpec to indicate various
@@ -56,9 +57,12 @@
 
 static void		DupByteArrayInternalRep(Tcl_Obj *srcPtr,
 			    Tcl_Obj *copyPtr);
+static void		DupProperByteArrayInternalRep(Tcl_Obj *srcPtr,
+			    Tcl_Obj *copyPtr);
 static int		FormatNumber(Tcl_Interp *interp, int type,
 			    Tcl_Obj *src, unsigned char **cursorPtr);
 static void		FreeByteArrayInternalRep(Tcl_Obj *objPtr);
+static void		FreeProperByteArrayInternalRep(Tcl_Obj *objPtr);
 static int		GetFormatSpec(const char **formatPtr, char *cmdPtr,
 			    int *countPtr, int *flagsPtr);
 static Tcl_Obj *	ScanNumber(unsigned char *buffer, int type,
@@ -246,8 +250,8 @@ static const EnsembleImplMap decodeMap[] = {
 
 static const Tcl_ObjType properByteArrayType = {
     "bytearray",
-    FreeByteArrayInternalRep,
-    DupByteArrayInternalRep,
+    FreeProperByteArrayInternalRep,
+    DupProperByteArrayInternalRep,
     UpdateStringOfByteArray,
     NULL
 };
@@ -268,9 +272,9 @@ const Tcl_ObjType tclByteArrayType = {
  */
 
 typedef struct ByteArray {
-    int used;			/* The number of bytes used in the byte
+    unsigned int used;		/* The number of bytes used in the byte
 				 * array. */
-    int allocated;		/* The amount of space actually allocated
+    unsigned int allocated;	/* The amount of space actually allocated
 				 * minus 1 byte. */
     unsigned char bytes[1];	/* The array of bytes. The actual size of this
 				 * field depends on the 'allocated' field
@@ -279,16 +283,15 @@ typedef struct ByteArray {
 
 #define BYTEARRAY_SIZE(len) \
 		((unsigned) (TclOffset(ByteArray, bytes) + (len)))
-#define GET_BYTEARRAY(objPtr) \
-		((ByteArray *) (objPtr)->internalRep.twoPtrValue.ptr1)
-#define SET_BYTEARRAY(objPtr, baPtr) \
-		(objPtr)->internalRep.twoPtrValue.ptr1 = (void *) (baPtr)
+#define GET_BYTEARRAY(irPtr) ((ByteArray *) (irPtr)->twoPtrValue.ptr1)
+#define SET_BYTEARRAY(irPtr, baPtr) \
+		(irPtr)->twoPtrValue.ptr1 = (void *) (baPtr)
 
 int
 TclIsPureByteArray(
     Tcl_Obj * objPtr)
 {
-    return (objPtr->typePtr == &properByteArrayType);
+    return (NULL != Tcl_FetchIntRep(objPtr, &properByteArrayType));
 }
 
 /*
@@ -403,11 +406,11 @@ Tcl_SetByteArrayObj(
 				   be >= 0. */
 {
     ByteArray *byteArrayPtr;
+    Tcl_ObjIntRep ir;
 
     if (Tcl_IsShared(objPtr)) {
 	Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayObj");
     }
-    TclFreeIntRep(objPtr);
     TclInvalidateStringRep(objPtr);
 
     if (length < 0) {
@@ -420,8 +423,9 @@ Tcl_SetByteArrayObj(
     if ((bytes != NULL) && (length > 0)) {
 	memcpy(byteArrayPtr->bytes, bytes, (size_t) length);
     }
-    objPtr->typePtr = &properByteArrayType;
-    SET_BYTEARRAY(objPtr, byteArrayPtr);
+    SET_BYTEARRAY(&ir, byteArrayPtr);
+
+    Tcl_StoreIntRep(objPtr, &properByteArrayType, &ir);
 }
 
 /*
@@ -449,17 +453,24 @@ Tcl_GetByteArrayFromObj(
 				 * array of bytes in the ByteArray object. */
 {
     ByteArray *baPtr;
+    const Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(objPtr, &properByteArrayType);
 
-    if ((objPtr->typePtr != &properByteArrayType)
-	    && (objPtr->typePtr != &tclByteArrayType)) {
-	SetByteArrayFromAny(NULL, objPtr);
+    if (irPtr == NULL) {
+	irPtr = Tcl_FetchIntRep(objPtr, &tclByteArrayType);
+	if (irPtr == NULL) {
+	    SetByteArrayFromAny(NULL, objPtr);
+	    irPtr = Tcl_FetchIntRep(objPtr, &properByteArrayType);
+	    if (irPtr == NULL) {
+		irPtr = Tcl_FetchIntRep(objPtr, &tclByteArrayType);
+	    }
+	}
     }
-    baPtr = GET_BYTEARRAY(objPtr);
+    baPtr = GET_BYTEARRAY(irPtr);
 
     if (lengthPtr != NULL) {
 	*lengthPtr = baPtr->used;
     }
-    return (unsigned char *) baPtr->bytes;
+    return baPtr->bytes;
 }
 
 /*
@@ -490,23 +501,36 @@ Tcl_SetByteArrayLength(
     int length)			/* New length for internal byte array. */
 {
     ByteArray *byteArrayPtr;
+    unsigned newLength;
+    Tcl_ObjIntRep *irPtr;
+
+    assert(length >= 0);
+    newLength = (unsigned int)length;
 
     if (Tcl_IsShared(objPtr)) {
 	Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayLength");
     }
-    if ((objPtr->typePtr != &properByteArrayType)
-	    && (objPtr->typePtr != &tclByteArrayType)) {
-	SetByteArrayFromAny(NULL, objPtr);
+
+    irPtr = Tcl_FetchIntRep(objPtr, &properByteArrayType);
+    if (irPtr == NULL) {
+	irPtr = Tcl_FetchIntRep(objPtr, &tclByteArrayType);
+	if (irPtr == NULL) {
+	    SetByteArrayFromAny(NULL, objPtr);
+	    irPtr = Tcl_FetchIntRep(objPtr, &properByteArrayType);
+	    if (irPtr == NULL) {
+		irPtr = Tcl_FetchIntRep(objPtr, &tclByteArrayType);
+	    }
+	}
     }
 
-    byteArrayPtr = GET_BYTEARRAY(objPtr);
-    if (length > byteArrayPtr->allocated) {
-	byteArrayPtr = ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(length));
-	byteArrayPtr->allocated = length;
-	SET_BYTEARRAY(objPtr, byteArrayPtr);
+    byteArrayPtr = GET_BYTEARRAY(irPtr);
+    if (newLength > byteArrayPtr->allocated) {
+	byteArrayPtr = ckrealloc(byteArrayPtr, BYTEARRAY_SIZE(newLength));
+	byteArrayPtr->allocated = newLength;
+	SET_BYTEARRAY(irPtr, byteArrayPtr);
     }
     TclInvalidateStringRep(objPtr);
-    byteArrayPtr->used = length;
+    byteArrayPtr->used = newLength;
     return byteArrayPtr->bytes;
 }
 
@@ -536,12 +560,12 @@ SetByteArrayFromAny(
     const char *src, *srcEnd;
     unsigned char *dst;
     ByteArray *byteArrayPtr;
-    Tcl_UniChar ch = 0;
+    Tcl_ObjIntRep ir;
 
-    if (objPtr->typePtr == &properByteArrayType) {
+    if (Tcl_FetchIntRep(objPtr, &properByteArrayType)) {
 	return TCL_OK;
     }
-    if (objPtr->typePtr == &tclByteArrayType) {
+    if (Tcl_FetchIntRep(objPtr, &tclByteArrayType)) {
 	return TCL_OK;
     }
 
@@ -551,6 +575,7 @@ SetByteArrayFromAny(
 
     byteArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
     for (dst = byteArrayPtr->bytes; src < srcEnd; ) {
+	Tcl_UniChar ch = 0;
 	src += TclUtfToUniChar(src, &ch);
 	improper = improper || (ch > 255);
 	*dst++ = UCHAR(ch);
@@ -559,9 +584,9 @@ SetByteArrayFromAny(
     byteArrayPtr->used = dst - byteArrayPtr->bytes;
     byteArrayPtr->allocated = length;
 
-    TclFreeIntRep(objPtr);
-    objPtr->typePtr = improper ? &tclByteArrayType : &properByteArrayType;
-    SET_BYTEARRAY(objPtr, byteArrayPtr);
+    SET_BYTEARRAY(&ir, byteArrayPtr);
+    Tcl_StoreIntRep(objPtr,
+	    improper ? &tclByteArrayType : &properByteArrayType, &ir);
     return TCL_OK;
 }
 
@@ -586,8 +611,14 @@ static void
 FreeByteArrayInternalRep(
     Tcl_Obj *objPtr)		/* Object with internal rep to free. */
 {
-    ckfree(GET_BYTEARRAY(objPtr));
-    objPtr->typePtr = NULL;
+    ckfree(GET_BYTEARRAY(Tcl_FetchIntRep(objPtr, &tclByteArrayType)));
+}
+
+static void
+FreeProperByteArrayInternalRep(
+    Tcl_Obj *objPtr)		/* Object with internal rep to free. */
+{
+    ckfree(GET_BYTEARRAY(Tcl_FetchIntRep(objPtr, &properByteArrayType)));
 }
 
 /*
@@ -612,19 +643,41 @@ DupByteArrayInternalRep(
     Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
     Tcl_Obj *copyPtr)		/* Object with internal rep to set. */
 {
-    int length;
+    unsigned int length;
     ByteArray *srcArrayPtr, *copyArrayPtr;
+    Tcl_ObjIntRep ir;
 
-    srcArrayPtr = GET_BYTEARRAY(srcPtr);
+    srcArrayPtr = GET_BYTEARRAY(Tcl_FetchIntRep(srcPtr, &tclByteArrayType));
     length = srcArrayPtr->used;
 
     copyArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
     copyArrayPtr->used = length;
     copyArrayPtr->allocated = length;
     memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, (size_t) length);
-    SET_BYTEARRAY(copyPtr, copyArrayPtr);
 
-    copyPtr->typePtr = srcPtr->typePtr;
+    SET_BYTEARRAY(&ir, copyArrayPtr);
+    Tcl_StoreIntRep(copyPtr, &tclByteArrayType, &ir);
+}
+
+static void
+DupProperByteArrayInternalRep(
+    Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
+    Tcl_Obj *copyPtr)		/* Object with internal rep to set. */
+{
+    unsigned int length;
+    ByteArray *srcArrayPtr, *copyArrayPtr;
+    Tcl_ObjIntRep ir;
+
+    srcArrayPtr = GET_BYTEARRAY(Tcl_FetchIntRep(srcPtr, &properByteArrayType));
+    length = srcArrayPtr->used;
+
+    copyArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
+    copyArrayPtr->used = length;
+    copyArrayPtr->allocated = length;
+    memcpy(copyArrayPtr->bytes, srcArrayPtr->bytes, (size_t) length);
+
+    SET_BYTEARRAY(&ir, copyArrayPtr);
+    Tcl_StoreIntRep(copyPtr, &properByteArrayType, &ir);
 }
 
 /*
@@ -632,9 +685,7 @@ DupByteArrayInternalRep(
  *
  * UpdateStringOfByteArray --
  *
- *	Update the string representation for a ByteArray data object. Note:
- *	This procedure does not invalidate an existing old string rep so
- *	storage will be lost if this has not already been done.
+ *	Update the string representation for a ByteArray data object.
  *
  * Results:
  *	None.
@@ -643,9 +694,6 @@ DupByteArrayInternalRep(
  *	The object's string is set to a valid string that results from the
  *	ByteArray-to-string conversion.
  *
- *	The object becomes a string object -- the internal rep is discarded
- *	and the typePtr becomes NULL.
- *
  *----------------------------------------------------------------------
  */
 
@@ -654,41 +702,35 @@ UpdateStringOfByteArray(
     Tcl_Obj *objPtr)		/* ByteArray object whose string rep to
 				 * update. */
 {
-    int i, length, size;
-    unsigned char *src;
-    char *dst;
-    ByteArray *byteArrayPtr;
-
-    byteArrayPtr = GET_BYTEARRAY(objPtr);
-    src = byteArrayPtr->bytes;
-    length = byteArrayPtr->used;
+    const Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(objPtr, &properByteArrayType);
+    ByteArray *byteArrayPtr = GET_BYTEARRAY(irPtr);
+    unsigned char *src = byteArrayPtr->bytes;
+    unsigned int i, length = byteArrayPtr->used;
+    unsigned int size = length;
 
     /*
      * How much space will string rep need?
      */
 
-    size = length;
-    for (i = 0; i < length && size >= 0; i++) {
+    for (i = 0; i < length && size <= INT_MAX; i++) {
 	if ((src[i] == 0) || (src[i] > 127)) {
 	    size++;
 	}
     }
-    if (size < 0) {
+    if (size > INT_MAX) {
 	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
     }
 
-    dst = ckalloc(size + 1);
-    objPtr->bytes = dst;
-    objPtr->length = size;
-
     if (size == length) {
-	memcpy(dst, src, (size_t) size);
-	dst[size] = '\0';
+	char *dst = Tcl_InitStringRep(objPtr, (char *)src, size);
+	TclOOM(dst, size);
     } else {
+	char *dst = Tcl_InitStringRep(objPtr, NULL, size);
+	TclOOM(dst, size);
 	for (i = 0; i < length; i++) {
 	    dst += Tcl_UniCharToUtf(src[i], dst);
 	}
-	*dst = '\0';
+	(void)Tcl_InitStringRep(objPtr, NULL, size);
     }
 }
 
@@ -718,7 +760,8 @@ TclAppendBytesToByteArray(
     int len)
 {
     ByteArray *byteArrayPtr;
-    int needed;
+    unsigned int length, needed;
+    Tcl_ObjIntRep *irPtr;
 
     if (Tcl_IsShared(objPtr)) {
 	Tcl_Panic("%s called with shared object","TclAppendBytesToByteArray");
@@ -731,24 +774,34 @@ TclAppendBytesToByteArray(
 	/* Append zero bytes is a no-op. */
 	return;
     }
-    if ((objPtr->typePtr != &properByteArrayType)
-	    && (objPtr->typePtr != &tclByteArrayType)) {
-	SetByteArrayFromAny(NULL, objPtr);
-    }
-    byteArrayPtr = GET_BYTEARRAY(objPtr);
 
-    if (len > INT_MAX - byteArrayPtr->used) {
+    length = (unsigned int)len;
+
+    irPtr = Tcl_FetchIntRep(objPtr, &properByteArrayType);
+    if (irPtr == NULL) {
+	irPtr = Tcl_FetchIntRep(objPtr, &tclByteArrayType);
+	if (irPtr == NULL) {
+	    SetByteArrayFromAny(NULL, objPtr);
+	    irPtr = Tcl_FetchIntRep(objPtr, &properByteArrayType);
+	    if (irPtr == NULL) {
+		irPtr = Tcl_FetchIntRep(objPtr, &tclByteArrayType);
+	    }
+	}
+    }
+    byteArrayPtr = GET_BYTEARRAY(irPtr);
+
+    if (length > INT_MAX - byteArrayPtr->used) {
 	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
     }
 
-    needed = byteArrayPtr->used + len;
+    needed = byteArrayPtr->used + length;
     /*
      * If we need to, resize the allocated space in the byte array.
      */
 
     if (needed > byteArrayPtr->allocated) {
 	ByteArray *ptr = NULL;
-	int attempt;
+	unsigned int attempt;
 
 	if (needed <= INT_MAX/2) {
 	    /* Try to allocate double the total space that is needed. */
@@ -758,7 +811,7 @@ TclAppendBytesToByteArray(
 	if (ptr == NULL) {
 	    /* Try to allocate double the increment that is needed (plus). */
 	    unsigned int limit = INT_MAX - needed;
-	    unsigned int extra = len + TCL_MIN_GROWTH;
+	    unsigned int extra = length + TCL_MIN_GROWTH;
 	    int growth = (int) ((extra > limit) ? limit : extra);
 
 	    attempt = needed + growth;
@@ -771,13 +824,13 @@ TclAppendBytesToByteArray(
 	}
 	byteArrayPtr = ptr;
 	byteArrayPtr->allocated = attempt;
-	SET_BYTEARRAY(objPtr, byteArrayPtr);
+	SET_BYTEARRAY(irPtr, byteArrayPtr);
     }
 
     if (bytes) {
-	memcpy(byteArrayPtr->bytes + byteArrayPtr->used, bytes, len);
+	memcpy(byteArrayPtr->bytes + byteArrayPtr->used, bytes, length);
     }
-    byteArrayPtr->used += len;
+    byteArrayPtr->used += length;
     TclInvalidateStringRep(objPtr);
 }
 
@@ -1978,10 +2031,11 @@ FormatNumber(
 	 */
 
 	if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) {
-	    if (src->typePtr != &tclDoubleType) {
+	    const Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(src, &tclDoubleType);
+	    if (irPtr == NULL) {
 		return TCL_ERROR;
 	    }
-	    dvalue = src->internalRep.doubleValue;
+	    dvalue = irPtr->doubleValue;
 	}
 	CopyNumber(&dvalue, *cursorPtr, sizeof(double), type);
 	*cursorPtr += sizeof(double);
@@ -1997,10 +2051,11 @@ FormatNumber(
 	 */
 
 	if (Tcl_GetDoubleFromObj(interp, src, &dvalue) != TCL_OK) {
-	    if (src->typePtr != &tclDoubleType) {
+	    const Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(src, &tclDoubleType);
+	    if (irPtr == NULL) {
 		return TCL_ERROR;
 	    }
-	    dvalue = src->internalRep.doubleValue;
+	    dvalue = irPtr->doubleValue;
 	}
 
 	/*
@@ -2483,8 +2538,8 @@ BinaryDecodeHex(
 	    }
 
 	    c = *data++;
-	    if (!isxdigit((int) c)) {
-		if (strict || !isspace(c)) {
+	    if (!isxdigit(UCHAR(c))) {
+		if (strict || !TclIsSpaceProc(c)) {
 		    goto badChar;
 		}
 		i--;
@@ -2831,7 +2886,7 @@ BinaryDecodeUu(
 	if (lineLen < 0) {
 	    c = *data++;
 	    if (c < 32 || c > 96) {
-		if (strict || !isspace(c)) {
+		if (strict || !TclIsSpaceProc(c)) {
 		    goto badUu;
 		}
 		i--;
@@ -2849,7 +2904,7 @@ BinaryDecodeUu(
 		d[i] = c = *data++;
 		if (c < 32 || c > 96) {
 		    if (strict) {
-			if (!isspace(c)) {
+			if (!TclIsSpaceProc(c)) {
 			    goto badUu;
 			} else if (c == '\n') {
 			    goto shortUu;
@@ -2893,7 +2948,7 @@ BinaryDecodeUu(
 		} else if (c >= 32 && c <= 96) {
 		    data--;
 		    break;
-		} else if (strict || !isspace(c)) {
+		} else if (strict || !TclIsSpaceProc(c)) {
 		    goto badUu;
 		}
 	    } while (data < dataend);
@@ -3018,7 +3073,7 @@ BinaryDecode64(
 		if (c == '=' && i > 1) {
 		     value <<= 6;
 		     cut++;
-		} else if (!strict && isspace(c)) {
+		} else if (!strict && TclIsSpaceProc(c)) {
 		     i--;
 		} else {
 		    goto bad64;
@@ -3036,7 +3091,7 @@ BinaryDecode64(
 	    } else if (c == '=') {
 		value <<= 6;
 		cut++;
-	    } else if (strict || !isspace(c)) {
+	    } else if (strict || !TclIsSpaceProc(c)) {
 		goto bad64;
 	    } else {
 		i--;
@@ -3057,7 +3112,7 @@ BinaryDecode64(
 		goto bad64;
 	    }
 	    for (; data < dataend; data++) {
-		if (!isspace(*data)) {
+		if (!TclIsSpaceProc(*data)) {
 		    goto bad64;
 		}
 	    }

generic/tclClock.c

@@ -452,7 +452,7 @@ ClockGetdatefieldsObjCmd(
      * that it isn't.
      */
 
-    if (objv[1]->typePtr == &tclBignumType) {
+    if (Tcl_FetchIntRep(objv[1], &tclBignumType)) {
 	Tcl_SetObjResult(interp, literals[LIT_INTEGER_VALUE_TOO_LARGE]);
 	return TCL_ERROR;
     }

generic/tclCmdAH.c

@@ -46,9 +46,6 @@ struct ForeachState {
 
 static int		CheckAccess(Tcl_Interp *interp, Tcl_Obj *pathPtr,
 			    int mode);
-static int		BadEncodingSubcommand(ClientData dummy,
-			    Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const objv[]);
 static int		EncodingConvertfromObjCmd(ClientData dummy,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
@@ -84,7 +81,6 @@ static Tcl_NRPostProc	ForPostNextCallback;
 static Tcl_NRPostProc	ForeachLoopStep;
 static Tcl_NRPostProc	EvalCmdErrMsg;
 
-static Tcl_ObjCmdProc	BadFileSubcommand;
 static Tcl_ObjCmdProc FileAttrAccessTimeCmd;
 static Tcl_ObjCmdProc FileAttrIsDirectoryCmd;
 static Tcl_ObjCmdProc FileAttrIsExecutableCmd;
@@ -536,122 +532,15 @@ TclInitEncodingCmd(
     static const EnsembleImplMap encodingImplMap[] = {
 	{"convertfrom", EncodingConvertfromObjCmd, TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
 	{"convertto",   EncodingConverttoObjCmd,   TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
-	{"dirs",        EncodingDirsObjCmd,        TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
+	{"dirs",        EncodingDirsObjCmd,        TclCompileBasic0Or1ArgCmd, NULL, NULL, 1},
 	{"names",       EncodingNamesObjCmd,       TclCompileBasic0ArgCmd,    NULL, NULL, 0},
-	{"system",      EncodingSystemObjCmd,      TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
+	{"system",      EncodingSystemObjCmd,      TclCompileBasic0Or1ArgCmd, NULL, NULL, 1},
 	{NULL,          NULL,                      NULL,                      NULL, NULL, 0}
     };
 
     return TclMakeEnsemble(interp, "encoding", encodingImplMap);
 }
 
-/*
- *-----------------------------------------------------------------------------
- *
- * TclMakeEncodingCommandSafe --
- *
- *	This function hides the unsafe 'dirs' and 'system' subcommands of
- *	the "encoding" Tcl command ensemble. It must be called only from
- *	TclHideUnsafeCommands.
- *
- * Results:
- *	A standard Tcl result
- *
- * Side effects:
- *	Adds commands to the table of hidden commands.
- *
- *-----------------------------------------------------------------------------
- */
-
-int
-TclMakeEncodingCommandSafe(
-    Tcl_Interp* interp)		/* Tcl interpreter */
-{
-    static const struct {
-	const char *cmdName;
-	int unsafe;
-    } unsafeInfo[] = {
-	{"convertfrom", 0},
-	{"convertto",   0},
-	{"dirs",        1},
-	{"names",       0},
-	{"system",      0},
-	{NULL,          0}
-    };
-
-    int i;
-    Tcl_DString oldBuf, newBuf;
-
-    Tcl_DStringInit(&oldBuf);
-    TclDStringAppendLiteral(&oldBuf, "::tcl::encoding::");
-    Tcl_DStringInit(&newBuf);
-    TclDStringAppendLiteral(&newBuf, "tcl:encoding:");
-    for (i=0 ; unsafeInfo[i].cmdName != NULL ; i++) {
-	if (unsafeInfo[i].unsafe) {
-	    const char *oldName, *newName;
-
-	    Tcl_DStringSetLength(&oldBuf, 17);
-	    oldName = Tcl_DStringAppend(&oldBuf, unsafeInfo[i].cmdName, -1);
-	    Tcl_DStringSetLength(&newBuf, 13);
-	    newName = Tcl_DStringAppend(&newBuf, unsafeInfo[i].cmdName, -1);
-	    if (TclRenameCommand(interp, oldName, "___tmp") != TCL_OK
-		    || Tcl_HideCommand(interp, "___tmp", newName) != TCL_OK) {
-		Tcl_Panic("problem making 'encoding %s' safe: %s",
-			unsafeInfo[i].cmdName,
-			Tcl_GetString(Tcl_GetObjResult(interp)));
-	    }
-	    Tcl_CreateObjCommand(interp, oldName, BadEncodingSubcommand,
-		    (ClientData) unsafeInfo[i].cmdName, NULL);
-	}
-    }
-    Tcl_DStringFree(&oldBuf);
-    Tcl_DStringFree(&newBuf);
-
-    /*
-     * Ugh. The [encoding] command is now actually safe, but it is assumed by
-     * scripts that it is not, which messes up security policies.
-     */
-
-    if (Tcl_HideCommand(interp, "encoding", "encoding") != TCL_OK) {
-	Tcl_Panic("problem making 'encoding' safe: %s",
-		Tcl_GetString(Tcl_GetObjResult(interp)));
-    }
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * BadEncodingSubcommand --
- *
- *	Command used to act as a backstop implementation when subcommands of
- *	"encoding" are unsafe (the real implementations of the subcommands are
- *	hidden). The clientData is always the full official subcommand name.
- *
- * Results:
- *	A standard Tcl result (always a TCL_ERROR).
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-BadEncodingSubcommand(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    const char *subcommandName = (const char *) clientData;
-
-    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-	    "not allowed to invoke subcommand %s of encoding", subcommandName));
-    Tcl_SetErrorCode(interp, "TCL", "SAFE", "SUBCOMMAND", NULL);
-    return TCL_ERROR;
-}
-
 /*
  *----------------------------------------------------------------------
  *
@@ -1174,180 +1063,45 @@ TclInitFileCmd(
      */
 
     static const EnsembleImplMap initMap[] = {
-	{"atime",	FileAttrAccessTimeCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
-	{"attributes",	TclFileAttrsCmd,	NULL, NULL, NULL, 0},
+	{"atime",	FileAttrAccessTimeCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 1},
+	{"attributes",	TclFileAttrsCmd,	NULL, NULL, NULL, 1},
 	{"channels",	TclChannelNamesCmd,	TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
-	{"copy",	TclFileCopyCmd,		NULL, NULL, NULL, 0},
-	{"delete",	TclFileDeleteCmd,	TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
-	{"dirname",	PathDirNameCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
-	{"executable",	FileAttrIsExecutableCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0},
-	{"exists",	FileAttrIsExistingCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
-	{"extension",	PathExtensionCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
-	{"isdirectory",	FileAttrIsDirectoryCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
-	{"isfile",	FileAttrIsFileCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
+	{"copy",	TclFileCopyCmd,		NULL, NULL, NULL, 1},
+	{"delete",	TclFileDeleteCmd,	TclCompileBasicMin0ArgCmd, NULL, NULL, 1},
+	{"dirname",	PathDirNameCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 1},
+	{"executable",	FileAttrIsExecutableCmd, TclCompileBasic1ArgCmd, NULL, NULL, 1},
+	{"exists",	FileAttrIsExistingCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
+	{"extension",	PathExtensionCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
+	{"isdirectory",	FileAttrIsDirectoryCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
+	{"isfile",	FileAttrIsFileCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
 	{"join",	PathJoinCmd,		TclCompileBasicMin1ArgCmd, NULL, NULL, 0},
-	{"link",	TclFileLinkCmd,		TclCompileBasic1To3ArgCmd, NULL, NULL, 0},
-	{"lstat",	FileAttrLinkStatCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
-	{"mtime",	FileAttrModifyTimeCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 0},
-	{"mkdir",	TclFileMakeDirsCmd,	TclCompileBasicMin0ArgCmd, NULL, NULL, 0},
-	{"nativename",	PathNativeNameCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
-	{"normalize",	PathNormalizeCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
-	{"owned",	FileAttrIsOwnedCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
+	{"link",	TclFileLinkCmd,		TclCompileBasic1To3ArgCmd, NULL, NULL, 1},
+	{"lstat",	FileAttrLinkStatCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 1},
+	{"mtime",	FileAttrModifyTimeCmd,	TclCompileBasic1Or2ArgCmd, NULL, NULL, 1},
+	{"mkdir",	TclFileMakeDirsCmd,	TclCompileBasicMin0ArgCmd, NULL, NULL, 1},
+	{"nativename",	PathNativeNameCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
+	{"normalize",	PathNormalizeCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
+	{"owned",	FileAttrIsOwnedCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
 	{"pathtype",	PathTypeCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
-	{"readable",	FileAttrIsReadableCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
-	{"readlink",	TclFileReadLinkCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
-	{"rename",	TclFileRenameCmd,	NULL, NULL, NULL, 0},
-	{"rootname",	PathRootNameCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
+	{"readable",	FileAttrIsReadableCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
+	{"readlink",	TclFileReadLinkCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
+	{"rename",	TclFileRenameCmd,	NULL, NULL, NULL, 1},
+	{"rootname",	PathRootNameCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
 	{"separator",	FilesystemSeparatorCmd,	TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
-	{"size",	FileAttrSizeCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
+	{"size",	FileAttrSizeCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
 	{"split",	PathSplitCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
-	{"stat",	FileAttrStatCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 0},
+	{"stat",	FileAttrStatCmd,	TclCompileBasic2ArgCmd, NULL, NULL, 1},
 	{"system",	PathFilesystemCmd,	TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
-	{"tail",	PathTailCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 0},
-	{"tempfile",	TclFileTemporaryCmd,	TclCompileBasic0To2ArgCmd, NULL, NULL, 0},
-	{"type",	FileAttrTypeCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
-	{"volumes",	FilesystemVolumesCmd,	TclCompileBasic0ArgCmd, NULL, NULL, 0},
-	{"writable",	FileAttrIsWritableCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 0},
+	{"tail",	PathTailCmd,		TclCompileBasic1ArgCmd, NULL, NULL, 1},
+	{"tempfile",	TclFileTemporaryCmd,	TclCompileBasic0To2ArgCmd, NULL, NULL, 1},
+	{"type",	FileAttrTypeCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
+	{"volumes",	FilesystemVolumesCmd,	TclCompileBasic0ArgCmd, NULL, NULL, 1},
+	{"writable",	FileAttrIsWritableCmd,	TclCompileBasic1ArgCmd, NULL, NULL, 1},
 	{NULL, NULL, NULL, NULL, NULL, 0}
     };
     return TclMakeEnsemble(interp, "file", initMap);
 }
 
-/*
- *----------------------------------------------------------------------
- *
- * TclMakeFileCommandSafe --
- *
- *	This function hides the unsafe subcommands of the "file" Tcl command
- *	ensemble. It must only be called from TclHideUnsafeCommands.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	Adds commands to the table of hidden commands.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclMakeFileCommandSafe(
-    Tcl_Interp *interp)
-{
-    static const struct {
-	const char *cmdName;
-	int unsafe;
-    } unsafeInfo[] = {
-	{"atime",	 1},
-	{"attributes",	 1},
-	{"channels",	 0},
-	{"copy",	 1},
-	{"delete",	 1},
-	{"dirname",	 1},
-	{"executable",	 1},
-	{"exists",	 1},
-	{"extension",	 1},
-	{"isdirectory",	 1},
-	{"isfile",	 1},
-	{"join",	 0},
-	{"link",	 1},
-	{"lstat",	 1},
-	{"mtime",	 1},
-	{"mkdir",	 1},
-	{"nativename",	 1},
-	{"normalize",	 1},
-	{"owned",	 1},
-	{"pathtype",	 0},
-	{"readable",	 1},
-	{"readlink",	 1},
-	{"rename",	 1},
-	{"rootname",	 1},
-	{"separator",	 0},
-	{"size",	 1},
-	{"split",	 0},
-	{"stat",	 1},
-	{"system",	 0},
-	{"tail",	 1},
-	{"tempfile",	 1},
-	{"type",	 1},
-	{"volumes",	 1},
-	{"writable",	 1},
-	{NULL, 0}
-    };
-    int i;
-    Tcl_DString oldBuf, newBuf;
-
-    Tcl_DStringInit(&oldBuf);
-    TclDStringAppendLiteral(&oldBuf, "::tcl::file::");
-    Tcl_DStringInit(&newBuf);
-    TclDStringAppendLiteral(&newBuf, "tcl:file:");
-    for (i=0 ; unsafeInfo[i].cmdName != NULL ; i++) {
-	if (unsafeInfo[i].unsafe) {
-	    const char *oldName, *newName;
-
-	    Tcl_DStringSetLength(&oldBuf, 13);
-	    oldName = Tcl_DStringAppend(&oldBuf, unsafeInfo[i].cmdName, -1);
-	    Tcl_DStringSetLength(&newBuf, 9);
-	    newName = Tcl_DStringAppend(&newBuf, unsafeInfo[i].cmdName, -1);
-	    if (TclRenameCommand(interp, oldName, "___tmp") != TCL_OK
-		    || Tcl_HideCommand(interp, "___tmp", newName) != TCL_OK) {
-		Tcl_Panic("problem making 'file %s' safe: %s",
-			unsafeInfo[i].cmdName,
-			Tcl_GetString(Tcl_GetObjResult(interp)));
-	    }
-	    Tcl_CreateObjCommand(interp, oldName, BadFileSubcommand,
-		    (ClientData) unsafeInfo[i].cmdName, NULL);
-	}
-    }
-    Tcl_DStringFree(&oldBuf);
-    Tcl_DStringFree(&newBuf);
-
-    /*
-     * Ugh. The [file] command is now actually safe, but it is assumed by
-     * scripts that it is not, which messes up security policies. [Bug
-     * 3211758]
-     */
-
-    if (Tcl_HideCommand(interp, "file", "file") != TCL_OK) {
-	Tcl_Panic("problem making 'file' safe: %s",
-		Tcl_GetString(Tcl_GetObjResult(interp)));
-    }
-    return TCL_OK;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * BadFileSubcommand --
- *
- *	Command used to act as a backstop implementation when subcommands of
- *	"file" are unsafe (the real implementations of the subcommands are
- *	hidden). The clientData is always the full official subcommand name.
- *
- * Results:
- *	A standard Tcl result (always a TCL_ERROR).
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-BadFileSubcommand(
-    ClientData clientData,
-    Tcl_Interp *interp,
-    int objc,
-    Tcl_Obj *const objv[])
-{
-    const char *subcommandName = (const char *) clientData;
-
-    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-	    "not allowed to invoke subcommand %s of file", subcommandName));
-    Tcl_SetErrorCode(interp, "TCL", "SAFE", "SUBCOMMAND", NULL);
-    return TCL_ERROR;
-}
-
 /*
  *----------------------------------------------------------------------
  *

generic/tclCmdIL.c

@@ -173,7 +173,7 @@ static const EnsembleImplMap defaultInfoMap[] = {
     {"library",		   InfoLibraryCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
     {"loaded",		   InfoLoadedCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
     {"locals",		   TclInfoLocalsCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
-    {"nameofexecutable",   InfoNameOfExecutableCmd, TclCompileBasic0ArgCmd, NULL, NULL, 0},
+    {"nameofexecutable",   InfoNameOfExecutableCmd, TclCompileBasic0ArgCmd, NULL, NULL, 1},
     {"patchlevel",	   InfoPatchLevelCmd,	    TclCompileBasic0ArgCmd, NULL, NULL, 0},
     {"procs",		   InfoProcsCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
     {"script",		   InfoScriptCmd,	    TclCompileBasic0Or1ArgCmd, NULL, NULL, 0},
@@ -539,9 +539,9 @@ InfoBodyCmd(
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
     register Interp *iPtr = (Interp *) interp;
-    const char *name;
+    const char *name, *bytes;
     Proc *procPtr;
-    Tcl_Obj *bodyPtr, *resultPtr;
+    int numBytes;
 
     if (objc != 2) {
 	Tcl_WrongNumArgs(interp, 1, objv, "procname");
@@ -566,18 +566,8 @@ InfoBodyCmd(
      * the object do not invalidate the internal rep.
      */
 
-    bodyPtr = procPtr->bodyPtr;
-    if (bodyPtr->bytes == NULL) {
-	/*
-	 * The string rep might not be valid if the procedure has never been
-	 * run before. [Bug #545644]
-	 */
-
-	TclGetString(bodyPtr);
-    }
-    resultPtr = Tcl_NewStringObj(bodyPtr->bytes, bodyPtr->length);
-
-    Tcl_SetObjResult(interp, resultPtr);
+    bytes = Tcl_GetStringFromObj(procPtr->bodyPtr, &numBytes);
+    Tcl_SetObjResult(interp, Tcl_NewStringObj(bytes, numBytes));
     return TCL_OK;
 }
 

generic/tclCmdMZ.c

@@ -258,7 +258,7 @@ Tcl_RegexpObjCmd(
     stringLength = Tcl_GetCharLength(objPtr);
 
     if (startIndex) {
-	TclGetIntForIndexM(NULL, startIndex, stringLength, &offset);
+	TclGetIntForIndexM(interp, startIndex, stringLength, &offset);
 	Tcl_DecrRefCount(startIndex);
 	if (offset < 0) {
 	    offset = 0;
@@ -582,7 +582,7 @@ Tcl_RegsubObjCmd(
     if (startIndex) {
 	int stringLength = Tcl_GetCharLength(objv[1]);
 
-	TclGetIntForIndexM(NULL, startIndex, stringLength, &offset);
+	TclGetIntForIndexM(interp, startIndex, stringLength, &offset);
 	Tcl_DecrRefCount(startIndex);
 	if (offset < 0) {
 	    offset = 0;
@@ -1490,7 +1490,7 @@ StringIsCmd(
 
     static const char *const isClasses[] = {
 	"alnum",	"alpha",	"ascii",	"control",
-	"boolean",	"digit",	"double",	"entier",
+	"boolean",	"dict", "digit",	"double",	"entier",
 	"false",	"graph",	"integer",	"list",
 	"lower",	"print",	"punct",	"space",
 	"true",		"upper",	"wideinteger",	"wordchar",
@@ -1498,7 +1498,7 @@ StringIsCmd(
     };
     enum isClasses {
 	STR_IS_ALNUM,	STR_IS_ALPHA,	STR_IS_ASCII,	STR_IS_CONTROL,
-	STR_IS_BOOL,	STR_IS_DIGIT,	STR_IS_DOUBLE,	STR_IS_ENTIER,
+	STR_IS_BOOL,	STR_IS_DICT, STR_IS_DIGIT,	STR_IS_DOUBLE,	STR_IS_ENTIER,
 	STR_IS_FALSE,	STR_IS_GRAPH,	STR_IS_INT,	STR_IS_LIST,
 	STR_IS_LOWER,	STR_IS_PRINT,	STR_IS_PUNCT,	STR_IS_SPACE,
 	STR_IS_TRUE,	STR_IS_UPPER,	STR_IS_WIDE,	STR_IS_WORD,
@@ -1589,13 +1589,20 @@ StringIsCmd(
     case STR_IS_CONTROL:
 	chcomp = Tcl_UniCharIsControl;
 	break;
+    case STR_IS_DICT: {
+    int dresult, dsize;
+	dresult = Tcl_DictObjSize(interp, objPtr, &dsize);
+	Tcl_ResetResult(interp);
+	result = (dresult==TCL_OK) ? 1 : 0;
+	break;
+	}
     case STR_IS_DIGIT:
 	chcomp = Tcl_UniCharIsDigit;
 	break;
     case STR_IS_DOUBLE: {
-	if ((objPtr->typePtr == &tclDoubleType) ||
-		(objPtr->typePtr == &tclIntType) ||
-		(objPtr->typePtr == &tclBignumType)) {
+	if (Tcl_FetchIntRep(objPtr, &tclDoubleType) ||
+		Tcl_FetchIntRep(objPtr, &tclIntType) ||
+		Tcl_FetchIntRep(objPtr, &tclBignumType)) {
 	    break;
 	}
 	string1 = TclGetStringFromObj(objPtr, &length1);
@@ -1623,13 +1630,9 @@ StringIsCmd(
 	chcomp = Tcl_UniCharIsGraph;
 	break;
     case STR_IS_INT:
-	if (TCL_OK == TclGetIntFromObj(NULL, objPtr, &i)) {
-	    break;
-	}
-	goto failedIntParse;
     case STR_IS_ENTIER:
-	if ((objPtr->typePtr == &tclIntType) ||
-		(objPtr->typePtr == &tclBignumType)) {
+	if (Tcl_FetchIntRep(objPtr, &tclIntType) ||
+		Tcl_FetchIntRep(objPtr, &tclBignumType)) {
 	    break;
 	}
 	string1 = TclGetStringFromObj(objPtr, &length1);
@@ -1674,7 +1677,6 @@ StringIsCmd(
 	    break;
 	}
 
-    failedIntParse:
 	string1 = TclGetStringFromObj(objPtr, &length1);
 	if (length1 == 0) {
 	    if (strict) {
@@ -1849,7 +1851,7 @@ static int
 UniCharIsHexDigit(
     int character)
 {
-    return (character >= 0) && (character < 0x80) && isxdigit(character);
+    return (character >= 0) && (character < 0x80) && isxdigit(UCHAR(character));
 }
 
 /*
@@ -1908,7 +1910,8 @@ StringMapCmd(
      * inconsistencies (see test string-10.20.1 for illustration why!)
      */
 
-    if (objv[objc-2]->typePtr == &tclDictType && objv[objc-2]->bytes == NULL){
+    if (!TclHasStringRep(objv[objc-2]) 
+	    && Tcl_FetchIntRep(objv[objc-2], &tclDictType)){
 	int i, done;
 	Tcl_DictSearch search;
 

generic/tclCompCmdsSZ.c

@@ -461,7 +461,7 @@ TclCompileStringIsCmd(
     Tcl_Token *tokenPtr = TokenAfter(parsePtr->tokenPtr);
     static const char *const isClasses[] = {
 	"alnum",	"alpha",	"ascii",	"control",
-	"boolean",	"digit",	"double",	"entier",
+	"boolean",	"dict", "digit",	"double",	"entier",
 	"false",	"graph",	"integer",	"list",
 	"lower",	"print",	"punct",	"space",
 	"true",		"upper",	"wideinteger",	"wordchar",
@@ -469,7 +469,7 @@ TclCompileStringIsCmd(
     };
     enum isClasses {
 	STR_IS_ALNUM,	STR_IS_ALPHA,	STR_IS_ASCII,	STR_IS_CONTROL,
-	STR_IS_BOOL,	STR_IS_DIGIT,	STR_IS_DOUBLE,	STR_IS_ENTIER,
+	STR_IS_BOOL,	STR_IS_DICT, STR_IS_DIGIT,	STR_IS_DOUBLE,	STR_IS_ENTIER,
 	STR_IS_FALSE,	STR_IS_GRAPH,	STR_IS_INT,	STR_IS_LIST,
 	STR_IS_LOWER,	STR_IS_PRINT,	STR_IS_PUNCT,	STR_IS_SPACE,
 	STR_IS_TRUE,	STR_IS_UPPER,	STR_IS_WIDE,	STR_IS_WORD,
@@ -691,14 +691,11 @@ TclCompileStringIsCmd(
 	}
 
 	switch (t) {
-	case STR_IS_INT:
-	    PUSH(	"1");
-	    OP(		EQ);
-	    break;
 	case STR_IS_WIDE:
 	    PUSH(	"2");
 	    OP(		LE);
 	    break;
+	case STR_IS_INT:
 	case STR_IS_ENTIER:
 	    PUSH(	"3");
 	    OP(		LE);
@@ -706,7 +703,19 @@ TclCompileStringIsCmd(
 	}
 	FIXJUMP1(	end);
 	return TCL_OK;
-
+    case STR_IS_DICT:
+	range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
+	OP4(		BEGIN_CATCH4, range);
+	ExceptionRangeStarts(envPtr, range);
+	OP(		DUP);
+	OP(		DICT_VERIFY);
+	ExceptionRangeEnds(envPtr, range);
+	ExceptionRangeTarget(envPtr, range, catchOffset);
+	OP(		POP);
+	OP(		PUSH_RETURN_CODE);
+	OP(		END_CATCH);
+	OP(		LNOT);
+	return TCL_OK;
     case STR_IS_LIST:
 	range = TclCreateExceptRange(CATCH_EXCEPTION_RANGE, envPtr);
 	OP4(		BEGIN_CATCH4, range);
@@ -1353,7 +1362,7 @@ static int
 UniCharIsHexDigit(
     int character)
 {
-    return (character >= 0) && (character < 0x80) && isxdigit(character);
+    return (character >= 0) && (character < 0x80) && isxdigit(UCHAR(character));
 }
 
 StringClassDesc const tclStringClassTable[] = {

generic/tclCompExpr.c

@@ -1759,7 +1759,7 @@ ConvertTreeToTokens(
 
 		/*
 		 * All the Tcl_Tokens allocated and filled belong to
-		 * this subexpresion. The first token is the leading
+		 * this subexpression. The first token is the leading
 		 * TCL_TOKEN_SUB_EXPR token, and all the rest (one fewer)
 		 * are its components.
 		 */
@@ -2476,11 +2476,13 @@ CompileExprTree(
 		     * already, then use it to share via the literal table.
 		     */
 
-		    if (objPtr->bytes) {
+		    if (TclHasStringRep(objPtr)) {
 			Tcl_Obj *tableValue;
+			int numBytes;
+			const char *bytes
+				= Tcl_GetStringFromObj(objPtr, &numBytes);
 
-			index = TclRegisterLiteral(envPtr, objPtr->bytes,
-				objPtr->length, 0);
+			index = TclRegisterLiteral(envPtr, bytes, numBytes, 0);
 			tableValue = TclFetchLiteral(envPtr, index);
 			if ((tableValue->typePtr == NULL) &&
 				(objPtr->typePtr != NULL)) {

generic/tclCompile.c

@@ -725,13 +725,14 @@ static const Tcl_ObjType substCodeType = {
     NULL,			/* updateStringProc */
     NULL,			/* setFromAnyProc */
 };
+#define SubstFlags(objPtr) (objPtr)->internalRep.twoPtrValue.ptr2
 
 /*
  * Helper macros.
  */
 
 #define TclIncrUInt4AtPtr(ptr, delta) \
-    TclStoreInt4AtPtr(TclGetUInt4AtPtr(ptr)+(delta), (ptr));
+    TclStoreInt4AtPtr(TclGetUInt4AtPtr(ptr)+(delta), (ptr))
 
 /*
  *----------------------------------------------------------------------
@@ -974,7 +975,10 @@ static void
 FreeByteCodeInternalRep(
     register Tcl_Obj *objPtr)	/* Object whose internal rep to free. */
 {
-    register ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;
+    ByteCode *codePtr;
+
+    ByteCodeGetIntRep(objPtr, &tclByteCodeType, codePtr);
+    assert(codePtr != NULL);
 
     TclReleaseByteCode(codePtr);
 }
@@ -1304,21 +1308,23 @@ CompileSubstObj(
     Interp *iPtr = (Interp *) interp;
     ByteCode *codePtr = NULL;
 
-    if (objPtr->typePtr == &substCodeType) {
+    ByteCodeGetIntRep(objPtr, &substCodeType, codePtr);
+
+    if (codePtr != NULL) {
 	Namespace *nsPtr = iPtr->varFramePtr->nsPtr;
 
-	codePtr = objPtr->internalRep.twoPtrValue.ptr1;
-	if (flags != PTR2INT(objPtr->internalRep.twoPtrValue.ptr2)
+	if (flags != PTR2INT(SubstFlags(objPtr))
 		|| ((Interp *) *codePtr->interpHandle != iPtr)
 		|| (codePtr->compileEpoch != iPtr->compileEpoch)
 		|| (codePtr->nsPtr != nsPtr)
 		|| (codePtr->nsEpoch != nsPtr->resolverEpoch)
 		|| (codePtr->localCachePtr !=
 		iPtr->varFramePtr->localCachePtr)) {
-	    TclFreeIntRep(objPtr);
+	    Tcl_StoreIntRep(objPtr, &substCodeType, NULL);
+	    codePtr = NULL;
 	}
     }
-    if (objPtr->typePtr != &substCodeType) {
+    if (codePtr == NULL) {
 	CompileEnv compEnv;
 	int numBytes;
 	const char *bytes = TclGetStringFromObj(objPtr, &numBytes);
@@ -1332,8 +1338,7 @@ CompileSubstObj(
 	codePtr = TclInitByteCodeObj(objPtr, &substCodeType, &compEnv);
 	TclFreeCompileEnv(&compEnv);
 
-	objPtr->internalRep.twoPtrValue.ptr1 = codePtr;
-	objPtr->internalRep.twoPtrValue.ptr2 = INT2PTR(flags);
+	SubstFlags(objPtr) = INT2PTR(flags);
 	if (iPtr->varFramePtr->localCachePtr) {
 	    codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
 	    codePtr->localCachePtr->refCount++;
@@ -1372,7 +1377,10 @@ static void
 FreeSubstCodeInternalRep(
     register Tcl_Obj *objPtr)	/* Object whose internal rep to free. */
 {
-    register ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;
+    register ByteCode *codePtr;
+
+    ByteCodeGetIntRep(objPtr, &substCodeType, codePtr);
+    assert(codePtr != NULL);
 
     TclReleaseByteCode(codePtr);
 }
@@ -2912,9 +2920,7 @@ TclInitByteCodeObj(
      * by making its internal rep point to the just compiled ByteCode.
      */
 
-    TclFreeIntRep(objPtr);
-    objPtr->internalRep.twoPtrValue.ptr1 = codePtr;
-    objPtr->typePtr = typePtr;
+    ByteCodeSetIntRep(objPtr, typePtr, codePtr);
     return codePtr;
 }
 

generic/tclCompile.h

@@ -514,6 +514,23 @@ typedef struct ByteCode {
 				 * created. */
 #endif /* TCL_COMPILE_STATS */
 } ByteCode;
+
+#define ByteCodeSetIntRep(objPtr, typePtr, codePtr)			\
+    do {								\
+	Tcl_ObjIntRep ir;						\
+	ir.twoPtrValue.ptr1 = (codePtr);				\
+	ir.twoPtrValue.ptr2 = NULL;					\
+	Tcl_StoreIntRep((objPtr), (typePtr), &ir);			\
+    } while (0)
+
+
+
+#define ByteCodeGetIntRep(objPtr, typePtr, codePtr)			\
+    do {								\
+	const Tcl_ObjIntRep *irPtr;					\
+	irPtr = Tcl_FetchIntRep((objPtr), (typePtr));			\
+	(codePtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL;		\
+    } while (0)
 
 /*
  * Opcodes for the Tcl bytecode instructions. These must correspond to the
@@ -1473,7 +1490,7 @@ MODULE_SCOPE int	TclPushProcCallFrame(ClientData clientData,
 #endif
 
 #define TclGetInt4AtPtr(p) \
-    (((int) TclGetInt1AtPtr(p) << 24) |				\
+    (((int) (TclGetUInt1AtPtr(p) << 24)) |				\
 		     (*((p)+1) << 16) |				\
 		     (*((p)+2) <<  8) |				\
 		     (*((p)+3)))

generic/tclDecls.h

@@ -1863,17 +1863,32 @@ EXTERN Tcl_Channel	Tcl_OpenTcpServerEx(Tcl_Interp *interp,
 				Tcl_TcpAcceptProc *acceptProc,
 				ClientData callbackData);
 /* 632 */
-EXTERN int		TclZipfs_Mount(Tcl_Interp *interp, const char *mntpt,
-				const char *zipname, const char *passwd);
+EXTERN int		TclZipfs_Mount(Tcl_Interp *interp,
+				const char *mountPoint, const char *zipname,
+				const char *passwd);
 /* 633 */
 EXTERN int		TclZipfs_Unmount(Tcl_Interp *interp,
-				const char *zipname);
+				const char *mountPoint);
 /* 634 */
 EXTERN Tcl_Obj *	TclZipfs_TclLibrary(void);
 /* 635 */
-EXTERN int		TclZipfs_Mount_Buffer(Tcl_Interp *interp,
-				const char *mntpt, unsigned char *data,
+EXTERN int		TclZipfs_MountBuffer(Tcl_Interp *interp,
+				const char *mountPoint, unsigned char *data,
 				size_t datalen, int copy);
+/* 636 */
+EXTERN void		Tcl_FreeIntRep(Tcl_Obj *objPtr);
+/* 637 */
+EXTERN char *		Tcl_InitStringRep(Tcl_Obj *objPtr, const char *bytes,
+				unsigned int numBytes);
+/* 638 */
+EXTERN Tcl_ObjIntRep *	Tcl_FetchIntRep(Tcl_Obj *objPtr,
+				const Tcl_ObjType *typePtr);
+/* 639 */
+EXTERN void		Tcl_StoreIntRep(Tcl_Obj *objPtr,
+				const Tcl_ObjType *typePtr,
+				const Tcl_ObjIntRep *irPtr);
+/* 640 */
+EXTERN int		Tcl_HasStringRep(Tcl_Obj *objPtr);
 
 typedef struct {
     const struct TclPlatStubs *tclPlatStubs;
@@ -2541,10 +2556,15 @@ 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 */
+    int (*tclZipfs_Mount) (Tcl_Interp *interp, const char *mountPoint, const char *zipname, const char *passwd); /* 632 */
+    int (*tclZipfs_Unmount) (Tcl_Interp *interp, const char *mountPoint); /* 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 */
+    int (*tclZipfs_MountBuffer) (Tcl_Interp *interp, const char *mountPoint, unsigned char *data, size_t datalen, int copy); /* 635 */
+    void (*tcl_FreeIntRep) (Tcl_Obj *objPtr); /* 636 */
+    char * (*tcl_InitStringRep) (Tcl_Obj *objPtr, const char *bytes, unsigned int numBytes); /* 637 */
+    Tcl_ObjIntRep * (*tcl_FetchIntRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr); /* 638 */
+    void (*tcl_StoreIntRep) (Tcl_Obj *objPtr, const Tcl_ObjType *typePtr, const Tcl_ObjIntRep *irPtr); /* 639 */
+    int (*tcl_HasStringRep) (Tcl_Obj *objPtr); /* 640 */
 } TclStubs;
 
 extern const TclStubs *tclStubsPtr;
@@ -3845,8 +3865,18 @@ extern const TclStubs *tclStubsPtr;
 	(tclStubsPtr->tclZipfs_Unmount) /* 633 */
 #define TclZipfs_TclLibrary \
 	(tclStubsPtr->tclZipfs_TclLibrary) /* 634 */
-#define TclZipfs_Mount_Buffer \
-	(tclStubsPtr->tclZipfs_Mount_Buffer) /* 635 */
+#define TclZipfs_MountBuffer \
+	(tclStubsPtr->tclZipfs_MountBuffer) /* 635 */
+#define Tcl_FreeIntRep \
+	(tclStubsPtr->tcl_FreeIntRep) /* 636 */
+#define Tcl_InitStringRep \
+	(tclStubsPtr->tcl_InitStringRep) /* 637 */
+#define Tcl_FetchIntRep \
+	(tclStubsPtr->tcl_FetchIntRep) /* 638 */
+#define Tcl_StoreIntRep \
+	(tclStubsPtr->tcl_StoreIntRep) /* 639 */
+#define Tcl_HasStringRep \
+	(tclStubsPtr->tcl_HasStringRep) /* 640 */
 
 #endif /* defined(USE_TCL_STUBS) */
 

generic/tclDictObj.c

@@ -12,6 +12,7 @@
 
 #include "tclInt.h"
 #include "tommath.h"
+#include <assert.h>
 
 /*
  * Forward declaration.
@@ -148,13 +149,6 @@ typedef struct Dict {
 				 * dictionaries. */
 } Dict;
 
-/*
- * Accessor macro for converting between a Tcl_Obj* and a Dict. Note that this
- * must be assignable as well as readable.
- */
-
-#define DICT(dictObj)   ((dictObj)->internalRep.twoPtrValue.ptr1)
-
 /*
  * The structure below defines the dictionary object type by means of
  * functions that can be invoked by generic object code.
@@ -168,6 +162,21 @@ const Tcl_ObjType tclDictType = {
     SetDictFromAny			/* setFromAnyProc */
 };
 
+#define DictSetIntRep(objPtr, dictRepPtr)				\
+    do {                                                                \
+        Tcl_ObjIntRep ir;                                               \
+        ir.twoPtrValue.ptr1 = (dictRepPtr);                             \
+        ir.twoPtrValue.ptr2 = NULL;                                     \
+        Tcl_StoreIntRep((objPtr), &tclDictType, &ir);                   \
+    } while (0)
+
+#define DictGetIntRep(objPtr, dictRepPtr)				\
+    do {                                                                \
+        const Tcl_ObjIntRep *irPtr;                                     \
+        irPtr = Tcl_FetchIntRep((objPtr), &tclDictType);                \
+        (dictRepPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL;          \
+    } while (0)
+
 /*
  * The type of the specially adapted version of the Tcl_Obj*-containing hash
  * table defined in the tclObj.c code. This version differs in that it
@@ -363,10 +372,11 @@ DupDictInternalRep(
     Tcl_Obj *srcPtr,
     Tcl_Obj *copyPtr)
 {
-    Dict *oldDict = DICT(srcPtr);
-    Dict *newDict = ckalloc(sizeof(Dict));
+    Dict *oldDict, *newDict = ckalloc(sizeof(Dict));
     ChainEntry *cPtr;
 
+    DictGetIntRep(srcPtr, oldDict);
+
     /*
      * Copy values across from the old hash table.
      */
@@ -398,9 +408,7 @@ DupDictInternalRep(
      * Store in the object.
      */
 
-    DICT(copyPtr) = newDict;
-    copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
-    copyPtr->typePtr = &tclDictType;
+    DictSetIntRep(copyPtr, newDict);
 }
 
 /*
@@ -425,12 +433,13 @@ static void
 FreeDictInternalRep(
     Tcl_Obj *dictPtr)
 {
-    Dict *dict = DICT(dictPtr);
+    Dict *dict;
+
+    DictGetIntRep(dictPtr, dict);
 
     if (dict->refCount-- <= 1) {
 	DeleteDict(dict);
     }
-    dictPtr->typePtr = NULL;
 }
 
 /*
@@ -489,7 +498,7 @@ UpdateStringOfDict(
 {
 #define LOCAL_SIZE 64
     char localFlags[LOCAL_SIZE], *flagPtr = NULL;
-    Dict *dict = DICT(dictPtr);
+    Dict *dict;
     ChainEntry *cPtr;
     Tcl_Obj *keyPtr, *valuePtr;
     int i, length, bytesNeeded = 0;
@@ -501,12 +510,17 @@ UpdateStringOfDict(
      * is not exposed by any API function...
      */
 
-    int numElems = dict->table.numEntries * 2;
+    int numElems;
+
+    DictGetIntRep(dictPtr, dict);
+
+    assert (dict != NULL);
+
+    numElems = dict->table.numEntries * 2;
 
     /* Handle empty list case first, simplifies what follows */
     if (numElems == 0) {
-	dictPtr->bytes = &tclEmptyString;
-	dictPtr->length = 0;
+	Tcl_InitStringRep(dictPtr, NULL, 0);
 	return;
     }
 
@@ -550,9 +564,8 @@ UpdateStringOfDict(
      * Pass 2: copy into string rep buffer.
      */
 
-    dictPtr->length = bytesNeeded - 1;
-    dictPtr->bytes = ckalloc(bytesNeeded);
-    dst = dictPtr->bytes;
+    dst = Tcl_InitStringRep(dictPtr, NULL, bytesNeeded - 1);
+    TclOOM(dst, bytesNeeded);
     for (i=0,cPtr=dict->entryChainHead; i<numElems; i+=2,cPtr=cPtr->nextPtr) {
 	flagPtr[i] |= ( i ? TCL_DONT_QUOTE_HASH : 0 );
 	keyPtr = Tcl_GetHashKey(&dict->table, &cPtr->entry);
@@ -566,7 +579,7 @@ UpdateStringOfDict(
 	dst += TclConvertElement(elem, length, dst, flagPtr[i+1]);
 	*dst++ = ' ';
     }
-    dictPtr->bytes[dictPtr->length] = '\0';
+    (void)Tcl_InitStringRep(dictPtr, NULL, bytesNeeded - 1);
 
     if (flagPtr != localFlags) {
 	ckfree(flagPtr);
@@ -610,7 +623,7 @@ SetDictFromAny(
      * the conversion from lists to dictionaries.
      */
 
-    if (objPtr->typePtr == &tclListType) {
+    if (Tcl_FetchIntRep(objPtr, &tclListType)) {
 	int objc, i;
 	Tcl_Obj **objv;
 
@@ -665,10 +678,14 @@ SetDictFromAny(
 		TclNewStringObj(keyPtr, elemStart, elemSize);
 	    } else {
 		/* Avoid double copy */
+		char *dst;
+
 		TclNewObj(keyPtr);
-		keyPtr->bytes = ckalloc((unsigned) elemSize + 1);
-		keyPtr->length = TclCopyAndCollapse(elemSize, elemStart,
-			keyPtr->bytes);
+		Tcl_InvalidateStringRep(keyPtr);
+		dst = Tcl_InitStringRep(keyPtr, NULL, elemSize);
+		TclOOM(dst, elemSize); /* Consider error */
+		(void)Tcl_InitStringRep(keyPtr, NULL,
+			TclCopyAndCollapse(elemSize, elemStart, dst));
 	    }
 
 	    if (TclFindDictElement(interp, nextElem, (limit - nextElem),
@@ -681,10 +698,14 @@ SetDictFromAny(
 		TclNewStringObj(valuePtr, elemStart, elemSize);
 	    } else {
 		/* Avoid double copy */
+		char *dst;
+
 		TclNewObj(valuePtr);
-		valuePtr->bytes = ckalloc((unsigned) elemSize + 1);
-		valuePtr->length = TclCopyAndCollapse(elemSize, elemStart,
-			valuePtr->bytes);
+		Tcl_InvalidateStringRep(valuePtr);
+		dst = Tcl_InitStringRep(valuePtr, NULL, elemSize);
+		TclOOM(dst, elemSize); /* Consider error */
+		(void)Tcl_InitStringRep(valuePtr, NULL,
+			TclCopyAndCollapse(elemSize, elemStart, dst));
 	    }
 
 	    /* Store key and value in the hash table we're building. */
@@ -706,13 +727,10 @@ SetDictFromAny(
      * Tcl_GetStringFromObj, to use that old internalRep.
      */
 
-    TclFreeIntRep(objPtr);
     dict->epoch = 1;
     dict->chain = NULL;
     dict->refCount = 1;
-    DICT(objPtr) = dict;
-    objPtr->internalRep.twoPtrValue.ptr2 = NULL;
-    objPtr->typePtr = &tclDictType;
+    DictSetIntRep(objPtr, dict);
     return TCL_OK;
 
   missingValue:
@@ -726,6 +744,23 @@ SetDictFromAny(
     ckfree(dict);
     return TCL_ERROR;
 }
+
+static Dict *
+GetDictFromObj(
+    Tcl_Interp *interp,
+    Tcl_Obj *dictPtr)
+{
+    Dict *dict;
+
+    DictGetIntRep(dictPtr, dict);
+    if (dict == NULL) {
+	if (SetDictFromAny(interp, dictPtr) != TCL_OK) {
+	    return NULL;
+	}
+	DictGetIntRep(dictPtr, dict);
+    }
+    return dict;
+}
 
 /*
  *----------------------------------------------------------------------
@@ -770,11 +805,13 @@ TclTraceDictPath(
     Dict *dict, *newDict;
     int i;
 
-    if (dictPtr->typePtr != &tclDictType
-	    && SetDictFromAny(interp, dictPtr) != TCL_OK) {
-	return NULL;
+    DictGetIntRep(dictPtr, dict);
+    if (dict == NULL) {
+	if (SetDictFromAny(interp, dictPtr) != TCL_OK) {
+	    return NULL;
+	}
+	DictGetIntRep(dictPtr, dict);
     }
-    dict = DICT(dictPtr);
     if (flags & DICT_PATH_UPDATE) {
 	dict->chain = NULL;
     }
@@ -810,13 +847,17 @@ TclTraceDictPath(
 	    Tcl_SetHashValue(hPtr, tmpObj);
 	} else {
 	    tmpObj = Tcl_GetHashValue(hPtr);
-	    if (tmpObj->typePtr != &tclDictType
-		    && SetDictFromAny(interp, tmpObj) != TCL_OK) {
-		return NULL;
+
+	    DictGetIntRep(tmpObj, newDict);
+
+	    if (newDict == NULL) {
+		if (SetDictFromAny(interp, tmpObj) != TCL_OK) {
+		    return NULL;
+		}
 	    }
 	}
 
-	newDict = DICT(tmpObj);
+	DictGetIntRep(tmpObj, newDict);
 	if (flags & DICT_PATH_UPDATE) {
 	    if (Tcl_IsShared(tmpObj)) {
 		TclDecrRefCount(tmpObj);
@@ -824,7 +865,7 @@ TclTraceDictPath(
 		Tcl_IncrRefCount(tmpObj);
 		Tcl_SetHashValue(hPtr, tmpObj);
 		dict->epoch++;
-		newDict = DICT(tmpObj);
+		DictGetIntRep(tmpObj, newDict);
 	    }
 
 	    newDict->chain = dictPtr;
@@ -859,17 +900,24 @@ static void
 InvalidateDictChain(
     Tcl_Obj *dictObj)
 {
-    Dict *dict = DICT(dictObj);
+    Dict *dict;
+
+    DictGetIntRep(dictObj, dict);
+    assert( dict != NULL);
 
     do {
+	dict->refCount++;
 	TclInvalidateStringRep(dictObj);
+	TclFreeIntRep(dictObj);
+	DictSetIntRep(dictObj, dict);
+
 	dict->epoch++;
 	dictObj = dict->chain;
 	if (dictObj == NULL) {
 	    break;
 	}
 	dict->chain = NULL;
-	dict = DICT(dictObj);
+	DictGetIntRep(dictObj, dict);
     } while (dict != NULL);
 }
 
@@ -907,16 +955,16 @@ Tcl_DictObjPut(
 	Tcl_Panic("%s called with shared object", "Tcl_DictObjPut");
     }
 
-    if (dictPtr->typePtr != &tclDictType
-	    && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+    dict = GetDictFromObj(interp, dictPtr);
+    if (dict == NULL) {
 	return TCL_ERROR;
     }
 
-    if (dictPtr->bytes != NULL) {
-	TclInvalidateStringRep(dictPtr);
-    }
-    dict = DICT(dictPtr);
+    TclInvalidateStringRep(dictPtr);
     hPtr = CreateChainEntry(dict, keyPtr, &isNew);
+    dict->refCount++;
+    TclFreeIntRep(dictPtr)
+    DictSetIntRep(dictPtr, dict);
     Tcl_IncrRefCount(valuePtr);
     if (!isNew) {
 	Tcl_Obj *oldValuePtr = Tcl_GetHashValue(hPtr);
@@ -958,13 +1006,12 @@ Tcl_DictObjGet(
     Dict *dict;
     Tcl_HashEntry *hPtr;
 
-    if (dictPtr->typePtr != &tclDictType
-	    && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+    dict = GetDictFromObj(interp, dictPtr);
+    if (dict == NULL) {
 	*valuePtrPtr = NULL;
 	return TCL_ERROR;
     }
 
-    dict = DICT(dictPtr);
     hPtr = Tcl_FindHashEntry(&dict->table, keyPtr);
     if (hPtr == NULL) {
 	*valuePtrPtr = NULL;
@@ -1005,16 +1052,13 @@ Tcl_DictObjRemove(
 	Tcl_Panic("%s called with shared object", "Tcl_DictObjRemove");
     }
 
-    if (dictPtr->typePtr != &tclDictType
-	    && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+    dict = GetDictFromObj(interp, dictPtr);
+    if (dict == NULL) {
 	return TCL_ERROR;
     }
 
-    dict = DICT(dictPtr);
     if (DeleteChainEntry(dict, keyPtr)) {
-	if (dictPtr->bytes != NULL) {
-	    TclInvalidateStringRep(dictPtr);
-	}
+	TclInvalidateStringRep(dictPtr);
 	dict->epoch++;
     }
     return TCL_OK;
@@ -1046,12 +1090,11 @@ Tcl_DictObjSize(
 {
     Dict *dict;
 
-    if (dictPtr->typePtr != &tclDictType
-	    && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+    dict = GetDictFromObj(interp, dictPtr);
+    if (dict == NULL) {
 	return TCL_ERROR;
     }
 
-    dict = DICT(dictPtr);
     *sizePtr = dict->table.numEntries;
     return TCL_OK;
 }
@@ -1098,12 +1141,11 @@ Tcl_DictObjFirst(
     Dict *dict;
     ChainEntry *cPtr;
 
-    if (dictPtr->typePtr != &tclDictType
-	    && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+    dict = GetDictFromObj(interp, dictPtr);
+    if (dict == NULL) {
 	return TCL_ERROR;
     }
 
-    dict = DICT(dictPtr);
     cPtr = dict->entryChainHead;
     if (cPtr == NULL) {
 	searchPtr->epoch = 0;
@@ -1277,7 +1319,8 @@ Tcl_DictObjPutKeyList(
 	return TCL_ERROR;
     }
 
-    dict = DICT(dictPtr);
+    DictGetIntRep(dictPtr, dict);
+    assert(dict != NULL);
     hPtr = CreateChainEntry(dict, keyv[keyc-1], &isNew);
     Tcl_IncrRefCount(valuePtr);
     if (!isNew) {
@@ -1334,7 +1377,8 @@ Tcl_DictObjRemoveKeyList(
 	return TCL_ERROR;
     }
 
-    dict = DICT(dictPtr);
+    DictGetIntRep(dictPtr, dict);
+    assert(dict != NULL);
     DeleteChainEntry(dict, keyv[keyc-1]);
     InvalidateDictChain(dictPtr);
     return TCL_OK;
@@ -1380,9 +1424,7 @@ Tcl_NewDictObj(void)
     dict->epoch = 1;
     dict->chain = NULL;
     dict->refCount = 1;
-    DICT(dictPtr) = dict;
-    dictPtr->internalRep.twoPtrValue.ptr2 = NULL;
-    dictPtr->typePtr = &tclDictType;
+    DictSetIntRep(dictPtr, dict);
     return dictPtr;
 #endif
 }
@@ -1430,9 +1472,7 @@ Tcl_DbNewDictObj(
     dict->epoch = 1;
     dict->chain = NULL;
     dict->refCount = 1;
-    DICT(dictPtr) = dict;
-    dictPtr->internalRep.twoPtrValue.ptr2 = NULL;
-    dictPtr->typePtr = &tclDictType;
+    DictSetIntRep(dictPtr, dict);
     return dictPtr;
 #else /* !TCL_MEM_DEBUG */
     return Tcl_NewDictObj();
@@ -1618,16 +1658,13 @@ DictReplaceCmd(
     }
 
     dictPtr = objv[1];
-    if (dictPtr->typePtr != &tclDictType
-	    && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+    if (GetDictFromObj(interp, dictPtr) == NULL) {
 	return TCL_ERROR;
     }
     if (Tcl_IsShared(dictPtr)) {
 	dictPtr = Tcl_DuplicateObj(dictPtr);
     }
-    if (dictPtr->bytes != NULL) {
-	TclInvalidateStringRep(dictPtr);
-    }
+    TclInvalidateStringRep(dictPtr);
     for (i=2 ; i<objc ; i+=2) {
 	Tcl_DictObjPut(NULL, dictPtr, objv[i], objv[i+1]);
     }
@@ -1669,16 +1706,13 @@ DictRemoveCmd(
     }
 
     dictPtr = objv[1];
-    if (dictPtr->typePtr != &tclDictType
-	    && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+    if (GetDictFromObj(interp, dictPtr) == NULL) {
 	return TCL_ERROR;
     }
     if (Tcl_IsShared(dictPtr)) {
 	dictPtr = Tcl_DuplicateObj(dictPtr);
     }
-    if (dictPtr->bytes != NULL) {
-	TclInvalidateStringRep(dictPtr);
-    }
+    TclInvalidateStringRep(dictPtr);
     for (i=2 ; i<objc ; i++) {
 	Tcl_DictObjRemove(NULL, dictPtr, objv[i]);
     }
@@ -1729,8 +1763,7 @@ DictMergeCmd(
      */
 
     targetObj = objv[1];
-    if (targetObj->typePtr != &tclDictType
-	    && SetDictFromAny(interp, targetObj) != TCL_OK) {
+    if (GetDictFromObj(interp, targetObj) == NULL) {
 	return TCL_ERROR;
     }
 
@@ -1813,8 +1846,7 @@ DictKeysCmd(
      * need. [Bug 1705778, leak K04]
      */
 
-    if (objv[1]->typePtr != &tclDictType
-	    && SetDictFromAny(interp, objv[1]) != TCL_OK) {
+    if (GetDictFromObj(interp, objv[1]) == NULL) {
 	return TCL_ERROR;
     }
 
@@ -2021,7 +2053,6 @@ DictInfoCmd(
     int objc,
     Tcl_Obj *const *objv)
 {
-    Tcl_Obj *dictPtr;
     Dict *dict;
     char *statsStr;
 
@@ -2030,12 +2061,10 @@ DictInfoCmd(
 	return TCL_ERROR;
     }
 
-    dictPtr = objv[1];
-    if (dictPtr->typePtr != &tclDictType
-	    && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+    dict = GetDictFromObj(interp, objv[1]);
+    if (dict == NULL) {
 	return TCL_ERROR;
     }
-    dict = DICT(dictPtr);
 
     statsStr = Tcl_HashStats(&dict->table);
     Tcl_SetObjResult(interp, Tcl_NewStringObj(statsStr, -1));
@@ -2096,12 +2125,11 @@ DictIncrCmd(
 	 * soon be no good.
 	 */
 
-	char *saved = dictPtr->bytes;
 	Tcl_Obj *oldPtr = dictPtr;
 
-	dictPtr->bytes = NULL;
-	dictPtr = Tcl_DuplicateObj(dictPtr);
-	oldPtr->bytes = saved;
+	TclNewObj(dictPtr);
+	TclInvalidateStringRep(dictPtr);
+	DupDictInternalRep(oldPtr, dictPtr);
     }
     if (valuePtr == NULL) {
 	/*
@@ -2238,7 +2266,7 @@ DictLappendCmd(
 
     if (allocatedValue) {
 	Tcl_DictObjPut(NULL, dictPtr, objv[2], valuePtr);
-    } else if (dictPtr->bytes != NULL) {
+    } else {
 	TclInvalidateStringRep(dictPtr);
     }
 

generic/tclDisassemble.c

@@ -38,7 +38,7 @@ static void		UpdateStringOfInstName(Tcl_Obj *objPtr);
  * reporting of inner contexts in errorstack without string allocation.
  */
 
-static const Tcl_ObjType tclInstNameType = {
+static const Tcl_ObjType instNameType = {
     "instname",			/* name */
     NULL,			/* freeIntRepProc */
     NULL,			/* dupIntRepProc */
@@ -46,12 +46,21 @@ static const Tcl_ObjType tclInstNameType = {
     NULL,			/* setFromAnyProc */
 };
 
-/*
- * How to get the bytecode out of a Tcl_Obj.
- */
+#define InstNameSetIntRep(objPtr, inst)				\
+    do {							\
+	Tcl_ObjIntRep ir;					\
+	ir.wideValue = (inst);					\
+	Tcl_StoreIntRep((objPtr), &instNameType, &ir);		\
+    } while (0)
+
+#define InstNameGetIntRep(objPtr, inst)				\
+    do {							\
+	const Tcl_ObjIntRep *irPtr;				\
+	irPtr = Tcl_FetchIntRep((objPtr), &instNameType);	\
+	assert(irPtr != NULL);					\
+	(inst) = (size_t)irPtr->wideValue;			\
+    } while (0)
 
-#define BYTECODE(objPtr)					\
-    ((ByteCode *) (objPtr)->internalRep.twoPtrValue.ptr1)
 
 /*
  *----------------------------------------------------------------------
@@ -245,14 +254,18 @@ DisassembleByteCodeObj(
     Tcl_Interp *interp,
     Tcl_Obj *objPtr)		/* The bytecode object to disassemble. */
 {
-    ByteCode *codePtr = BYTECODE(objPtr);
+    ByteCode *codePtr;
     unsigned char *codeStart, *codeLimit, *pc;
     unsigned char *codeDeltaNext, *codeLengthNext;
     unsigned char *srcDeltaNext, *srcLengthNext;
     int codeOffset, codeLen, srcOffset, srcLen, numCmds, delta, i, line;
-    Interp *iPtr = (Interp *) *codePtr->interpHandle;
+    Interp *iPtr;
     Tcl_Obj *bufferObj, *fileObj;
 
+    ByteCodeGetIntRep(objPtr, &tclByteCodeType, codePtr);
+
+    iPtr = (Interp *) *codePtr->interpHandle;
+
     TclNewObj(bufferObj);
     if (!codePtr->refCount) {
 	return bufferObj;	/* Already freed. */
@@ -796,9 +809,8 @@ TclNewInstNameObj(
 {
     Tcl_Obj *objPtr = Tcl_NewObj();
 
-    objPtr->typePtr = &tclInstNameType;
-    objPtr->internalRep.wideValue = (long) inst;
-    objPtr->bytes = NULL;
+    TclInvalidateStringRep(objPtr);
+    InstNameSetIntRep(objPtr, (long) inst);
 
     return objPtr;
 }
@@ -817,20 +829,22 @@ static void
 UpdateStringOfInstName(
     Tcl_Obj *objPtr)
 {
-    size_t len, inst = (size_t)objPtr->internalRep.wideValue;
-    char *s, buf[TCL_INTEGER_SPACE + 5];
+    size_t inst;	/* NOTE: We know this is really an unsigned char */
+    char *dst;
+
+    InstNameGetIntRep(objPtr, inst);
 
     if (inst > LAST_INST_OPCODE) {
-        sprintf(buf, "inst_%" TCL_Z_MODIFIER "d", inst);
-        s = buf;
+	dst = Tcl_InitStringRep(objPtr, NULL, TCL_INTEGER_SPACE + 5);
+	TclOOM(dst, TCL_INTEGER_SPACE + 5);
+        sprintf(dst, "inst_%" TCL_Z_MODIFIER "d", inst);
+	(void) Tcl_InitStringRep(objPtr, NULL, strlen(dst));
     } else {
-        s = (char *) tclInstructionTable[inst].name;
+	const char *s = tclInstructionTable[inst].name;
+	unsigned int len = strlen(s);
+	dst = Tcl_InitStringRep(objPtr, s, len);
+	TclOOM(dst, len);
     }
-    len = strlen(s);
-    /* assert (len < UINT_MAX) */
-    objPtr->bytes = ckalloc(len + 1);
-    memcpy(objPtr->bytes, s, len + 1);
-    objPtr->length = len;
 }
 
 /*
@@ -942,13 +956,15 @@ DisassembleByteCodeAsDicts(
 				 * procedure, if one exists. */
     Tcl_Obj *objPtr)		/* The bytecode-holding value to take apart */
 {
-    ByteCode *codePtr = BYTECODE(objPtr);
+    ByteCode *codePtr;
     Tcl_Obj *description, *literals, *variables, *instructions, *inst;
     Tcl_Obj *aux, *exn, *commands, *file;
     unsigned char *pc, *opnd, *codeOffPtr, *codeLenPtr, *srcOffPtr, *srcLenPtr;
     int codeOffset, codeLength, sourceOffset, sourceLength;
     int i, val, line;
 
+    ByteCodeGetIntRep(objPtr, &tclByteCodeType, codePtr);
+
     /*
      * Get the literals from the bytecode.
      */
@@ -1286,6 +1302,7 @@ Tcl_DisassembleObjCmd(
     Proc *procPtr = NULL;
     Tcl_HashEntry *hPtr;
     Object *oPtr;
+    ByteCode *codePtr;
     Method *methodPtr;
 
     if (objc < 2) {
@@ -1304,27 +1321,19 @@ Tcl_DisassembleObjCmd(
 
 	/*
 	 * Compile (if uncompiled) and disassemble a lambda term.
-	 *
-	 * WARNING! Pokes inside the lambda objtype.
 	 */
 
 	if (objc != 3) {
 	    Tcl_WrongNumArgs(interp, 2, objv, "lambdaTerm");
 	    return TCL_ERROR;
 	}
-	if (objv[2]->typePtr == &tclLambdaType) {
-	    procPtr = objv[2]->internalRep.twoPtrValue.ptr1;
-	}
-	if (procPtr == NULL || procPtr->iPtr != (Interp *) interp) {
-	    result = tclLambdaType.setFromAnyProc(interp, objv[2]);
-	    if (result != TCL_OK) {
-		return result;
-	    }
-	    procPtr = objv[2]->internalRep.twoPtrValue.ptr1;
+
+	procPtr = TclGetLambdaFromObj(interp, objv[2], &nsObjPtr);
+	if (procPtr == NULL) {
+	    return TCL_ERROR;
 	}
 
 	memset(&cmd, 0, sizeof(Command));
-	nsObjPtr = objv[2]->internalRep.twoPtrValue.ptr2;
 	result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr);
 	if (result != TCL_OK) {
 	    return result;
@@ -1374,8 +1383,9 @@ Tcl_DisassembleObjCmd(
 	    Tcl_WrongNumArgs(interp, 2, objv, "script");
 	    return TCL_ERROR;
 	}
-	if ((objv[2]->typePtr != &tclByteCodeType)
-		&& (TclSetByteCodeFromAny(interp, objv[2], NULL, NULL) != TCL_OK)) {
+
+	if ((NULL == Tcl_FetchIntRep(objv[2], &tclByteCodeType)) && (TCL_OK
+		!= TclSetByteCodeFromAny(interp, objv[2], NULL, NULL))) {
 	    return TCL_ERROR;
 	}
 	codeObjPtr = objv[2];
@@ -1575,7 +1585,7 @@ Tcl_DisassembleObjCmd(
 		    "METHODTYPE", NULL);
 	    return TCL_ERROR;
 	}
-	if (procPtr->bodyPtr->typePtr != &tclByteCodeType) {
+	if (NULL == Tcl_FetchIntRep(procPtr->bodyPtr, &tclByteCodeType)) {
 	    Command cmd;
 
 	    /*
@@ -1603,14 +1613,16 @@ Tcl_DisassembleObjCmd(
      * Do the actual disassembly.
      */
 
-    if (BYTECODE(codeObjPtr)->flags & TCL_BYTECODE_PRECOMPILED) {
+    ByteCodeGetIntRep(codeObjPtr, &tclByteCodeType, codePtr);
+
+    if (codePtr->flags & TCL_BYTECODE_PRECOMPILED) {
 	Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		"may not disassemble prebuilt bytecode", -1));
 	Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
 		"BYTECODE", NULL);
 	return TCL_ERROR;
     }
-    if (PTR2INT(clientData)) {
+    if (clientData) {
 	Tcl_SetObjResult(interp,
 		DisassembleByteCodeAsDicts(interp, codeObjPtr));
     } else {

generic/tclEncoding.c

@@ -279,6 +279,21 @@ static int		Iso88591ToUtfProc(ClientData clientData,
 static const Tcl_ObjType encodingType = {
     "encoding", FreeEncodingIntRep, DupEncodingIntRep, NULL, NULL
 };
+#define EncodingSetIntRep(objPtr, encoding)				\
+    do {								\
+	Tcl_ObjIntRep ir;						\
+	ir.twoPtrValue.ptr1 = (encoding);				\
+	ir.twoPtrValue.ptr2 = NULL;					\
+	Tcl_StoreIntRep((objPtr), &encodingType, &ir);			\
+    } while (0)
+
+#define EncodingGetIntRep(objPtr, encoding)				\
+    do {								\
+	const Tcl_ObjIntRep *irPtr;					\
+	irPtr = Tcl_FetchIntRep ((objPtr), &encodingType);		\
+	(encoding) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL;		\
+    } while (0)
+
 
 /*
  *----------------------------------------------------------------------
@@ -305,17 +320,16 @@ Tcl_GetEncodingFromObj(
     Tcl_Obj *objPtr,
     Tcl_Encoding *encodingPtr)
 {
+    Tcl_Encoding encoding;
     const char *name = TclGetString(objPtr);
 
-    if (objPtr->typePtr != &encodingType) {
-	Tcl_Encoding encoding = Tcl_GetEncoding(interp, name);
-
+    EncodingGetIntRep(objPtr, encoding);
+    if (encoding == NULL) {
+	encoding = Tcl_GetEncoding(interp, name);
 	if (encoding == NULL) {
 	    return TCL_ERROR;
 	}
-	TclFreeIntRep(objPtr);
-	objPtr->internalRep.twoPtrValue.ptr1 = encoding;
-	objPtr->typePtr = &encodingType;
+	EncodingSetIntRep(objPtr, encoding);
     }
     *encodingPtr = Tcl_GetEncoding(NULL, name);
     return TCL_OK;
@@ -335,8 +349,10 @@ static void
 FreeEncodingIntRep(
     Tcl_Obj *objPtr)
 {
-    Tcl_FreeEncoding(objPtr->internalRep.twoPtrValue.ptr1);
-    objPtr->typePtr = NULL;
+    Tcl_Encoding encoding;
+
+    EncodingGetIntRep(objPtr, encoding);
+    Tcl_FreeEncoding(encoding);
 }
 
 /*
@@ -354,8 +370,8 @@ DupEncodingIntRep(
     Tcl_Obj *srcPtr,
     Tcl_Obj *dupPtr)
 {
-    dupPtr->internalRep.twoPtrValue.ptr1 = Tcl_GetEncoding(NULL, srcPtr->bytes);
-    dupPtr->typePtr = &encodingType;
+    Tcl_Encoding encoding = Tcl_GetEncoding(NULL, TclGetString(srcPtr));
+    EncodingSetIntRep(dupPtr, encoding);
 }
 
 /*
@@ -2058,7 +2074,7 @@ LoadEscapeEncoding(
     dataPtr->numSubTables =
 	    Tcl_DStringLength(&escapeData) / sizeof(EscapeSubTable);
     memcpy(dataPtr->subTables, Tcl_DStringValue(&escapeData),
-	    (size_t) Tcl_DStringLength(&escapeData));
+	    Tcl_DStringLength(&escapeData));
     Tcl_DStringFree(&escapeData);
 
     memset(dataPtr->prefixBytes, 0, sizeof(dataPtr->prefixBytes));

generic/tclEnsemble.c

@@ -84,6 +84,21 @@ static const Tcl_ObjType ensembleCmdType = {
     NULL			/* setFromAnyProc */
 };
 
+#define ECRSetIntRep(objPtr, ecRepPtr)					\
+    do {								\
+	Tcl_ObjIntRep ir;						\
+	ir.twoPtrValue.ptr1 = (ecRepPtr);				\
+	ir.twoPtrValue.ptr2 = NULL;					\
+	Tcl_StoreIntRep((objPtr), &ensembleCmdType, &ir);		\
+    } while (0)
+
+#define ECRGetIntRep(objPtr, ecRepPtr)					\
+    do {								\
+	const Tcl_ObjIntRep *irPtr;					\
+	irPtr = Tcl_FetchIntRep((objPtr), &ensembleCmdType);		\
+	(ecRepPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL;		\
+    } while (0)
+
 /*
  * The internal rep for caching ensemble subcommand lookups and spelling
  * corrections.
@@ -1742,10 +1757,10 @@ NsEnsembleImplementationCmdNR(
 	 * check here, and if we're still valid, we can jump straight to the
 	 * part where we do the invocation of the subcommand.
 	 */
+	EnsembleCmdRep *ensembleCmd;
 
-	if (subObj->typePtr==&ensembleCmdType){
-	    EnsembleCmdRep *ensembleCmd = subObj->internalRep.twoPtrValue.ptr1;
-
+	ECRGetIntRep(subObj, ensembleCmd);
+	if (ensembleCmd) {
 	    if (ensembleCmd->epoch == ensemblePtr->epoch &&
 		    ensembleCmd->token == (Command *)ensemblePtr->token) {
 		prefixObj = Tcl_GetHashValue(ensembleCmd->hPtr);
@@ -2378,8 +2393,8 @@ MakeCachedEnsembleCommand(
 {
     register EnsembleCmdRep *ensembleCmd;
 
-    if (objPtr->typePtr == &ensembleCmdType) {
-	ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;
+    ECRGetIntRep(objPtr, ensembleCmd);
+    if (ensembleCmd) {
 	TclCleanupCommandMacro(ensembleCmd->token);
 	if (ensembleCmd->fix) {
 	    Tcl_DecrRefCount(ensembleCmd->fix);
@@ -2390,10 +2405,8 @@ MakeCachedEnsembleCommand(
 	 * our own.
 	 */
 
-	TclFreeIntRep(objPtr);
 	ensembleCmd = ckalloc(sizeof(EnsembleCmdRep));
-	objPtr->internalRep.twoPtrValue.ptr1 = ensembleCmd;
-	objPtr->typePtr = &ensembleCmdType;
+	ECRSetIntRep(objPtr, ensembleCmd);
     }
 
     /*
@@ -2797,14 +2810,14 @@ static void
 FreeEnsembleCmdRep(
     Tcl_Obj *objPtr)
 {
-    EnsembleCmdRep *ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;
+    EnsembleCmdRep *ensembleCmd;
 
+    ECRGetIntRep(objPtr, ensembleCmd);
     TclCleanupCommandMacro(ensembleCmd->token);
     if (ensembleCmd->fix) {
 	Tcl_DecrRefCount(ensembleCmd->fix);
     }
     ckfree(ensembleCmd);
-    objPtr->typePtr = NULL;
 }
 
 /*
@@ -2830,11 +2843,12 @@ DupEnsembleCmdRep(
     Tcl_Obj *objPtr,
     Tcl_Obj *copyPtr)
 {
-    EnsembleCmdRep *ensembleCmd = objPtr->internalRep.twoPtrValue.ptr1;
+    EnsembleCmdRep *ensembleCmd;
     EnsembleCmdRep *ensembleCopy = ckalloc(sizeof(EnsembleCmdRep));
 
-    copyPtr->typePtr = &ensembleCmdType;
-    copyPtr->internalRep.twoPtrValue.ptr1 = ensembleCopy;
+    ECRGetIntRep(objPtr, ensembleCmd);
+    ECRSetIntRep(copyPtr, ensembleCopy);
+
     ensembleCopy->epoch = ensembleCmd->epoch;
     ensembleCopy->token = ensembleCmd->token;
     ensembleCopy->token->refCount++;

generic/tclExecute.c

@@ -500,7 +500,7 @@ VarHashCreateVar(
 
 #define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \
     (((objPtr)->typePtr == &tclIntType)					\
-	?	(*(tPtr) = TCL_NUMBER_WIDE,				\
+	?	(*(tPtr) = TCL_NUMBER_INT,				\
 		*(ptrPtr) = (ClientData)				\
 		    (&((objPtr)->internalRep.wideValue)), TCL_OK) :	\
     ((objPtr)->typePtr == &tclDoubleType)				\
@@ -748,20 +748,22 @@ ReleaseDictIterator(
 {
     Tcl_DictSearch *searchPtr;
     Tcl_Obj *dictPtr;
+    const Tcl_ObjIntRep *irPtr;
+
+    irPtr = Tcl_FetchIntRep(objPtr, &dictIteratorType);
+    assert(irPtr != NULL);
 
     /*
      * First kill the search, and then release the reference to the dictionary
      * that we were holding.
      */
 
-    searchPtr = objPtr->internalRep.twoPtrValue.ptr1;
+    searchPtr = irPtr->twoPtrValue.ptr1;
     Tcl_DictObjDone(searchPtr);
     ckfree(searchPtr);
 
-    dictPtr = objPtr->internalRep.twoPtrValue.ptr2;
+    dictPtr = irPtr->twoPtrValue.ptr2;
     TclDecrRefCount(dictPtr);
-
-    objPtr->typePtr = NULL;
 }
 
 /*
@@ -1450,19 +1452,23 @@ CompileExprObj(
      * Get the expression ByteCode from the object. If it exists, make sure it
      * is valid in the current context.
      */
-    if (objPtr->typePtr == &exprCodeType) {
+
+    ByteCodeGetIntRep(objPtr, &exprCodeType, codePtr);
+    
+    if (codePtr != NULL) {
 	Namespace *namespacePtr = iPtr->varFramePtr->nsPtr;
 
-	codePtr = objPtr->internalRep.twoPtrValue.ptr1;
 	if (((Interp *) *codePtr->interpHandle != iPtr)
 		|| (codePtr->compileEpoch != iPtr->compileEpoch)
 		|| (codePtr->nsPtr != namespacePtr)
 		|| (codePtr->nsEpoch != namespacePtr->resolverEpoch)
 		|| (codePtr->localCachePtr != iPtr->varFramePtr->localCachePtr)) {
-	    TclFreeIntRep(objPtr);
+	    Tcl_StoreIntRep(objPtr, &exprCodeType, NULL);
+	    codePtr = NULL;
 	}
     }
-    if (objPtr->typePtr != &exprCodeType) {
+
+    if (codePtr == NULL) {
 	/*
 	 * TIP #280: No invoker (yet) - Expression compilation.
 	 */
@@ -1562,7 +1568,9 @@ static void
 FreeExprCodeInternalRep(
     Tcl_Obj *objPtr)
 {
-    ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;
+    ByteCode *codePtr;
+    ByteCodeGetIntRep(objPtr, &exprCodeType, codePtr);
+    assert(codePtr != NULL);
 
     TclReleaseByteCode(codePtr);
 }
@@ -1600,7 +1608,8 @@ TclCompileObj(
      * compilation). Otherwise, check that it is "fresh" enough.
      */
 
-    if (objPtr->typePtr == &tclByteCodeType) {
+    ByteCodeGetIntRep(objPtr, &tclByteCodeType, codePtr);
+    if (codePtr != NULL) {
 	/*
 	 * Make sure the Bytecode hasn't been invalidated by, e.g., someone
 	 * redefining a command with a compile procedure (this might make the
@@ -1618,7 +1627,6 @@ TclCompileObj(
 	 * here.
 	 */
 
-	codePtr = objPtr->internalRep.twoPtrValue.ptr1;
 	if (((Interp *) *codePtr->interpHandle != iPtr)
 		|| (codePtr->compileEpoch != iPtr->compileEpoch)
 		|| (codePtr->nsPtr != namespacePtr)
@@ -1746,7 +1754,7 @@ TclCompileObj(
     iPtr->invokeWord = word;
     TclSetByteCodeFromAny(interp, objPtr, NULL, NULL);
     iPtr->invokeCmdFramePtr = NULL;
-    codePtr = objPtr->internalRep.twoPtrValue.ptr1;
+    ByteCodeGetIntRep(objPtr, &tclByteCodeType, codePtr);
     if (iPtr->varFramePtr->localCachePtr) {
 	codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
 	codePtr->localCachePtr->refCount++;
@@ -3620,7 +3628,7 @@ TEBCresume(
 
 	    objPtr = varPtr->value.objPtr;
 	    if (GetNumberFromObj(NULL, objPtr, &ptr, &type) == TCL_OK) {
-		if (type == TCL_NUMBER_WIDE) {
+		if (type == TCL_NUMBER_INT) {
 		    Tcl_WideInt augend = *((const Tcl_WideInt *)ptr);
 		    Tcl_WideInt sum = augend + increment;
 
@@ -3662,7 +3670,7 @@ TEBCresume(
 			TclSetIntObj(objPtr, w+increment);
 		    }
 		    goto doneIncr;
-		}	/* end if (type == TCL_NUMBER_WIDE) */
+		}	/* end if (type == TCL_NUMBER_INT) */
 	    }
 	    if (Tcl_IsShared(objPtr)) {
 		objPtr->refCount--;	/* We know it's shared */
@@ -4760,8 +4768,8 @@ TEBCresume(
 	 */
 
 	if ((TclListObjGetElements(interp, valuePtr, &objc, &objv) == TCL_OK)
-		&& (value2Ptr->typePtr != &tclListType)
-		&& (TclGetIntForIndexM(NULL , value2Ptr, objc-1,
+		&& (NULL == Tcl_FetchIntRep(value2Ptr, &tclListType))
+		&& (TclGetIntForIndexM(NULL, value2Ptr, objc-1,
 			&index) == TCL_OK)) {
 	    TclDecrRefCount(value2Ptr);
 	    tosPtr--;
@@ -5631,22 +5639,13 @@ TEBCresume(
     case INST_NUM_TYPE:
 	if (GetNumberFromObj(NULL, OBJ_AT_TOS, &ptr1, &type1) != TCL_OK) {
 	    type1 = 0;
-	} else if (type1 == TCL_NUMBER_WIDE) {
-	    /* value is between WIDE_MIN and WIDE_MAX */
-	    /* [string is integer] is -UINT_MAX to UINT_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 WIDE_MIN to WIDE_MAX range */
-	    /* [string is wideinteger] is -UWIDE_MAX to UWIDE_MAX range */
+	    /* [string is wideinteger] is WIDE_MIN to WIDE_MAX range */
 	    Tcl_WideInt w;
 
 	    if (Tcl_GetWideIntFromObj(NULL, OBJ_AT_TOS, &w) == TCL_OK) {
-		type1 = TCL_NUMBER_WIDE;
+		type1 = TCL_NUMBER_INT;
 	    }
 	}
 	TclNewIntObj(objResultPtr, type1);
@@ -5692,7 +5691,7 @@ TEBCresume(
 	    compare = MP_EQ;
 	    goto convertComparison;
 	}
-	if ((type1 == TCL_NUMBER_WIDE) && (type2 == TCL_NUMBER_WIDE)) {
+	if ((type1 == TCL_NUMBER_INT) && (type2 == TCL_NUMBER_INT)) {
 	    w1 = *((const Tcl_WideInt *)ptr1);
 	    w2 = *((const Tcl_WideInt *)ptr2);
 	    compare = (w1 < w2) ? MP_LT : ((w1 > w2) ? MP_GT : MP_EQ);
@@ -5771,7 +5770,7 @@ TEBCresume(
 	 * Check for common, simple case.
 	 */
 
-	if ((type1 == TCL_NUMBER_WIDE) && (type2 == TCL_NUMBER_WIDE)) {
+	if ((type1 == TCL_NUMBER_INT) && (type2 == TCL_NUMBER_INT)) {
 	    w1 = *((const Tcl_WideInt *)ptr1);
 	    w2 = *((const Tcl_WideInt *)ptr2);
 
@@ -6011,7 +6010,7 @@ TEBCresume(
 	 * an external function.
 	 */
 
-	if ((type1 == TCL_NUMBER_WIDE) && (type2 == TCL_NUMBER_WIDE)) {
+	if ((type1 == TCL_NUMBER_INT) && (type2 == TCL_NUMBER_INT)) {
 	    w1 = *((const Tcl_WideInt *)ptr1);
 	    w2 = *((const Tcl_WideInt *)ptr2);
 
@@ -6154,7 +6153,7 @@ TEBCresume(
 	    CACHE_STACK_INFO();
 	    goto gotError;
 	}
-	if (type1 == TCL_NUMBER_WIDE) {
+	if (type1 == TCL_NUMBER_INT) {
 	    w1 = *((const Tcl_WideInt *) ptr1);
 	    if (Tcl_IsShared(valuePtr)) {
 		TclNewIntObj(objResultPtr, ~w1);
@@ -6191,7 +6190,7 @@ TEBCresume(
 	    /* -NaN => NaN */
 	    TRACE_APPEND(("%s\n", O2S(valuePtr)));
 	    NEXT_INST_F(1, 0, 0);
-	case TCL_NUMBER_WIDE:
+	case TCL_NUMBER_INT:
 	    w1 = *((const Tcl_WideInt *) ptr1);
 	    if (w1 != WIDE_MIN) {
 		if (Tcl_IsShared(valuePtr)) {
@@ -7113,13 +7112,16 @@ TEBCresume(
 	    TRACE_ERROR(interp);
 	    goto gotError;
 	}
-	TclNewObj(statePtr);
-	statePtr->typePtr = &dictIteratorType;
-	statePtr->internalRep.twoPtrValue.ptr1 = searchPtr;
-	statePtr->internalRep.twoPtrValue.ptr2 = dictPtr;
+	{
+	    Tcl_ObjIntRep ir;
+	    TclNewObj(statePtr);
+	    ir.twoPtrValue.ptr1 = searchPtr;
+	    ir.twoPtrValue.ptr2 = dictPtr;
+	    Tcl_StoreIntRep(statePtr, &dictIteratorType, &ir);
+	}
 	varPtr = LOCAL(opnd);
 	if (varPtr->value.objPtr) {
-	    if (varPtr->value.objPtr->typePtr == &dictIteratorType) {
+	    if (Tcl_FetchIntRep(varPtr->value.objPtr, &dictIteratorType)) {
 		Tcl_Panic("mis-issued dictFirst!");
 	    }
 	    TclDecrRefCount(varPtr->value.objPtr);
@@ -7132,11 +7134,17 @@ TEBCresume(
 	opnd = TclGetUInt4AtPtr(pc+1);
 	TRACE(("%u => ", opnd));
 	statePtr = (*LOCAL(opnd)).value.objPtr;
-	if (statePtr == NULL || statePtr->typePtr != &dictIteratorType) {
-	    Tcl_Panic("mis-issued dictNext!");
+	{
+	    const Tcl_ObjIntRep *irPtr;
+
+	    if (statePtr &&
+		    (irPtr = Tcl_FetchIntRep(statePtr, &dictIteratorType))) {
+		searchPtr = irPtr->twoPtrValue.ptr1;
+		Tcl_DictObjNext(searchPtr, &keyPtr, &valuePtr, &done);
+	    } else {
+		Tcl_Panic("mis-issued dictNext!");
+	    }
 	}
-	searchPtr = statePtr->internalRep.twoPtrValue.ptr1;
-	Tcl_DictObjNext(searchPtr, &keyPtr, &valuePtr, &done);
     pushDictIteratorResult:
 	if (done) {
 	    TclNewObj(emptyPtr);
@@ -7870,7 +7878,7 @@ ExecuteExtendedBinaryMathOp(
 	/* TODO: Attempts to re-use unshared operands on stack */
 
 	w2 = 0;			/* silence gcc warning */
-	if (type2 == TCL_NUMBER_WIDE) {
+	if (type2 == TCL_NUMBER_INT) {
 	    w2 = *((const Tcl_WideInt *)ptr2);
 	    if (w2 == 0) {
 		return DIVIDED_BY_ZERO;
@@ -7883,7 +7891,7 @@ ExecuteExtendedBinaryMathOp(
 		return constants[0];
 	    }
 	}
-	if (type1 == TCL_NUMBER_WIDE) {
+	if (type1 == TCL_NUMBER_INT) {
 	    w1 = *((const Tcl_WideInt *)ptr1);
 
 	    if (w1 == 0) {
@@ -7961,7 +7969,7 @@ ExecuteExtendedBinaryMathOp(
 	 */
 
 	switch (type2) {
-	case TCL_NUMBER_WIDE:
+	case TCL_NUMBER_INT:
 	    invalid = (*((const Tcl_WideInt *)ptr2) < (Tcl_WideInt)0);
 	    break;
 	case TCL_NUMBER_BIG:
@@ -7983,7 +7991,7 @@ ExecuteExtendedBinaryMathOp(
 	 * Zero shifted any number of bits is still zero.
 	 */
 
-	if ((type1==TCL_NUMBER_WIDE) && (*((const Tcl_WideInt *)ptr1) == (Tcl_WideInt)0)) {
+	if ((type1==TCL_NUMBER_INT) && (*((const Tcl_WideInt *)ptr1) == (Tcl_WideInt)0)) {
 	    return constants[0];
 	}
 
@@ -7996,7 +8004,7 @@ ExecuteExtendedBinaryMathOp(
 	     * counterparts, leading to incorrect results.
 	     */
 
-	    if ((type2 != TCL_NUMBER_WIDE)
+	    if ((type2 != TCL_NUMBER_INT)
 		    || (*((const Tcl_WideInt *)ptr2) > INT_MAX)) {
 		/*
 		 * Technically, we could hold the value (1 << (INT_MAX+1)) in
@@ -8029,7 +8037,7 @@ ExecuteExtendedBinaryMathOp(
 	     * Quickly force large right shifts to 0 or -1.
 	     */
 
-	    if ((type2 != TCL_NUMBER_WIDE)
+	    if ((type2 != TCL_NUMBER_INT)
 		    || (*(const Tcl_WideInt *)ptr2 > INT_MAX)) {
 		/*
 		 * Again, technically, the value to be shifted could be an
@@ -8040,7 +8048,7 @@ ExecuteExtendedBinaryMathOp(
 		 */
 
 		switch (type1) {
-		case TCL_NUMBER_WIDE:
+		case TCL_NUMBER_INT:
 		    zero = (*(const Tcl_WideInt *)ptr1 > (Tcl_WideInt)0);
 		    break;
 		case TCL_NUMBER_BIG:
@@ -8063,7 +8071,7 @@ ExecuteExtendedBinaryMathOp(
 	     * Handle shifts within the native wide range.
 	     */
 
-	    if (type1 == TCL_NUMBER_WIDE) {
+	    if (type1 == TCL_NUMBER_INT) {
 		w1 = *(const Tcl_WideInt *)ptr1;
 		if ((size_t)shift >= CHAR_BIT*sizeof(Tcl_WideInt)) {
 		    if (w1 >= (Tcl_WideInt)0) {
@@ -8240,7 +8248,7 @@ ExecuteExtendedBinaryMathOp(
 	    BIG_RESULT(&bigResult);
 	}
 
-	if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE)) {
+	if ((type1 == TCL_NUMBER_INT) || (type2 == TCL_NUMBER_INT)) {
 	    TclGetWideIntFromObj(NULL, valuePtr, &w1);
 	    TclGetWideIntFromObj(NULL, value2Ptr, &w2);
 
@@ -8294,7 +8302,7 @@ ExecuteExtendedBinaryMathOp(
 	    goto doubleResult;
 	}
 	w2 = 0;
-	if (type2 == TCL_NUMBER_WIDE) {
+	if (type2 == TCL_NUMBER_INT) {
 	    w2 = *((const Tcl_WideInt *) ptr2);
 	    if (w2 == 0) {
 		/*
@@ -8312,7 +8320,7 @@ ExecuteExtendedBinaryMathOp(
 	}
 
 	switch (type2) {
-	case TCL_NUMBER_WIDE:
+	case TCL_NUMBER_INT:
 	    w2 = *((const Tcl_WideInt *)ptr2);
 	    negativeExponent = (w2 < 0);
 	    oddExponent = (int) (w2 & (Tcl_WideInt)1);
@@ -8326,11 +8334,11 @@ ExecuteExtendedBinaryMathOp(
 	    break;
 	}
 
-	if (type1 == TCL_NUMBER_WIDE) {
+	if (type1 == TCL_NUMBER_INT) {
 	    w1 = *((const Tcl_WideInt *)ptr1);
 	}
 	if (negativeExponent) {
-	    if (type1 == TCL_NUMBER_WIDE) {
+	    if (type1 == TCL_NUMBER_INT) {
 		switch (w1) {
 		case 0:
 		    /*
@@ -8360,7 +8368,7 @@ ExecuteExtendedBinaryMathOp(
 	    return constants[0];
 	}
 
-	if (type1 == TCL_NUMBER_WIDE) {
+	if (type1 == TCL_NUMBER_INT) {
 	    switch (w1) {
 	    case 0:
 		/*
@@ -8387,17 +8395,17 @@ ExecuteExtendedBinaryMathOp(
 	 * which means the max exponent value is 2**28-1 = 0x0fffffff =
 	 * 268435455, which fits into a signed 32 bit int which is within the
 	 * range of the long int type. This means any numeric Tcl_Obj value
-	 * not using TCL_NUMBER_WIDE type must hold a value larger than we
+	 * not using TCL_NUMBER_INT type must hold a value larger than we
 	 * accept.
 	 */
 
-	if (type2 != TCL_NUMBER_WIDE) {
+	if (type2 != TCL_NUMBER_INT) {
 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		    "exponent too large", -1));
 	    return GENERAL_ARITHMETIC_ERROR;
 	}
 
-	if (type1 == TCL_NUMBER_WIDE) {
+	if (type1 == TCL_NUMBER_INT) {
 	    if (w1 == 2) {
 		/*
 		 * Reduce small powers of 2 to shifts.
@@ -8421,7 +8429,7 @@ ExecuteExtendedBinaryMathOp(
 		goto overflowExpon;
 	    }
 	}
-	if (type1 == TCL_NUMBER_WIDE) {
+	if (type1 == TCL_NUMBER_INT) {
 	    w1 = *((const Tcl_WideInt *) ptr1);
 	} else {
 	    goto overflowExpon;
@@ -8621,7 +8629,7 @@ ExecuteExtendedBinaryMathOp(
 	    switch (opcode) {
 	    case INST_ADD:
 		wResult = w1 + w2;
-		if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE))
+		if ((type1 == TCL_NUMBER_INT) || (type2 == TCL_NUMBER_INT))
 		{
 		    /*
 		     * Check for overflow.
@@ -8635,7 +8643,7 @@ ExecuteExtendedBinaryMathOp(
 
 	    case INST_SUB:
 		wResult = w1 - w2;
-		if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE))
+		if ((type1 == TCL_NUMBER_INT) || (type2 == TCL_NUMBER_INT))
 		{
 		    /*
 		     * Must check for overflow. The macro tests for overflows
@@ -8758,7 +8766,7 @@ ExecuteExtendedUnaryMathOp(
 
     switch (opcode) {
     case INST_BITNOT:
-	if (type == TCL_NUMBER_WIDE) {
+	if (type == TCL_NUMBER_INT) {
 	    w = *((const Tcl_WideInt *) ptr);
 	    WIDE_RESULT(~w);
 	}
@@ -8771,7 +8779,7 @@ ExecuteExtendedUnaryMathOp(
 	switch (type) {
 	case TCL_NUMBER_DOUBLE:
 	    DOUBLE_RESULT(-(*((const double *) ptr)));
-	case TCL_NUMBER_WIDE:
+	case TCL_NUMBER_INT:
 	    w = *((const Tcl_WideInt *) ptr);
 	    if (w != WIDE_MIN) {
 		WIDE_RESULT(-w);
@@ -8825,10 +8833,10 @@ TclCompareTwoNumbers(
     (void) GetNumberFromObj(NULL, value2Ptr, &ptr2, &type2);
 
     switch (type1) {
-    case TCL_NUMBER_WIDE:
+    case TCL_NUMBER_INT:
 	w1 = *((const Tcl_WideInt *)ptr1);
 	switch (type2) {
-	case TCL_NUMBER_WIDE:
+	case TCL_NUMBER_INT:
 	    w2 = *((const Tcl_WideInt *)ptr2);
 	wideCompare:
 	    return (w1 < w2) ? MP_LT : ((w1 > w2) ? MP_GT : MP_EQ);
@@ -8885,7 +8893,7 @@ TclCompareTwoNumbers(
 	    d2 = *((const double *)ptr2);
 	doubleCompare:
 	    return (d1 < d2) ? MP_LT : ((d1 > d2) ? MP_GT : MP_EQ);
-	case TCL_NUMBER_WIDE:
+	case TCL_NUMBER_INT:
 	    w2 = *((const Tcl_WideInt *)ptr2);
 	    d2 = (double) w2;
 	    if (DBL_MANT_DIG > CHAR_BIT*sizeof(Tcl_WideInt)
@@ -8927,7 +8935,7 @@ TclCompareTwoNumbers(
     case TCL_NUMBER_BIG:
 	Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
 	switch (type2) {
-	case TCL_NUMBER_WIDE:
+	case TCL_NUMBER_INT:
 	    compare = mp_cmp_d(&big1, 0);
 	    mp_clear(&big1);
 	    return compare;
@@ -9767,7 +9775,7 @@ EvalStatsCmd(
     for (i = 0;  i < globalTablePtr->numBuckets;  i++) {
 	for (entryPtr = globalTablePtr->buckets[i];  entryPtr != NULL;
 		entryPtr = entryPtr->nextPtr) {
-	    if (entryPtr->objPtr->typePtr == &tclByteCodeType) {
+	    if (NULL != Tcl_FetchIntRep(entryPtr->objPtr, &tclByteCodeType)) {
 		numByteCodeLits++;
 	    }
 	    (void) TclGetStringFromObj(entryPtr->objPtr, &length);

generic/tclGetDate.y

@@ -897,7 +897,7 @@ TclDatelex(
 
     location->first_column = yyInput - info->dateStart;
     for ( ; ; ) {
-	while (isspace(UCHAR(*yyInput))) {
+	while (TclIsSpaceProc(UCHAR(*yyInput))) {
 	    yyInput++;
 	}
 

generic/tclIO.c

@@ -337,6 +337,22 @@ static const Tcl_ObjType chanObjType = {
     NULL			/* setFromAnyProc */
 };
 
+#define ChanSetIntRep(objPtr, resPtr)					\
+    do {								\
+	Tcl_ObjIntRep ir;						\
+	(resPtr)->refCount++;						\
+	ir.twoPtrValue.ptr1 = (resPtr);					\
+	ir.twoPtrValue.ptr2 = NULL;					\
+	Tcl_StoreIntRep((objPtr), &chanObjType, &ir);			\
+    } while (0)
+
+#define ChanGetIntRep(objPtr, resPtr)					\
+    do {								\
+	const Tcl_ObjIntRep *irPtr;					\
+	irPtr = Tcl_FetchIntRep((objPtr), &chanObjType);		\
+	(resPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL;		\
+    } while (0)
+
 #define BUSY_STATE(st, fl) \
      ((((st)->csPtrR) && ((fl) & TCL_READABLE)) || \
       (((st)->csPtrW) && ((fl) & TCL_WRITABLE)))
@@ -1515,12 +1531,12 @@ TclGetChannelFromObj(
 	return TCL_ERROR;
     }
 
-    if (objPtr->typePtr == &chanObjType) {
+    ChanGetIntRep(objPtr, resPtr);
+    if (resPtr) {
 	/*
  	 * Confirm validity of saved lookup results.
  	 */
 
-	resPtr = (ResolvedChanName *) objPtr->internalRep.twoPtrValue.ptr1;
 	statePtr = resPtr->statePtr;
 	if ((resPtr->interp == interp)		/* Same interp context */
 			/* No epoch change in channel since lookup */
@@ -1537,7 +1553,7 @@ TclGetChannelFromObj(
 
     if (chan == NULL) {
 	if (resPtr) {
-	    FreeChannelIntRep(objPtr);
+	    Tcl_StoreIntRep(objPtr, &chanObjType, NULL);
 	}
 	return TCL_ERROR;
     }
@@ -1548,14 +1564,10 @@ TclGetChannelFromObj(
          */
 
 	Tcl_Release((ClientData) resPtr->statePtr);
-
     } else {
-	TclFreeIntRep(objPtr);
-
 	resPtr = (ResolvedChanName *) ckalloc(sizeof(ResolvedChanName));
-	resPtr->refCount = 1;
-	objPtr->internalRep.twoPtrValue.ptr1 = (ClientData) resPtr;
-	objPtr->typePtr = &chanObjType;
+	resPtr->refCount = 0;
+	ChanSetIntRep(objPtr, resPtr);		/* Overwrites, if needed */
     }
     statePtr = ((Channel *)chan)->state;
     resPtr->statePtr = statePtr;
@@ -11198,11 +11210,11 @@ DupChannelIntRep(
     register Tcl_Obj *copyPtr)	/* Object with internal rep to set. Must not
 				 * currently have an internal rep.*/
 {
-    ResolvedChanName *resPtr = srcPtr->internalRep.twoPtrValue.ptr1;
+    ResolvedChanName *resPtr;
 
-    resPtr->refCount++;
-    copyPtr->internalRep.twoPtrValue.ptr1 = resPtr;
-    copyPtr->typePtr = srcPtr->typePtr;
+    ChanGetIntRep(srcPtr, resPtr);
+    assert(resPtr);
+    ChanSetIntRep(copyPtr, resPtr);
 }
 
 /*
@@ -11225,9 +11237,10 @@ static void
 FreeChannelIntRep(
     Tcl_Obj *objPtr)		/* Object with internal rep to free. */
 {
-    ResolvedChanName *resPtr = objPtr->internalRep.twoPtrValue.ptr1;
+    ResolvedChanName *resPtr;
 
-    objPtr->typePtr = NULL;
+    ChanGetIntRep(objPtr, resPtr);
+    assert(resPtr);
     if (resPtr->refCount-- > 1) {
 	return;
     }

generic/tclIOCmd.c

@@ -991,7 +991,7 @@ Tcl_ExecObjCmd(
 
     resultPtr = Tcl_NewObj();
     if (Tcl_GetChannelHandle(chan, TCL_READABLE, NULL) == TCL_OK) {
-	if (Tcl_ReadChars(chan, resultPtr, -1, 0) < 0) {
+	if (Tcl_ReadChars(chan, resultPtr, -1, 0) == TCL_IO_FAILURE) {
 	    /*
 	     * TIP #219.
 	     * Capture error messages put by the driver into the bypass area

generic/tclIOUtil.c

@@ -1807,7 +1807,7 @@ Tcl_FSEvalFileEx(
      * be handled especially.
      */
 
-    if (Tcl_ReadChars(chan, objPtr, 1, 0) < 0) {
+    if (Tcl_ReadChars(chan, objPtr, 1, 0) == TCL_IO_FAILURE) {
 	Tcl_Close(interp, chan);
 	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
 		"couldn't read file \"%s\": %s",
@@ -1822,7 +1822,7 @@ Tcl_FSEvalFileEx(
      */
 
     if (Tcl_ReadChars(chan, objPtr, -1,
-	    memcmp(string, "\xef\xbb\xbf", 3)) < 0) {
+	    memcmp(string, "\xef\xbb\xbf", 3)) == TCL_IO_FAILURE) {
 	Tcl_Close(interp, chan);
 	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
 		"couldn't read file \"%s\": %s",
@@ -1942,7 +1942,7 @@ TclNREvalFile(
      * be handled especially.
      */
 
-    if (Tcl_ReadChars(chan, objPtr, 1, 0) < 0) {
+    if (Tcl_ReadChars(chan, objPtr, 1, 0) == TCL_IO_FAILURE) {
 	Tcl_Close(interp, chan);
 	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
 		"couldn't read file \"%s\": %s",
@@ -1958,7 +1958,7 @@ TclNREvalFile(
      */
 
     if (Tcl_ReadChars(chan, objPtr, -1,
-	    memcmp(string, "\xef\xbb\xbf", 3)) < 0) {
+	    memcmp(string, "\xef\xbb\xbf", 3)) == TCL_IO_FAILURE) {
 	Tcl_Close(interp, chan);
 	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
 		"couldn't read file \"%s\": %s",

generic/tclIndexObj.c

@@ -115,14 +115,18 @@ Tcl_GetIndexFromObj(
     int flags,			/* 0 or TCL_EXACT */
     int *indexPtr)		/* Place to store resulting integer index. */
 {
+    if (!(flags & INDEX_TEMP_TABLE)) {
+
     /*
      * See if there is a valid cached result from a previous lookup (doing the
      * check here saves the overhead of calling Tcl_GetIndexFromObjStruct in
      * the common case where the result is cached).
      */
 
-    if (!(flags & INDEX_TEMP_TABLE) && objPtr->typePtr == &indexType) {
-	IndexRep *indexRep = objPtr->internalRep.twoPtrValue.ptr1;
+    const Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(objPtr, &indexType);
+
+    if (irPtr) {
+	IndexRep *indexRep = irPtr->twoPtrValue.ptr1;
 
 	/*
 	 * Here's hoping we don't get hit by unfortunate packing constraints
@@ -135,6 +139,7 @@ Tcl_GetIndexFromObj(
 	    return TCL_OK;
 	}
     }
+    }
     return Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, sizeof(char *),
 	    msg, flags, indexPtr);
 }
@@ -266,6 +271,7 @@ Tcl_GetIndexFromObjStruct(
     const char *const *entryPtr;
     Tcl_Obj *resultPtr;
     IndexRep *indexRep;
+    const Tcl_ObjIntRep *irPtr;
 
     /* Protect against invalid values, like -1 or 0. */
     if (offset < (int)sizeof(char *)) {
@@ -275,13 +281,16 @@ Tcl_GetIndexFromObjStruct(
      * See if there is a valid cached result from a previous lookup.
      */
 
-    if (!(flags & INDEX_TEMP_TABLE) && objPtr->typePtr == &indexType) {
-	indexRep = objPtr->internalRep.twoPtrValue.ptr1;
+    if (!(flags & INDEX_TEMP_TABLE)) {
+    irPtr = Tcl_FetchIntRep(objPtr, &indexType);
+    if (irPtr) {
+	indexRep = irPtr->twoPtrValue.ptr1;
 	if (indexRep->tablePtr==tablePtr && indexRep->offset==offset) {
 	    *indexPtr = indexRep->index;
 	    return TCL_OK;
 	}
     }
+    }
 
     /*
      * Lookup the value of the object in the table. Accept unique
@@ -337,17 +346,19 @@ Tcl_GetIndexFromObjStruct(
      */
 
     if (!(flags & INDEX_TEMP_TABLE)) {
-	if (objPtr->typePtr == &indexType) {
-	    indexRep = objPtr->internalRep.twoPtrValue.ptr1;
-	} else {
-	    TclFreeIntRep(objPtr);
-	    indexRep = ckalloc(sizeof(IndexRep));
-	    objPtr->internalRep.twoPtrValue.ptr1 = indexRep;
-	    objPtr->typePtr = &indexType;
-	}
-	indexRep->tablePtr = (void *) tablePtr;
-	indexRep->offset = offset;
-	indexRep->index = index;
+    irPtr = Tcl_FetchIntRep(objPtr, &indexType);
+    if (irPtr) {
+	indexRep = irPtr->twoPtrValue.ptr1;
+    } else {
+	Tcl_ObjIntRep ir;
+
+	indexRep = ckalloc(sizeof(IndexRep));
+	ir.twoPtrValue.ptr1 = indexRep;
+	Tcl_StoreIntRep(objPtr, &indexType, &ir);
+    }
+    indexRep->tablePtr = (void *) tablePtr;
+    indexRep->offset = offset;
+    indexRep->index = index;
     }
 
     *indexPtr = index;
@@ -446,16 +457,10 @@ static void
 UpdateStringOfIndex(
     Tcl_Obj *objPtr)
 {
-    IndexRep *indexRep = objPtr->internalRep.twoPtrValue.ptr1;
-    register char *buf;
-    register unsigned len;
+    IndexRep *indexRep = Tcl_FetchIntRep(objPtr, &indexType)->twoPtrValue.ptr1;
     register const char *indexStr = EXPAND_OF(indexRep);
 
-    len = strlen(indexStr);
-    buf = ckalloc(len + 1);
-    memcpy(buf, indexStr, len+1);
-    objPtr->bytes = buf;
-    objPtr->length = len;
+    Tcl_InitStringRep(objPtr, indexStr, strlen(indexStr));
 }
 
 /*
@@ -481,12 +486,14 @@ DupIndex(
     Tcl_Obj *srcPtr,
     Tcl_Obj *dupPtr)
 {
-    IndexRep *srcIndexRep = srcPtr->internalRep.twoPtrValue.ptr1;
+    Tcl_ObjIntRep ir;
     IndexRep *dupIndexRep = ckalloc(sizeof(IndexRep));
 
-    memcpy(dupIndexRep, srcIndexRep, sizeof(IndexRep));
-    dupPtr->internalRep.twoPtrValue.ptr1 = dupIndexRep;
-    dupPtr->typePtr = &indexType;
+    memcpy(dupIndexRep, Tcl_FetchIntRep(srcPtr, &indexType)->twoPtrValue.ptr1,
+	    sizeof(IndexRep));
+
+    ir.twoPtrValue.ptr1 = dupIndexRep;
+    Tcl_StoreIntRep(dupPtr, &indexType, &ir);
 }
 
 /*
@@ -510,7 +517,7 @@ static void
 FreeIndex(
     Tcl_Obj *objPtr)
 {
-    ckfree(objPtr->internalRep.twoPtrValue.ptr1);
+    ckfree(Tcl_FetchIntRep(objPtr, &indexType)->twoPtrValue.ptr1);
     objPtr->typePtr = NULL;
 }
 
@@ -957,10 +964,10 @@ Tcl_WrongNumArgs(
 	    /*
 	     * Add the element, quoting it if necessary.
 	     */
+	    const Tcl_ObjIntRep *irPtr;
 
-	    if (origObjv[i]->typePtr == &indexType) {
-		register IndexRep *indexRep =
-			origObjv[i]->internalRep.twoPtrValue.ptr1;
+	    if ((irPtr = Tcl_FetchIntRep(origObjv[i], &indexType))) {
+		register IndexRep *indexRep = irPtr->twoPtrValue.ptr1;
 
 		elementStr = EXPAND_OF(indexRep);
 		elemLen = strlen(elementStr);
@@ -1007,9 +1014,10 @@ Tcl_WrongNumArgs(
 	 * the correct error message even if the subcommand was abbreviated.
 	 * Otherwise, just use the string rep.
 	 */
+	const Tcl_ObjIntRep *irPtr;
 
-	if (objv[i]->typePtr == &indexType) {
-	    register IndexRep *indexRep = objv[i]->internalRep.twoPtrValue.ptr1;
+	if ((irPtr = Tcl_FetchIntRep(objv[i], &indexType))) {
+	    register IndexRep *indexRep = irPtr->twoPtrValue.ptr1;
 
 	    Tcl_AppendStringsToObj(objPtr, EXPAND_OF(indexRep), NULL);
 	} else {

generic/tclInt.h

@@ -120,19 +120,19 @@ typedef int ptrdiff_t;
 #if !defined(INT2PTR) && !defined(PTR2INT)
 #   if defined(HAVE_INTPTR_T) || defined(intptr_t)
 #	define INT2PTR(p) ((void *)(intptr_t)(p))
-#	define PTR2INT(p) ((int)(intptr_t)(p))
+#	define PTR2INT(p) ((intptr_t)(p))
 #   else
 #	define INT2PTR(p) ((void *)(p))
-#	define PTR2INT(p) ((int)(p))
+#	define PTR2INT(p) ((long)(p))
 #   endif
 #endif
 #if !defined(UINT2PTR) && !defined(PTR2UINT)
 #   if defined(HAVE_UINTPTR_T) || defined(uintptr_t)
 #	define UINT2PTR(p) ((void *)(uintptr_t)(p))
-#	define PTR2UINT(p) ((unsigned int)(uintptr_t)(p))
+#	define PTR2UINT(p) ((uintptr_t)(p))
 #   else
 #	define UINT2PTR(p) ((void *)(p))
-#	define PTR2UINT(p) ((unsigned int)(p))
+#	define PTR2UINT(p) ((unsigned long)(p))
 #   endif
 #endif
 
@@ -2363,6 +2363,13 @@ typedef struct Interp {
 
 #define TCL_ALIGN(x) (((int)(x) + 7) & ~7)
 
+/*
+ * A common panic alert when memory allocation fails.
+ */
+
+#define TclOOM(ptr, size) \
+	((size) && ((ptr)||(Tcl_Panic("unable to alloc %u bytes", (size)),1)))
+
 /*
  * The following enum values are used to specify the runtime platform setting
  * of the tclPlatform variable.
@@ -2437,12 +2444,6 @@ typedef struct List {
 #define ListRepPtr(listPtr) \
     ((List *) (listPtr)->internalRep.twoPtrValue.ptr1)
 
-#define ListSetIntRep(objPtr, listRepPtr) \
-    (objPtr)->internalRep.twoPtrValue.ptr1 = (void *)(listRepPtr), \
-    (objPtr)->internalRep.twoPtrValue.ptr2 = NULL, \
-    (listRepPtr)->refCount++, \
-    (objPtr)->typePtr = &tclListType
-
 #define ListObjGetElements(listPtr, objc, objv) \
     ((objv) = &(ListRepPtr(listPtr)->elements), \
      (objc) = ListRepPtr(listPtr)->elemCount)
@@ -2497,16 +2498,16 @@ typedef struct List {
 #else
 #define TclGetLongFromObj(interp, objPtr, longPtr) \
     (((objPtr)->typePtr == &tclIntType \
-	    && (objPtr)->internalRep.wideValue >= -(Tcl_WideInt)(ULONG_MAX) \
-	    && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(ULONG_MAX))	\
+	    && (objPtr)->internalRep.wideValue >= (Tcl_WideInt)(LONG_MIN) \
+	    && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(LONG_MAX))	\
 	    ? ((*(longPtr) = (long)(objPtr)->internalRep.wideValue), TCL_OK) \
 	    : Tcl_GetLongFromObj((interp), (objPtr), (longPtr)))
 #endif
 
 #define TclGetIntFromObj(interp, objPtr, intPtr) \
     (((objPtr)->typePtr == &tclIntType \
-	    && (objPtr)->internalRep.wideValue >= -(Tcl_WideInt)(UINT_MAX) \
-	    && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(UINT_MAX))	\
+	    && (objPtr)->internalRep.wideValue >= (Tcl_WideInt)(INT_MIN) \
+	    && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(INT_MAX))	\
 	    ? ((*(intPtr) = (int)(objPtr)->internalRep.wideValue), TCL_OK) \
 	    : Tcl_GetIntFromObj((interp), (objPtr), (intPtr)))
 #define TclGetIntForIndexM(interp, objPtr, endValue, idxPtr) \
@@ -2709,8 +2710,11 @@ typedef struct ProcessGlobalValue {
  *----------------------------------------------------------------------
  */
 
-#define TCL_NUMBER_LONG		1
-#define TCL_NUMBER_WIDE		2
+#define TCL_NUMBER_INT		2
+#if (TCL_MAJOR_VERSION < 9) && !defined(TCL_NO_DEPRECATED)
+#   define TCL_NUMBER_LONG		1 /* deprecated, not used any more */
+#   define TCL_NUMBER_WIDE		TCL_NUMBER_INT /* deprecated */
+#endif
 #define TCL_NUMBER_BIG		3
 #define TCL_NUMBER_DOUBLE	4
 #define TCL_NUMBER_NAN		5
@@ -2747,7 +2751,6 @@ MODULE_SCOPE const Tcl_ObjType tclBooleanType;
 MODULE_SCOPE const Tcl_ObjType tclByteArrayType;
 MODULE_SCOPE const Tcl_ObjType tclByteCodeType;
 MODULE_SCOPE const Tcl_ObjType tclDoubleType;
-MODULE_SCOPE const Tcl_ObjType tclEndOffsetType;
 MODULE_SCOPE const Tcl_ObjType tclIntType;
 MODULE_SCOPE const Tcl_ObjType tclListType;
 MODULE_SCOPE const Tcl_ObjType tclDictType;
@@ -3027,6 +3030,8 @@ MODULE_SCOPE int	TclGetChannelFromObj(Tcl_Interp *interp,
 MODULE_SCOPE CmdFrame *	TclGetCmdFrameForProcedure(Proc *procPtr);
 MODULE_SCOPE int	TclGetCompletionCodeFromObj(Tcl_Interp *interp,
 			    Tcl_Obj *value, int *code);
+MODULE_SCOPE Proc *	TclGetLambdaFromObj(Tcl_Interp *interp,
+			    Tcl_Obj *objPtr, Tcl_Obj **nsObjPtrPtr);
 MODULE_SCOPE int	TclGetNumberFromObj(Tcl_Interp *interp,
 			    Tcl_Obj *objPtr, ClientData *clientDataPtr,
 			    int *typePtr);
@@ -3360,7 +3365,6 @@ MODULE_SCOPE int	TclNRAssembleObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
 MODULE_SCOPE Tcl_Command TclInitEncodingCmd(Tcl_Interp *interp);
-MODULE_SCOPE int	TclMakeEncodingCommandSafe(Tcl_Interp *interp);
 MODULE_SCOPE int	Tcl_EofObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
@@ -3389,7 +3393,6 @@ MODULE_SCOPE int	Tcl_FcopyObjCmd(ClientData dummy,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
 MODULE_SCOPE Tcl_Command TclInitFileCmd(Tcl_Interp *interp);
-MODULE_SCOPE int	TclMakeFileCommandSafe(Tcl_Interp *interp);
 MODULE_SCOPE int	Tcl_FileEventObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
@@ -4420,7 +4423,7 @@ MODULE_SCOPE void	TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
 	(objPtr)->length = 0; \
     } else { \
 	(objPtr)->bytes = (char *) ckalloc((unsigned) ((len) + 1)); \
-	memcpy((objPtr)->bytes, (bytePtr), (unsigned) (len)); \
+	memcpy((objPtr)->bytes, (bytePtr) ? (bytePtr) : &tclEmptyString, (unsigned) (len)); \
 	(objPtr)->bytes[len] = '\0'; \
 	(objPtr)->length = (len); \
     }
@@ -4480,6 +4483,18 @@ MODULE_SCOPE void	TclDbInitNewObj(Tcl_Obj *objPtr, const char *file,
 	(objPtr)->bytes = NULL; \
     }
 
+/*
+ *----------------------------------------------------------------
+ * Macro used by the Tcl core to test whether an object has a
+ * string representation (or is a 'pure' internal value).
+ * The ANSI C "prototype" for this macro is:
+ *
+ * MODULE_SCOPE int	TclHasStringRep(Tcl_Obj *objPtr);
+ *----------------------------------------------------------------
+ */
+
+#define TclHasStringRep(objPtr) ((objPtr)->bytes != NULL)
+
 /*
  *----------------------------------------------------------------
  * Macros used by the Tcl core to grow Tcl_Token arrays. They use the same
@@ -4699,18 +4714,18 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit;
 
 #define TclSetIntObj(objPtr, i) \
     do {						\
+	Tcl_ObjIntRep ir;				\
+	ir.wideValue = (Tcl_WideInt) i;			\
 	TclInvalidateStringRep(objPtr);			\
-	TclFreeIntRep(objPtr);				\
-	(objPtr)->internalRep.wideValue = (Tcl_WideInt)(i);	\
-	(objPtr)->typePtr = &tclIntType;		\
+	Tcl_StoreIntRep(objPtr, &tclIntType, &ir);	\
     } while (0)
 
 #define TclSetDoubleObj(objPtr, d) \
-    do {							\
-	TclInvalidateStringRep(objPtr);				\
-	TclFreeIntRep(objPtr);					\
-	(objPtr)->internalRep.doubleValue = (double)(d);	\
-	(objPtr)->typePtr = &tclDoubleType;			\
+    do {						\
+	Tcl_ObjIntRep ir;				\
+	ir.doubleValue = (double) d;			\
+	TclInvalidateStringRep(objPtr);			\
+	Tcl_StoreIntRep(objPtr, &tclDoubleType, &ir);	\
     } while (0)
 
 /*

generic/tclInterp.c

@@ -397,7 +397,6 @@ 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"
@@ -410,6 +409,7 @@ Tcl_Init(
 "	} else {\n"
 "	    lappend scripts {::tcl::pkgconfig get scriptdir,runtime}\n"
 "	}\n"
+"	lappend scripts {::tcl::zipfs::tcl_library_init}\n"
 "	lappend scripts {\n"
 "set parentDir [file dirname [file dirname [info nameofexecutable]]]\n"
 "set grandParentDir [file dirname $parentDir]\n"
@@ -1826,7 +1826,7 @@ AliasNRCmd(
     cmdc = prefc + objc - 1;
 
     listPtr = Tcl_NewListObj(cmdc, NULL);
-    listRep = listPtr->internalRep.twoPtrValue.ptr1;
+    listRep = ListRepPtr(listPtr);
     listRep->elemCount = cmdc;
     cmdv = &listRep->elements;
 

generic/tclLink.c

@@ -416,7 +416,8 @@ LinkTraceProc(
     case TCL_LINK_DOUBLE:
 	if (Tcl_GetDoubleFromObj(NULL, valueObj, &linkPtr->lastValue.d) != TCL_OK) {
 #ifdef ACCEPT_NAN
-	    if (valueObj->typePtr != &tclDoubleType) {
+	    Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(valueObj, &tclDoubleType);
+	    if (irPtr == NULL) {
 #endif
 		if (GetInvalidDoubleFromObj(valueObj, &linkPtr->lastValue.d) != TCL_OK) {
 		    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
@@ -425,7 +426,7 @@ LinkTraceProc(
 		}
 #ifdef ACCEPT_NAN
 	    }
-	    linkPtr->lastValue.d = valueObj->internalRep.doubleValue;
+	    linkPtr->lastValue.d = irPtr->doubleValue;
 #endif
 	}
 	LinkedVar(double) = linkPtr->lastValue.d;

generic/tclListObj.c

@@ -12,6 +12,7 @@
  */
 
 #include "tclInt.h"
+#include <assert.h>
 
 /*
  * Prototypes for functions defined later in this file:
@@ -46,6 +47,27 @@ const Tcl_ObjType tclListType = {
     SetListFromAny		/* setFromAnyProc */
 };
 
+/* Macros to manipulate the List internal rep */
+
+#define ListSetIntRep(objPtr, listRepPtr)				\
+    do {								\
+	Tcl_ObjIntRep ir;						\
+	ir.twoPtrValue.ptr1 = (listRepPtr);				\
+	ir.twoPtrValue.ptr2 = NULL;					\
+	(listRepPtr)->refCount++;					\
+	Tcl_StoreIntRep((objPtr), &tclListType, &ir);			\
+    } while (0)
+
+#define ListGetIntRep(objPtr, listRepPtr)				\
+    do {								\
+	const Tcl_ObjIntRep *irPtr;					\
+	irPtr = Tcl_FetchIntRep((objPtr), &tclListType);		\
+	(listRepPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL;		\
+    } while (0)
+
+#define ListResetIntRep(objPtr, listRepPtr) \
+    Tcl_FetchIntRep((objPtr), &tclListType)->twoPtrValue.ptr1 = (listRepPtr)
+
 #ifndef TCL_MIN_ELEMENT_GROWTH
 #define TCL_MIN_ELEMENT_GROWTH TCL_MIN_GROWTH/sizeof(Tcl_Obj *)
 #endif
@@ -374,8 +396,7 @@ Tcl_SetListObj(
 	listRepPtr = NewListIntRep(objc, objv, 1);
 	ListSetIntRep(objPtr, listRepPtr);
     } else {
-	objPtr->bytes = &tclEmptyString;
-	objPtr->length = 0;
+	Tcl_InitStringRep(objPtr, NULL, 0);
     }
 }
 
@@ -407,8 +428,10 @@ TclListObjCopy(
 				 * to be returned. */
 {
     Tcl_Obj *copyPtr;
+    List *listRepPtr;
 
-    if (listPtr->typePtr != &tclListType) {
+    ListGetIntRep(listPtr, listRepPtr);
+    if (NULL == listRepPtr) {
 	if (SetListFromAny(interp, listPtr) != TCL_OK) {
 	    return NULL;
 	}
@@ -543,10 +566,13 @@ Tcl_ListObjGetElements(
 {
     register List *listRepPtr;
 
-    if (listPtr->typePtr != &tclListType) {
-	int result;
+    ListGetIntRep(listPtr, listRepPtr);
 
-	if (listPtr->bytes == &tclEmptyString) {
+    if (listRepPtr == NULL) {
+	int result, length;
+
+	(void) Tcl_GetStringFromObj(listPtr, &length);
+	if (length == 0) {
 	    *objcPtr = 0;
 	    *objvPtr = NULL;
 	    return TCL_OK;
@@ -555,8 +581,8 @@ Tcl_ListObjGetElements(
 	if (result != TCL_OK) {
 	    return result;
 	}
+	ListGetIntRep(listPtr, listRepPtr);
     }
-    listRepPtr = ListRepPtr(listPtr);
     *objcPtr = listRepPtr->elemCount;
     *objvPtr = &listRepPtr->elements;
     return TCL_OK;
@@ -653,10 +679,13 @@ Tcl_ListObjAppendElement(
     if (Tcl_IsShared(listPtr)) {
 	Tcl_Panic("%s called with shared object", "Tcl_ListObjAppendElement");
     }
-    if (listPtr->typePtr != &tclListType) {
-	int result;
 
-	if (listPtr->bytes == &tclEmptyString) {
+    ListGetIntRep(listPtr, listRepPtr);
+    if (listRepPtr == NULL) {
+	int result, length;
+
+	(void) Tcl_GetStringFromObj(listPtr, &length);
+	if (length == 0) {
 	    Tcl_SetListObj(listPtr, 1, &objPtr);
 	    return TCL_OK;
 	}
@@ -664,9 +693,9 @@ Tcl_ListObjAppendElement(
 	if (result != TCL_OK) {
 	    return result;
 	}
+	ListGetIntRep(listPtr, listRepPtr);
     }
 
-    listRepPtr = ListRepPtr(listPtr);
     numElems = listRepPtr->elemCount;
     numRequired = numElems + 1 ;
     needGrow = (numRequired > listRepPtr->maxElemCount);
@@ -762,7 +791,11 @@ Tcl_ListObjAppendElement(
 	}
 	listRepPtr = newPtr;
     }
-    listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr;
+    ListResetIntRep(listPtr, listRepPtr);
+    listRepPtr->refCount++;
+    TclFreeIntRep(listPtr);
+    ListSetIntRep(listPtr, listRepPtr);
+    listRepPtr->refCount--;
 
     /*
      * Add objPtr to the end of listPtr's array of element pointers. Increment
@@ -817,10 +850,12 @@ Tcl_ListObjIndex(
 {
     register List *listRepPtr;
 
-    if (listPtr->typePtr != &tclListType) {
-	int result;
+    ListGetIntRep(listPtr, listRepPtr);
+    if (listRepPtr == NULL) {
+	int result, length;
 
-	if (listPtr->bytes == &tclEmptyString) {
+	(void) Tcl_GetStringFromObj(listPtr, &length);
+	if (length == 0) {
 	    *objPtrPtr = NULL;
 	    return TCL_OK;
 	}
@@ -828,9 +863,9 @@ Tcl_ListObjIndex(
 	if (result != TCL_OK) {
 	    return result;
 	}
+	ListGetIntRep(listPtr, listRepPtr);
     }
 
-    listRepPtr = ListRepPtr(listPtr);
     if ((index < 0) || (index >= listRepPtr->elemCount)) {
 	*objPtrPtr = NULL;
     } else {
@@ -870,10 +905,12 @@ Tcl_ListObjLength(
 {
     register List *listRepPtr;
 
-    if (listPtr->typePtr != &tclListType) {
-	int result;
+    ListGetIntRep(listPtr, listRepPtr);
+    if (listRepPtr == NULL) {
+	int result, length;
 
-	if (listPtr->bytes == &tclEmptyString) {
+	(void) Tcl_GetStringFromObj(listPtr, &length);
+	if (length == 0) {
 	    *intPtr = 0;
 	    return TCL_OK;
 	}
@@ -881,9 +918,9 @@ Tcl_ListObjLength(
 	if (result != TCL_OK) {
 	    return result;
 	}
+	ListGetIntRep(listPtr, listRepPtr);
     }
 
-    listRepPtr = ListRepPtr(listPtr);
     *intPtr = listRepPtr->elemCount;
     return TCL_OK;
 }
@@ -943,9 +980,14 @@ Tcl_ListObjReplace(
     if (Tcl_IsShared(listPtr)) {
 	Tcl_Panic("%s called with shared object", "Tcl_ListObjReplace");
     }
-    if (listPtr->typePtr != &tclListType) {
-	if (listPtr->bytes == &tclEmptyString) {
-	    if (!objc) {
+
+    ListGetIntRep(listPtr, listRepPtr);
+    if (listRepPtr == NULL) {
+	int length;
+
+	(void) Tcl_GetStringFromObj(listPtr, &length);
+	if (length == 0) {
+	    if (objc == 0) {
 		return TCL_OK;
 	    }
 	    Tcl_SetListObj(listPtr, objc, NULL);
@@ -956,6 +998,7 @@ Tcl_ListObjReplace(
 		return result;
 	    }
 	}
+	ListGetIntRep(listPtr, listRepPtr);
     }
 
     /*
@@ -966,7 +1009,6 @@ Tcl_ListObjReplace(
      * Resist any temptation to optimize this case.
      */
 
-    listRepPtr = ListRepPtr(listPtr);
     elemPtrs = &listRepPtr->elements;
     numElems = listRepPtr->elemCount;
 
@@ -1020,7 +1062,7 @@ Tcl_ListObjReplace(
 	}
 	if (newPtr) {
 	    listRepPtr = newPtr;
-	    listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr;
+	    ListResetIntRep(listPtr, listRepPtr);
 	    elemPtrs = &listRepPtr->elements;
 	    listRepPtr->maxElemCount = attempt;
 	    needGrow = numRequired > listRepPtr->maxElemCount;
@@ -1093,7 +1135,7 @@ Tcl_ListObjReplace(
 	    }
 	}
 
-	listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr;
+	ListResetIntRep(listPtr, listRepPtr);
 	listRepPtr->refCount++;
 
 	elemPtrs = &listRepPtr->elements;
@@ -1166,10 +1208,15 @@ Tcl_ListObjReplace(
     listRepPtr->elemCount = numRequired;
 
     /*
-     * Invalidate and free any old string representation since it no longer
-     * reflects the list's internal representation.
+     * Invalidate and free any old representations that may not agree
+     * with the revised list's internal representation.
      */
 
+    listRepPtr->refCount++;
+    TclFreeIntRep(listPtr);
+    ListSetIntRep(listPtr, listRepPtr);
+    listRepPtr->refCount--;
+
     TclInvalidateStringRep(listPtr);
     return TCL_OK;
 }
@@ -1208,6 +1255,7 @@ TclLindexList(
 
     int index;			/* Index into the list. */
     Tcl_Obj *indexListCopy;
+    List *listRepPtr;
 
     /*
      * Determine whether argPtr designates a list or a single index. We have
@@ -1215,7 +1263,8 @@ TclLindexList(
      * shimmering; see TIP#22 and TIP#33 for the details.
      */
 
-    if (argPtr->typePtr != &tclListType
+    ListGetIntRep(argPtr, listRepPtr);
+    if ((listRepPtr == NULL)
 	    && TclGetIntForIndexM(NULL , argPtr, 0, &index) == TCL_OK) {
 	/*
 	 * argPtr designates a single index.
@@ -1246,13 +1295,12 @@ TclLindexList(
 	return TclLindexFlat(interp, listPtr, 1, &argPtr);
     }
 
-    {
-	int indexCount = -1;		/* Size of the array of list indices. */
-	Tcl_Obj **indices = NULL; 	/* Array of list indices. */
+    ListGetIntRep(indexListCopy, listRepPtr);
 
-	TclListObjGetElements(NULL, indexListCopy, &indexCount, &indices);
-	listPtr = TclLindexFlat(interp, listPtr, indexCount, indices);
-    }
+    assert(listRepPtr != NULL);
+
+    listPtr = TclLindexFlat(interp, listPtr, listRepPtr->elemCount,
+		&listRepPtr->elements);
     Tcl_DecrRefCount(indexListCopy);
     return listPtr;
 }
@@ -1387,6 +1435,7 @@ TclLsetList(
     Tcl_Obj *retValuePtr;	/* Pointer to the list to be returned. */
     int index;			/* Current index in the list - discarded. */
     Tcl_Obj *indexListCopy;
+    List *listRepPtr;
 
     /*
      * Determine whether the index arg designates a list or a single index.
@@ -1394,7 +1443,8 @@ TclLsetList(
      * shimmering; see TIP #22 and #23 for details.
      */
 
-    if (indexArgPtr->typePtr != &tclListType
+    ListGetIntRep(indexArgPtr, listRepPtr);
+    if (listRepPtr == NULL
 	    && TclGetIntForIndexM(NULL, indexArgPtr, 0, &index) == TCL_OK) {
 	/*
 	 * indexArgPtr designates a single index.
@@ -1479,6 +1529,7 @@ TclLsetFlat(
 {
     int index, result, len;
     Tcl_Obj *subListPtr, *retValuePtr, *chainPtr;
+    Tcl_ObjIntRep *irPtr;
 
     /*
      * If there are no indices, simply return the new value.  (Without
@@ -1609,7 +1660,8 @@ TclLsetFlat(
 	     * them at that time.
 	     */
 
-	    parentList->internalRep.twoPtrValue.ptr2 = chainPtr;
+	    irPtr = Tcl_FetchIntRep(parentList, &tclListType);
+	    irPtr->twoPtrValue.ptr2 = chainPtr;
 	    chainPtr = parentList;
 	}
     } while (indexCount > 0);
@@ -1623,22 +1675,32 @@ TclLsetFlat(
 
     while (chainPtr) {
 	Tcl_Obj *objPtr = chainPtr;
-
-	if (result == TCL_OK) {
-	    /*
-	     * We're going to store valuePtr, so spoil string reps of all
-	     * containing lists.
-	     */
-
-	    TclInvalidateStringRep(objPtr);
-	}
+	List *listRepPtr;
 
 	/*
 	 * Clear away our intrep surgery mess.
 	 */
 
-	chainPtr = objPtr->internalRep.twoPtrValue.ptr2;
-	objPtr->internalRep.twoPtrValue.ptr2 = NULL;
+	irPtr = Tcl_FetchIntRep(objPtr, &tclListType);
+	listRepPtr = irPtr->twoPtrValue.ptr1;
+	chainPtr = irPtr->twoPtrValue.ptr2;
+	
+	if (result == TCL_OK) {
+
+	    /*
+	     * We're going to store valuePtr, so spoil string reps of all
+	     * containing lists.
+	     */
+
+	    listRepPtr->refCount++;
+	    TclFreeIntRep(objPtr);
+	    ListSetIntRep(objPtr, listRepPtr);
+	    listRepPtr->refCount--;
+
+	    TclInvalidateStringRep(objPtr);
+	} else {
+	    irPtr->twoPtrValue.ptr2 = NULL;
+	}
     }
 
     if (result != TCL_OK) {
@@ -1665,8 +1727,8 @@ TclLsetFlat(
 	Tcl_ListObjAppendElement(NULL, subListPtr, valuePtr);
     } else {
 	TclListObjSetElement(NULL, subListPtr, index, valuePtr);
+	TclInvalidateStringRep(subListPtr);
     }
-    TclInvalidateStringRep(subListPtr);
     Tcl_IncrRefCount(retValuePtr);
     return retValuePtr;
 }
@@ -1722,10 +1784,13 @@ TclListObjSetElement(
     if (Tcl_IsShared(listPtr)) {
 	Tcl_Panic("%s called with shared object", "TclListObjSetElement");
     }
-    if (listPtr->typePtr != &tclListType) {
-	int result;
 
-	if (listPtr->bytes == &tclEmptyString) {
+    ListGetIntRep(listPtr, listRepPtr);
+    if (listRepPtr == NULL) {
+	int result, length;
+
+	(void) Tcl_GetStringFromObj(listPtr, &length);
+	if (length == 0) {
 	    if (interp != NULL) {
 		Tcl_SetObjResult(interp,
 			Tcl_NewStringObj("list index out of range", -1));
@@ -1738,9 +1803,9 @@ TclListObjSetElement(
 	if (result != TCL_OK) {
 	    return result;
 	}
+	ListGetIntRep(listPtr, listRepPtr);
     }
 
-    listRepPtr = ListRepPtr(listPtr);
     elemCount = listRepPtr->elemCount;
 
     /*
@@ -1783,7 +1848,8 @@ TclListObjSetElement(
 
 	listRepPtr->refCount--;
 
-	listPtr->internalRep.twoPtrValue.ptr1 = listRepPtr = newPtr;
+	listRepPtr = newPtr;
+	ListResetIntRep(listPtr, listRepPtr);
     }
     elemPtrs = &listRepPtr->elements;
 
@@ -1805,6 +1871,18 @@ TclListObjSetElement(
 
     elemPtrs[index] = valuePtr;
 
+    /*
+     * Invalidate outdated intreps.
+     */
+
+    ListGetIntRep(listPtr, listRepPtr);
+    listRepPtr->refCount++;
+    TclFreeIntRep(listPtr);
+    ListSetIntRep(listPtr, listRepPtr);
+    listRepPtr->refCount--;
+
+    TclInvalidateStringRep(listPtr);
+
     return TCL_OK;
 }
 
@@ -1820,9 +1898,8 @@ TclListObjSetElement(
  *	None.
  *
  * Side effects:
- *	Frees listPtr's List* internal representation and sets listPtr's
- *	internalRep.twoPtrValue.ptr1 to NULL. Decrements the ref counts of all
- *	element objects, which may free them.
+ *	Frees listPtr's List* internal representation, if no longer shared.
+ *	May decrement the ref counts of element objects, which may free them.
  *
  *----------------------------------------------------------------------
  */
@@ -1831,7 +1908,10 @@ static void
 FreeListInternalRep(
     Tcl_Obj *listPtr)		/* List object with internal rep to free. */
 {
-    List *listRepPtr = ListRepPtr(listPtr);
+    List *listRepPtr;
+
+    ListGetIntRep(listPtr, listRepPtr);
+    assert(listRepPtr != NULL);
 
     if (listRepPtr->refCount-- <= 1) {
 	Tcl_Obj **elemPtrs = &listRepPtr->elements;
@@ -1842,8 +1922,6 @@ FreeListInternalRep(
 	}
 	ckfree(listRepPtr);
     }
-
-    listPtr->typePtr = NULL;
 }
 
 /*
@@ -1868,8 +1946,10 @@ DupListInternalRep(
     Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
     Tcl_Obj *copyPtr)		/* Object with internal rep to set. */
 {
-    List *listRepPtr = ListRepPtr(srcPtr);
+    List *listRepPtr;
 
+    ListGetIntRep(srcPtr, listRepPtr);
+    assert(listRepPtr != NULL);
     ListSetIntRep(copyPtr, listRepPtr);
 }
 
@@ -1908,7 +1988,7 @@ SetListFromAny(
      * describe duplicate keys).
      */
 
-    if (objPtr->typePtr == &tclDictType && !objPtr->bytes) {
+    if (!TclHasStringRep(objPtr) && Tcl_FetchIntRep(objPtr, &tclDictType)) {
 	Tcl_Obj *keyPtr, *valuePtr;
 	Tcl_DictSearch search;
 	int done, size;
@@ -1966,10 +2046,12 @@ SetListFromAny(
 
 	while (nextElem < limit) {
 	    const char *elemStart;
+	    char *check;
 	    int elemSize, literal;
 
 	    if (TCL_OK != TclFindElement(interp, nextElem, limit - nextElem,
 		    &elemStart, &nextElem, &elemSize, &literal)) {
+	    fail:
 		while (--elemPtrs >= &listRepPtr->elements) {
 		    Tcl_DecrRefCount(*elemPtrs);
 		}
@@ -1980,14 +2062,21 @@ SetListFromAny(
 		break;
 	    }
 
-	    /* TODO: replace panic with error on alloc failure? */
-	    if (literal) {
-		TclNewStringObj(*elemPtrs, elemStart, elemSize);
-	    } else {
-		TclNewObj(*elemPtrs);
-		(*elemPtrs)->bytes = ckalloc((unsigned) elemSize + 1);
-		(*elemPtrs)->length = TclCopyAndCollapse(elemSize, elemStart,
-			(*elemPtrs)->bytes);
+	    TclNewObj(*elemPtrs);
+	    TclInvalidateStringRep(*elemPtrs);
+	    check = Tcl_InitStringRep(*elemPtrs, literal ? elemStart : NULL,
+		    elemSize);
+	    if (elemSize && check == NULL) {
+		if (interp) {
+		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+			    "cannot construct list, out of memory", -1));
+		    Tcl_SetErrorCode(interp, "TCL", "MEMORY", NULL);
+		}
+		goto fail;
+	    }
+	    if (!literal) {
+		Tcl_InitStringRep(*elemPtrs, NULL,
+			TclCopyAndCollapse(elemSize, elemStart, check));
 	    }
 
 	    Tcl_IncrRefCount(*elemPtrs++);/* Since list now holds ref to it. */
@@ -1997,12 +2086,11 @@ SetListFromAny(
     }
 
     /*
-     * Free the old internalRep before setting the new one. We do this as late
+     * Store the new internalRep. We do this as late
      * as possible to allow the conversion code, in particular
-     * Tcl_GetStringFromObj, to use that old internalRep.
+     * Tcl_GetStringFromObj, to use the old internalRep.
      */
 
-    TclFreeIntRep(objPtr);
     ListSetIntRep(objPtr, listRepPtr);
     return TCL_OK;
 }
@@ -2034,12 +2122,17 @@ UpdateStringOfList(
 {
 #   define LOCAL_SIZE 64
     char localFlags[LOCAL_SIZE], *flagPtr = NULL;
-    List *listRepPtr = ListRepPtr(listPtr);
-    int numElems = listRepPtr->elemCount;
-    int i, length, bytesNeeded = 0;
+    int numElems, i, length, bytesNeeded = 0;
     const char *elem;
     char *dst;
     Tcl_Obj **elemPtrs;
+    List *listRepPtr;
+
+    ListGetIntRep(listPtr, listRepPtr);
+
+    assert(listRepPtr != NULL);
+
+    numElems = listRepPtr->elemCount;
 
     /*
      * Mark the list as being canonical; although it will now have a string
@@ -2054,8 +2147,7 @@ UpdateStringOfList(
      */
 
     if (numElems == 0) {
-	listPtr->bytes = &tclEmptyString;
-	listPtr->length = 0;
+	Tcl_InitStringRep(listPtr, NULL, 0);
 	return;
     }
 
@@ -2084,22 +2176,21 @@ UpdateStringOfList(
     if (bytesNeeded > INT_MAX - numElems + 1) {
 	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
     }
-    bytesNeeded += numElems;
+    bytesNeeded += numElems - 1;
 
     /*
      * Pass 2: copy into string rep buffer.
      */
 
-    listPtr->length = bytesNeeded - 1;
-    listPtr->bytes = ckalloc(bytesNeeded);
-    dst = listPtr->bytes;
+    dst = Tcl_InitStringRep(listPtr, NULL, bytesNeeded);
+    TclOOM(dst, bytesNeeded);
     for (i = 0; i < numElems; i++) {
 	flagPtr[i] |= (i ? TCL_DONT_QUOTE_HASH : 0);
 	elem = TclGetStringFromObj(elemPtrs[i], &length);
 	dst += TclConvertElement(elem, length, dst, flagPtr[i]);
 	*dst++ = ' ';
     }
-    listPtr->bytes[listPtr->length] = '\0';
+    (void) Tcl_InitStringRep(listPtr, NULL, bytesNeeded);
 
     if (flagPtr != localFlags) {
 	ckfree(flagPtr);

generic/tclNamesp.c

@@ -25,6 +25,7 @@
 
 #include "tclInt.h"
 #include "tclCompile.h" /* for TclLogCommandInfo visibility */
+#include <assert.h>
 
 /*
  * Thread-local storage used to avoid having a global lock on data that is not
@@ -152,6 +153,22 @@ static const Tcl_ObjType nsNameType = {
     SetNsNameFromAny		/* setFromAnyProc */
 };
 
+#define NsNameSetIntRep(objPtr, nnPtr)					\
+    do {								\
+	Tcl_ObjIntRep ir;						\
+	(nnPtr)->refCount++;						\
+	ir.twoPtrValue.ptr1 = (nnPtr);					\
+	ir.twoPtrValue.ptr2 = NULL;					\
+	Tcl_StoreIntRep((objPtr), &nsNameType, &ir);			\
+    } while (0)
+
+#define NsNameGetIntRep(objPtr, nnPtr)					\
+    do {								\
+	const Tcl_ObjIntRep *irPtr;					\
+	irPtr = Tcl_FetchIntRep((objPtr), &nsNameType);			\
+	(nnPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL;		\
+    } while (0)
+
 /*
  * Array of values describing how to implement each standard subcommand of the
  * "namespace" command.
@@ -2898,15 +2915,16 @@ GetNamespaceFromObj(
     Tcl_Namespace **nsPtrPtr)	/* Result namespace pointer goes here. */
 {
     ResolvedNsName *resNamePtr;
-    Namespace *nsPtr, *refNsPtr;
 
-    if (objPtr->typePtr == &nsNameType) {
+    NsNameGetIntRep(objPtr, resNamePtr);
+    if (resNamePtr) {
+	Namespace *nsPtr, *refNsPtr;
+
 	/*
 	 * Check that the ResolvedNsName is still valid; avoid letting the ref
 	 * cross interps.
 	 */
 
-	resNamePtr = objPtr->internalRep.twoPtrValue.ptr1;
 	nsPtr = resNamePtr->nsPtr;
 	refNsPtr = resNamePtr->refNsPtr;
 	if (!(nsPtr->flags & NS_DYING) && (interp == nsPtr->interp)
@@ -2915,9 +2933,11 @@ GetNamespaceFromObj(
 	    *nsPtrPtr = (Tcl_Namespace *) nsPtr;
 	    return TCL_OK;
 	}
+	Tcl_StoreIntRep(objPtr, &nsNameType, NULL);
     }
     if (SetNsNameFromAny(interp, objPtr) == TCL_OK) {
-	resNamePtr = objPtr->internalRep.twoPtrValue.ptr1;
+	NsNameGetIntRep(objPtr, resNamePtr);
+	assert(resNamePtr != NULL);
 	*nsPtrPtr = (Tcl_Namespace *) resNamePtr->nsPtr;
 	return TCL_OK;
     }
@@ -4687,8 +4707,11 @@ FreeNsNameInternalRep(
     register Tcl_Obj *objPtr)	/* nsName object with internal representation
 				 * to free. */
 {
-    ResolvedNsName *resNamePtr = objPtr->internalRep.twoPtrValue.ptr1;
+    ResolvedNsName *resNamePtr;
 
+    NsNameGetIntRep(objPtr, resNamePtr);
+    assert(resNamePtr != NULL);
+	
     /*
      * Decrement the reference count of the namespace. If there are no more
      * references, free it up.
@@ -4704,7 +4727,6 @@ FreeNsNameInternalRep(
 	TclNsDecrRefCount(resNamePtr->nsPtr);
 	ckfree(resNamePtr);
     }
-    objPtr->typePtr = NULL;
 }
 
 /*
@@ -4731,11 +4753,11 @@ DupNsNameInternalRep(
     Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
     register Tcl_Obj *copyPtr)	/* Object with internal rep to set. */
 {
-    ResolvedNsName *resNamePtr = srcPtr->internalRep.twoPtrValue.ptr1;
+    ResolvedNsName *resNamePtr;
 
-    copyPtr->internalRep.twoPtrValue.ptr1 = resNamePtr;
-    resNamePtr->refCount++;
-    copyPtr->typePtr = &nsNameType;
+    NsNameGetIntRep(srcPtr, resNamePtr);
+    assert(resNamePtr != NULL);
+    NsNameSetIntRep(copyPtr, resNamePtr);
 }
 
 /*
@@ -4780,24 +4802,15 @@ SetNsNameFromAny(
     TclGetNamespaceForQualName(interp, name, NULL, TCL_FIND_ONLY_NS,
 	     &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy);
 
+    if ((nsPtr == NULL) || (nsPtr->flags & NS_DYING)) {
+	return TCL_ERROR;
+    }
+
     /*
      * If we found a namespace, then create a new ResolvedNsName structure
      * that holds a reference to it.
      */
 
-    if ((nsPtr == NULL) || (nsPtr->flags & NS_DYING)) {
-	/*
-	 * Our failed lookup proves any previously cached nsName intrep is no
-	 * longer valid. Get rid of it so we no longer waste memory storing
-	 * it, nor time determining its invalidity again and again.
-	 */
-
-	if (objPtr->typePtr == &nsNameType) {
-	    TclFreeIntRep(objPtr);
-	}
-	return TCL_ERROR;
-    }
-
     nsPtr->refCount++;
     resNamePtr = ckalloc(sizeof(ResolvedNsName));
     resNamePtr->nsPtr = nsPtr;
@@ -4806,10 +4819,8 @@ SetNsNameFromAny(
     } else {
 	resNamePtr->refNsPtr = (Namespace *) TclGetCurrentNamespace(interp);
     }
-    resNamePtr->refCount = 1;
-    TclFreeIntRep(objPtr);
-    objPtr->internalRep.twoPtrValue.ptr1 = resNamePtr;
-    objPtr->typePtr = &nsNameType;
+    resNamePtr->refCount = 0;
+    NsNameSetIntRep(objPtr, resNamePtr);
     return TCL_OK;
 }
 

generic/tclOO.c

@@ -59,7 +59,6 @@ static const struct {
  * Function declarations for things defined in this file.
  */
 
-static Class *		AllocClass(Tcl_Interp *interp, Object *useThisObj);
 static Object *		AllocObject(Tcl_Interp *interp, const char *nameStr,
 			    Namespace *nsPtr, const char *nsNameStr);
 static int		CloneClassMethod(Tcl_Interp *interp, Class *clsPtr,
@@ -84,8 +83,6 @@ static void		ObjectNamespaceDeleted(ClientData clientData);
 static void		ObjectRenamedTrace(ClientData clientData,
 			    Tcl_Interp *interp, const char *oldName,
 			    const char *newName, int flags);
-static void		ReleaseClassContents(Tcl_Interp *interp,Object *oPtr);
-static void		DeleteDescendants(Tcl_Interp *interp,Object *oPtr);
 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);
@@ -451,10 +448,10 @@ InitClassSystemRoots(
 
     /* Stand up a phony class for bootstrapping. */
     fPtr->objectCls = &fakeCls;
-    /* referenced in AllocClass to increment the refCount. */
+    /* referenced in TclOOAllocClass to increment the refCount. */
     fakeCls.thisPtr = &fakeObject;
 
-    fPtr->objectCls = AllocClass(interp,
+    fPtr->objectCls = TclOOAllocClass(interp,
 	    AllocObject(interp, "object", (Namespace *)fPtr->ooNs, NULL));
     /* Corresponding TclOODecrRefCount in KillFoudation */
     AddRef(fPtr->objectCls->thisPtr);
@@ -470,7 +467,7 @@ InitClassSystemRoots(
     fPtr->objectCls->thisPtr->flags |= ROOT_OBJECT;
     fPtr->objectCls->flags |= ROOT_OBJECT;
 
-    fPtr->classCls = AllocClass(interp,
+    fPtr->classCls = TclOOAllocClass(interp,
 	    AllocObject(interp, "class", (Namespace *)fPtr->ooNs, NULL));
     /* Corresponding TclOODecrRefCount in KillFoudation */
     AddRef(fPtr->classCls->thisPtr);
@@ -839,15 +836,15 @@ ObjectRenamedTrace(
 /*
  * ----------------------------------------------------------------------
  *
- * DeleteDescendants --
+ * TclOODeleteDescendants --
  *
  *	Delete all descendants of a particular class.
  *
  * ----------------------------------------------------------------------
  */
 
-static void
-DeleteDescendants(
+void
+TclOODeleteDescendants(
     Tcl_Interp *interp,		/* The interpreter containing the class. */
     Object *oPtr)		/* The object representing the class. */
 {
@@ -864,7 +861,8 @@ DeleteDescendants(
 	    /* This condition also covers the case where mixinSubclassPtr ==
 	     * clsPtr
 	     */
-	    if (!Deleted(mixinSubclassPtr->thisPtr)) {
+	    if (!Deleted(mixinSubclassPtr->thisPtr)
+		    && !(mixinSubclassPtr->thisPtr->flags & DONT_DELETE)) {
 		Tcl_DeleteCommandFromToken(interp,
 			mixinSubclassPtr->thisPtr->command);
 	    }
@@ -883,8 +881,10 @@ DeleteDescendants(
     if (clsPtr->subclasses.num > 0) {
 	while (clsPtr->subclasses.num > 0) {
 	    subclassPtr = clsPtr->subclasses.list[clsPtr->subclasses.num-1];
-	    if (!Deleted(subclassPtr->thisPtr) && !IsRoot(subclassPtr)) {
-		Tcl_DeleteCommandFromToken(interp, subclassPtr->thisPtr->command);
+	    if (!Deleted(subclassPtr->thisPtr) && !IsRoot(subclassPtr)
+		    && !(subclassPtr->thisPtr->flags & DONT_DELETE)) {
+		Tcl_DeleteCommandFromToken(interp,
+			subclassPtr->thisPtr->command);
 	    }
 	    TclOORemoveFromSubclasses(subclassPtr, clsPtr);
 	}
@@ -906,7 +906,8 @@ DeleteDescendants(
 	     * This condition also covers the case where instancePtr == oPtr
 	     */
 
-	    if (!Deleted(instancePtr) && !IsRoot(instancePtr)) {
+	    if (!Deleted(instancePtr) && !IsRoot(instancePtr) &&
+		    !(instancePtr->flags & DONT_DELETE)) {
 		Tcl_DeleteCommandFromToken(interp, instancePtr->command);
 	    }
 	    TclOORemoveFromInstances(instancePtr, clsPtr);
@@ -922,7 +923,7 @@ DeleteDescendants(
 /*
  * ----------------------------------------------------------------------
  *
- * ReleaseClassContents --
+ * TclOOReleaseClassContents --
  *
  *	Tear down the special class data structure, including deleting all
  *	dependent classes and objects.
@@ -930,8 +931,8 @@ DeleteDescendants(
  * ----------------------------------------------------------------------
  */
 
-static void
-ReleaseClassContents(
+void
+TclOOReleaseClassContents(
     Tcl_Interp *interp,		/* The interpreter containing the class. */
     Object *oPtr)		/* The object representing the class. */
 {
@@ -954,9 +955,6 @@ ReleaseClassContents(
 	} else if (IsRootObject(oPtr)) {
 	    Tcl_Panic("deleting class structure for non-deleted %s",
 		    "::oo::object");
-	} else {
-	    Tcl_Panic("deleting class structure for non-deleted %s",
-		    "general object");
 	}
     }
 
@@ -1108,7 +1106,7 @@ ObjectNamespaceDeleted(
 
     /* Let the dominoes fall */
     if (oPtr->classPtr) {
-	DeleteDescendants(interp, oPtr);
+	TclOODeleteDescendants(interp, oPtr);
     }
 
     /*
@@ -1184,7 +1182,9 @@ ObjectNamespaceDeleted(
 	    TclOORemoveFromInstances(oPtr, mixinPtr);
 	    TclOODecrRefCount(mixinPtr->thisPtr);
 	}
-	ckfree(oPtr->mixins.list);
+	if (oPtr->mixins.list != NULL) {
+	    ckfree(oPtr->mixins.list);
+	}
     }
 
     FOREACH(filterObj, oPtr->filters) {
@@ -1237,8 +1237,8 @@ ObjectNamespaceDeleted(
 
     /*
      * Because an object can be a class that is an instance of itself, the
-     * class object's class structure should only be cleaned after most of the
-     * cleanup on the object is done.
+     * class object's class structure should only be cleaned after most of
+     * the cleanup on the object is done.
      *
      * The class of objects needs some special care; if it is deleted (and
      * we're not killing the whole interpreter) we force the delete of the
@@ -1253,7 +1253,7 @@ ObjectNamespaceDeleted(
     }
 
     if (oPtr->classPtr != NULL) {
-	ReleaseClassContents(interp, oPtr);
+	TclOOReleaseClassContents(interp, oPtr);
     }
 
     /*
@@ -1357,6 +1357,41 @@ TclOOAddToInstances(
     AddRef(oPtr);
 }
 
+/*
+ * ----------------------------------------------------------------------
+ *
+ * TclOORemoveFromMixins --
+ *
+ *	Utility function to remove a class from the list of mixins within an
+ *	object.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+int
+TclOORemoveFromMixins(
+    Class *mixinPtr,		/* The mixin to remove. */
+    Object *oPtr)		/* The object (possibly) containing the
+				 * reference to the mixin. */
+{
+    int i, res = 0;
+    Class *mixPtr;
+
+    FOREACH(mixPtr, oPtr->mixins) {
+	if (mixinPtr == mixPtr) {
+	    RemoveItem(Class, oPtr->mixins, i);
+	    TclOODecrRefCount(mixPtr->thisPtr);
+	    res++;
+	    break;
+	}
+    }
+    if (oPtr->mixins.num == 0) {
+	ckfree(oPtr->mixins.list);
+	oPtr->mixins.list = NULL;
+    }
+    return res;
+}
+
 /*
  * ----------------------------------------------------------------------
  *
@@ -1489,10 +1524,10 @@ TclOOAddToMixinSubs(
 /*
  * ----------------------------------------------------------------------
  *
- * AllocClass --
+ * TclOOAllocClass --
  *
- *	Allocate a basic class. Does not add class to its
- *	class's instance list.
+ *	Allocate a basic class. Does not add class to its class's instance
+ *	list.
  *
  * ----------------------------------------------------------------------
  */
@@ -1516,8 +1551,8 @@ InitClassPath(
     }
 }
 
-static Class *
-AllocClass(
+Class *
+TclOOAllocClass(
     Tcl_Interp *interp,		/* Interpreter within which to allocate the
 				 * class. */
     Object *useThisObj)		/* Object that is to act as the class
@@ -1758,13 +1793,13 @@ TclNewObjectInstanceCommon(
 
     if (TclOOIsReachable(fPtr->classCls, classPtr)) {
 	/*
-	 * Is a class, so attach a class structure. Note that the AllocClass
-	 * function splices the structure into the object, so we don't have
-	 * to. Once that's done, we need to repatch the object to have the
-	 * right class since AllocClass interferes with that.
+	 * Is a class, so attach a class structure. Note that the
+	 * TclOOAllocClass function splices the structure into the object, so
+	 * we don't have to. Once that's done, we need to repatch the object
+	 * to have the right class since TclOOAllocClass interferes with that.
 	 */
 
-	AllocClass(interp, oPtr);
+	TclOOAllocClass(interp, oPtr);
 	TclOOAddToSubclasses(oPtr->classPtr, fPtr->objectCls);
     } else {
 	oPtr->classPtr = NULL;

generic/tclOOCall.c

@@ -15,6 +15,7 @@
 #endif
 #include "tclInt.h"
 #include "tclOOInt.h"
+#include <assert.h>
 
 /*
  * Structure containing a CallContext and any other values needed only during
@@ -128,6 +129,7 @@ static const Tcl_ObjType methodNameType = {
     NULL,
     NULL
 };
+
 
 /*
  * ----------------------------------------------------------------------
@@ -222,11 +224,12 @@ StashCallChain(
     Tcl_Obj *objPtr,
     CallChain *callPtr)
 {
+    Tcl_ObjIntRep ir;
+
     callPtr->refCount++;
     TclGetString(objPtr);
-    TclFreeIntRep(objPtr);
-    objPtr->typePtr = &methodNameType;
-    objPtr->internalRep.twoPtrValue.ptr1 = callPtr;
+    ir.twoPtrValue.ptr1 = callPtr;
+    Tcl_StoreIntRep(objPtr, &methodNameType, &ir);
 }
 
 void
@@ -253,21 +256,16 @@ DupMethodNameRep(
     Tcl_Obj *srcPtr,
     Tcl_Obj *dstPtr)
 {
-    register CallChain *callPtr = srcPtr->internalRep.twoPtrValue.ptr1;
-
-    dstPtr->typePtr = &methodNameType;
-    dstPtr->internalRep.twoPtrValue.ptr1 = callPtr;
-    callPtr->refCount++;
+    StashCallChain(dstPtr,
+	    Tcl_FetchIntRep(srcPtr, &methodNameType)->twoPtrValue.ptr1);
 }
 
 static void
 FreeMethodNameRep(
     Tcl_Obj *objPtr)
 {
-    register CallChain *callPtr = objPtr->internalRep.twoPtrValue.ptr1;
-
-    TclOODeleteChain(callPtr);
-    objPtr->typePtr = NULL;
+    TclOODeleteChain(
+	    Tcl_FetchIntRep(objPtr, &methodNameType)->twoPtrValue.ptr1);
 }
 
 /*
@@ -1165,15 +1163,16 @@ TclOOGetCallContext(
 	 * the object, and in the class).
 	 */
 
+	const Tcl_ObjIntRep *irPtr;
 	const int reuseMask = (WANT_PUBLIC(flags) ? ~0 : ~PUBLIC_METHOD);
 
-	if (cacheInThisObj->typePtr == &methodNameType) {
-	    callPtr = cacheInThisObj->internalRep.twoPtrValue.ptr1;
+	if ((irPtr = Tcl_FetchIntRep(cacheInThisObj, &methodNameType))) {
+	    callPtr = irPtr->twoPtrValue.ptr1;
 	    if (IsStillValid(callPtr, oPtr, flags, reuseMask)) {
 		callPtr->refCount++;
 		goto returnContext;
 	    }
-	    FreeMethodNameRep(cacheInThisObj);
+	    Tcl_StoreIntRep(cacheInThisObj, &methodNameType, NULL);
 	}
 
 	if (oPtr->flags & USE_CLASS_CACHE) {
@@ -1704,7 +1703,6 @@ AddSimpleClassChainToCallContext(
     if (flags & CONSTRUCTOR) {
 	AddMethodToCallChain(classPtr->constructorPtr, cbPtr, doneFilters,
 		filterDecl, flags);
-
     } else if (flags & DESTRUCTOR) {
 	AddMethodToCallChain(classPtr->destructorPtr, cbPtr, doneFilters,
 		filterDecl, flags);

generic/tclOODefineCmds.c

@@ -46,7 +46,7 @@ struct DeclaredSlot {
 		    getter, NULL, NULL},				\
 	    {TCL_OO_METHOD_VERSION_CURRENT, "core method: " name " Setter", \
 		    setter, NULL, NULL},				\
-	    {TCL_OO_METHOD_VERSION_CURRENT, "core method: " name " Setter", \
+	    {TCL_OO_METHOD_VERSION_CURRENT, "core method: " name " Resolver", \
 		    resolver, NULL, NULL}}
 
 /*
@@ -1375,6 +1375,8 @@ TclOODefineClassObjCmd(
 {
     Object *oPtr;
     Class *clsPtr;
+    Foundation *fPtr = TclOOGetFoundation(interp);
+    int wasClass, willBeClass;
 
     /*
      * Parse the context to get the object to operate on.
@@ -1410,12 +1412,20 @@ TclOODefineClassObjCmd(
     if (clsPtr == NULL) {
 	return TCL_ERROR;
     }
-
+    if (oPtr == clsPtr->thisPtr) {
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		"may not change classes into an instance of themselves", -1));
+	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
+	return TCL_ERROR;
+    }
 
     /*
      * Set the object's class.
      */
 
+    wasClass = (oPtr->classPtr != NULL);
+    willBeClass = (TclOOIsReachable(fPtr->classCls, clsPtr));
+
     if (oPtr->selfCls != clsPtr) {
 	TclOORemoveFromInstances(oPtr, oPtr->selfCls);
 	TclOODecrRefCount(oPtr->selfCls->thisPtr);
@@ -1423,6 +1433,28 @@ TclOODefineClassObjCmd(
 	AddRef(oPtr->selfCls->thisPtr);
 	TclOOAddToInstances(oPtr, oPtr->selfCls);
 
+	/*
+	 * Create or delete the class guts if necessary.
+	 */
+
+	if (wasClass && !willBeClass) {
+	    /*
+	     * This is the most global of all epochs. Bump it! No cache can be
+	     * trusted!
+	     */
+
+	    TclOORemoveFromMixins(oPtr->classPtr, oPtr);
+	    oPtr->fPtr->epoch++;
+	    oPtr->flags |= DONT_DELETE;
+	    TclOODeleteDescendants(interp, oPtr);
+	    oPtr->flags &= ~DONT_DELETE;
+	    TclOOReleaseClassContents(interp, oPtr);
+		ckfree(oPtr->classPtr);
+		oPtr->classPtr = NULL;
+	} else if (!wasClass && willBeClass) {
+	    TclOOAllocClass(interp, oPtr);
+	}
+
 	if (oPtr->classPtr != NULL) {
 	    BumpGlobalEpoch(interp, oPtr->classPtr);
 	} else {

generic/tclOOInt.h

@@ -242,6 +242,10 @@ typedef struct Object {
 				/* Object/class has (or had) private methods,
 				 * and so shouldn't be cached so
 				 * aggressively. */
+#define DONT_DELETE 0x40000	/* Inhibit deletion of this object. Used
+				 * during fundamental object type mutation to
+				 * make sure that the object actually survives
+				 * to the end of the operation. */
 
 /*
  * And the definition of a class. Note that every class also has an associated
@@ -526,6 +530,8 @@ MODULE_SCOPE int	TclOO_Object_VarName(ClientData clientData,
 MODULE_SCOPE void	TclOOAddToInstances(Object *oPtr, Class *clsPtr);
 MODULE_SCOPE void	TclOOAddToMixinSubs(Class *subPtr, Class *mixinPtr);
 MODULE_SCOPE void	TclOOAddToSubclasses(Class *subPtr, Class *superPtr);
+MODULE_SCOPE Class *	TclOOAllocClass(Tcl_Interp *interp,
+			    Object *useThisObj);
 MODULE_SCOPE int	TclNRNewObjectInstance(Tcl_Interp *interp,
 			    Tcl_Class cls, const char *nameStr,
 			    const char *nsNameStr, int objc,
@@ -540,6 +546,8 @@ MODULE_SCOPE int	TclOODefineSlots(Foundation *fPtr);
 MODULE_SCOPE void	TclOODeleteChain(CallChain *callPtr);
 MODULE_SCOPE void	TclOODeleteChainCache(Tcl_HashTable *tablePtr);
 MODULE_SCOPE void	TclOODeleteContext(CallContext *contextPtr);
+MODULE_SCOPE void	TclOODeleteDescendants(Tcl_Interp *interp,
+			    Object *oPtr);
 MODULE_SCOPE void	TclOODelMethodRef(Method *method);
 MODULE_SCOPE CallContext *TclOOGetCallContext(Object *oPtr,
 			    Tcl_Obj *methodNameObj, int flags,
@@ -567,7 +575,10 @@ MODULE_SCOPE int	TclNRObjectContextInvokeNext(Tcl_Interp *interp,
 MODULE_SCOPE void	TclOONewBasicMethod(Tcl_Interp *interp, Class *clsPtr,
 			    const DeclaredClassMethod *dcm);
 MODULE_SCOPE Tcl_Obj *	TclOOObjectName(Tcl_Interp *interp, Object *oPtr);
+MODULE_SCOPE void	TclOOReleaseClassContents(Tcl_Interp *interp,
+			    Object *oPtr);
 MODULE_SCOPE int	TclOORemoveFromInstances(Object *oPtr, Class *clsPtr);
+MODULE_SCOPE int	TclOORemoveFromMixins(Class *mixinPtr, Object *oPtr);
 MODULE_SCOPE int	TclOORemoveFromMixinSubs(Class *subPtr,
 			    Class *mixinPtr);
 MODULE_SCOPE int	TclOORemoveFromSubclasses(Class *subPtr,

generic/tclOOMethod.c

@@ -799,6 +799,7 @@ PushMethodCallFrame(
     register int result;
     const char *namePtr;
     CallFrame **framePtrPtr = &fdPtr->framePtr;
+    ByteCode *codePtr;
 
     /*
      * Compute basic information on the basis of the type of method it is.
@@ -864,10 +865,8 @@ PushMethodCallFrame(
      * alternative is *so* slow...
      */
 
-    if (pmPtr->procPtr->bodyPtr->typePtr == &tclByteCodeType) {
-	ByteCode *codePtr =
-		pmPtr->procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;
-
+    ByteCodeGetIntRep(pmPtr->procPtr->bodyPtr, &tclByteCodeType, codePtr);
+    if (codePtr) {
 	codePtr->nsPtr = nsPtr;
     }
     result = TclProcCompileProc(interp, pmPtr->procPtr,
@@ -1341,7 +1340,7 @@ CloneProcedureMethod(
 
     bodyObj = Tcl_DuplicateObj(pmPtr->procPtr->bodyPtr);
     Tcl_GetString(bodyObj);
-    TclFreeIntRep(bodyObj);
+    Tcl_StoreIntRep(pmPtr->procPtr->bodyPtr, &tclByteCodeType, NULL);
 
     /*
      * Create the actual copy of the method record, manufacturing a new proc
@@ -1570,9 +1569,7 @@ TclOOGetMethodBody(
     if (mPtr->typePtr == &procMethodType) {
 	ProcedureMethod *pmPtr = mPtr->clientData;
 
-	if (pmPtr->procPtr->bodyPtr->bytes == NULL) {
-	    (void) Tcl_GetString(pmPtr->procPtr->bodyPtr);
-	}
+	(void) TclGetString(pmPtr->procPtr->bodyPtr);
 	return pmPtr->procPtr->bodyPtr;
     }
     return NULL;

generic/tclObj.c

@@ -17,6 +17,7 @@
 #include "tclInt.h"
 #include "tommath.h"
 #include <math.h>
+#include <assert.h>
 
 /*
  * Table of all object types.
@@ -1065,9 +1066,8 @@ TclDbInitNewObj(
 				 * debugging. */
 {
     objPtr->refCount = 0;
-    objPtr->bytes = &tclEmptyString;
-    objPtr->length = 0;
     objPtr->typePtr = NULL;
+    TclInitStringRep(objPtr, NULL, 0);
 
 #if TCL_THREADS
     /*
@@ -1722,6 +1722,91 @@ Tcl_GetStringFromObj(
     return objPtr->bytes;
 }
 
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_InitStringRep --
+ *
+ *	This function is called in several configurations to provide all
+ *	the tools needed to set an object's string representation. The
+ *	function is determined by the arguments.
+ *	
+ *	(objPtr->bytes != NULL && bytes != NULL) || (numBytes < 0)
+ *	    Invalid call -- panic!
+ *	
+ *	objPtr->bytes == NULL && bytes == NULL && numBytes >= 0
+ *	    Allocation only - allocate space for (numBytes+1) chars.
+ *	    store in objPtr->bytes and return. Also sets
+ *	    objPtr->length to 0 and objPtr->bytes[0] to NUL.
+ *	
+ *	objPtr->bytes == NULL && bytes != NULL && numBytes >= 0
+ *	    Allocate and copy. bytes is assumed to point to chars to
+ *	    copy into the string rep. objPtr->length = numBytes. Allocate
+ *	    array of (numBytes + 1) chars. store in objPtr->bytes. Copy
+ *	    numBytes chars from bytes to objPtr->bytes; Set
+ *	    objPtr->bytes[numBytes] to NUL and return objPtr->bytes.
+ *	    Caller must guarantee there are numBytes chars at bytes to
+ *	    be copied.
+ *
+ *	objPtr->bytes != NULL && bytes == NULL && numBytes >= 0
+ *	    Truncate.  Set objPtr->length to numBytes and
+ *	    objPr->bytes[numBytes] to NUL.  Caller has to guarantee
+ *	    that a prior allocating call allocated enough bytes for
+ *	    this to be valid. Return objPtr->bytes.
+ *
+ *	Caller is expected to ascertain that the bytes copied into
+ *	the string rep make up complete valid UTF-8 characters.
+ *
+ * Results:
+ *	A pointer to the string rep of objPtr.
+ *
+ * Side effects:
+ *	As described above.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tcl_InitStringRep(
+    Tcl_Obj *objPtr,	/* Object whose string rep is to be set */
+    const char *bytes,
+    unsigned int numBytes)
+{
+    assert(objPtr->bytes == NULL || bytes == NULL);
+
+    if (numBytes > INT_MAX) {
+	Tcl_Panic("max size for a Tcl value (%d bytes) exceeded", INT_MAX);
+    }
+
+    /* Allocate */
+    if (objPtr->bytes == NULL) {
+	/* Allocate only as empty - extend later if bytes copied */
+	objPtr->length = 0;
+	if (numBytes) {
+	    objPtr->bytes = attemptckalloc(numBytes + 1);
+	    if (objPtr->bytes == NULL) {
+		return NULL;
+	    }
+	    if (bytes) {
+		/* Copy */
+		memcpy(objPtr->bytes, bytes, numBytes);
+		objPtr->length = (int) numBytes;
+	    }
+	} else {
+	    TclInitStringRep(objPtr, NULL, 0);
+	}
+    } else {
+	/* objPtr->bytes != NULL bytes == NULL - Truncate */
+	objPtr->bytes = ckrealloc(objPtr->bytes, numBytes + 1);
+	objPtr->length = (int)numBytes;
+    }
+
+    /* Terminate */
+    objPtr->bytes[objPtr->length] = '\0';
+
+    return objPtr->bytes;
+}
+
 /*
  *----------------------------------------------------------------------
  *
@@ -1748,6 +1833,123 @@ Tcl_InvalidateStringRep(
     TclInvalidateStringRep(objPtr);
 }
 
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_HasStringRep --
+ *
+ *	This function reports whether object has a string representation.
+ *
+ * Results:
+ *	Boolean.
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_HasStringRep(
+    Tcl_Obj *objPtr)	/* Object to test */
+{
+    return TclHasStringRep(objPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_StoreIntRep --
+ *
+ *	This function is called to set the object's internal
+ *	representation to match a particular type.
+ *
+ *	It is the caller's responsibility to guarantee that
+ *	the value of the submitted IntRep is in agreement with
+ *	the value of any existing string rep.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Calls the freeIntRepProc of the current Tcl_ObjType, if any.
+ *	Sets the internalRep and typePtr fields to the submitted values.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_StoreIntRep(
+    Tcl_Obj *objPtr,		/* Object whose internal rep should be set. */
+    const Tcl_ObjType *typePtr,	/* New type for the object */
+    const Tcl_ObjIntRep *irPtr)	/* New IntRep for the object */
+{
+    /* Clear out any existing IntRep ( "shimmer" ) */
+    TclFreeIntRep(objPtr);
+
+    /* When irPtr == NULL, just leave objPtr with no IntRep for typePtr */
+    if (irPtr) {
+	/* Copy the new IntRep into place */
+	objPtr->internalRep = *irPtr;
+
+	/* Set the type to match */
+	objPtr->typePtr = typePtr;
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FetchIntRep --
+ *
+ *	This function is called to retrieve the object's internal
+ *	representation matching a requested type, if any.
+ *
+ * Results:
+ *	A read-only pointer to the associated Tcl_ObjIntRep, or
+ *	NULL if no such internal representation exists.
+ *
+ * Side effects:
+ *	Calls the freeIntRepProc of the current Tcl_ObjType, if any.
+ *	Sets the internalRep and typePtr fields to the submitted values.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_ObjIntRep *
+Tcl_FetchIntRep(
+    Tcl_Obj *objPtr,		/* Object to fetch from. */
+    const Tcl_ObjType *typePtr)	/* Requested type */
+{
+    /* If objPtr type doesn't match request, nothing can be fetched */
+    if (objPtr->typePtr != typePtr) {
+	return NULL;
+    }
+
+    /* Type match! objPtr IntRep is the one sought. */
+    return &(objPtr->internalRep);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_FreeIntRep --
+ *
+ *	This function is called to free an object's internal representation.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Calls the freeIntRepProc of the current Tcl_ObjType, if any.
+ *	Sets typePtr field to NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_FreeIntRep(
+    Tcl_Obj *objPtr)	/* Object whose internal rep should be freed. */
+{
+    TclFreeIntRep(objPtr);
+}
+
 /*
  *----------------------------------------------------------------------
  *
@@ -1835,6 +2037,7 @@ Tcl_DbNewBooleanObj(
     register Tcl_Obj *objPtr;
 
     TclDbNewObj(objPtr, file, line);
+    /* Optimized TclInvalidateStringRep() */
     objPtr->bytes = NULL;
 
     objPtr->internalRep.wideValue = (boolValue != 0);
@@ -2221,6 +2424,7 @@ Tcl_DbNewDoubleObj(
     register Tcl_Obj *objPtr;
 
     TclDbNewObj(objPtr, file, line);
+    /* Optimized TclInvalidateStringRep() */
     objPtr->bytes = NULL;
 
     objPtr->internalRep.doubleValue = dblValue;
@@ -2381,15 +2585,12 @@ static void
 UpdateStringOfDouble(
     register Tcl_Obj *objPtr)	/* Double obj with string rep to update. */
 {
-    char buffer[TCL_DOUBLE_SPACE];
-    register int len;
+    char *dst = Tcl_InitStringRep(objPtr, NULL, TCL_DOUBLE_SPACE);
 
-    Tcl_PrintDouble(NULL, objPtr->internalRep.doubleValue, buffer);
-    len = strlen(buffer);
+    TclOOM(dst, TCL_DOUBLE_SPACE + 1);
 
-    objPtr->bytes = ckalloc(len + 1);
-    memcpy(objPtr->bytes, buffer, (unsigned) len + 1);
-    objPtr->length = len;
+    Tcl_PrintDouble(NULL, objPtr->internalRep.doubleValue, dst);
+    (void) Tcl_InitStringRep(objPtr, NULL, strlen(dst));
 }
 
 /*
@@ -2516,7 +2717,7 @@ Tcl_GetIntFromObj(
     if (TclGetLongFromObj(interp, objPtr, &l) != TCL_OK) {
 	return TCL_ERROR;
     }
-    if ((ULONG_MAX > UINT_MAX) && ((l > UINT_MAX) || (l < -(long)UINT_MAX))) {
+    if ((ULONG_MAX > UINT_MAX) && ((l > UINT_MAX) || (l < INT_MIN))) {
 	if (interp != NULL) {
 	    const char *s =
 		    "integer value too large to represent as non-long integer";
@@ -2578,14 +2779,11 @@ static void
 UpdateStringOfInt(
     register Tcl_Obj *objPtr)	/* Int object whose string rep to update. */
 {
-    char buffer[TCL_INTEGER_SPACE];
-    register int len;
+    char *dst = Tcl_InitStringRep( objPtr, NULL, TCL_INTEGER_SPACE);
 
-    len = TclFormatInt(buffer, objPtr->internalRep.wideValue);
-
-    objPtr->bytes = ckalloc(len + 1);
-    memcpy(objPtr->bytes, buffer, (unsigned) len + 1);
-    objPtr->length = len;
+    TclOOM(dst, TCL_INTEGER_SPACE + 1);
+    (void) Tcl_InitStringRep(objPtr, NULL,
+	    TclFormatInt(dst, objPtr->internalRep.wideValue));
 }
 
 #if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 && !defined(TCL_WIDE_INT_IS_LONG)
@@ -2593,14 +2791,11 @@ static void
 UpdateStringOfOldInt(
     register Tcl_Obj *objPtr)	/* Int object whose string rep to update. */
 {
-    char buffer[TCL_INTEGER_SPACE];
-    register int len;
+    char *dst = Tcl_InitStringRep( objPtr, NULL, TCL_INTEGER_SPACE);
 
-    len = TclFormatInt(buffer, objPtr->internalRep.longValue);
-
-    objPtr->bytes = ckalloc(len + 1);
-    memcpy(objPtr->bytes, buffer, (unsigned) len + 1);
-    objPtr->length = len;
+    TclOOM(dst, TCL_INTEGER_SPACE + 1);
+    (void) Tcl_InitStringRep(objPtr, NULL,
+	    TclFormatInt(dst, objPtr->internalRep.longValue));
 }
 #endif
 
@@ -2706,6 +2901,7 @@ Tcl_DbNewLongObj(
     register Tcl_Obj *objPtr;
 
     TclDbNewObj(objPtr, file, line);
+    /* Optimized TclInvalidateStringRep */
     objPtr->bytes = NULL;
 
     objPtr->internalRep.wideValue = longValue;
@@ -2796,7 +2992,7 @@ Tcl_GetLongFromObj(
 #else
 	if (objPtr->typePtr == &tclIntType) {
 	    /*
-	     * We return any integer in the range -ULONG_MAX to ULONG_MAX
+	     * We return any integer in the range LONG_MIN to ULONG_MAX
 	     * converted to a long, ignoring overflow. The rule preserves
 	     * existing semantics for conversion of integers on input, but
 	     * avoids inadvertent demotion of wide integers to 32-bit ones in
@@ -2805,7 +3001,7 @@ Tcl_GetLongFromObj(
 
 	    Tcl_WideInt w = objPtr->internalRep.wideValue;
 
-	    if (w >= -(Tcl_WideInt)(ULONG_MAX)
+	    if (w >= (Tcl_WideInt)(LONG_MIN)
 		    && w <= (Tcl_WideInt)(ULONG_MAX)) {
 		*longPtr = (long) w;
 		return TCL_OK;
@@ -2843,11 +3039,16 @@ Tcl_GetLongFromObj(
 			value = (value << CHAR_BIT) | *bytes++;
 		    }
 		    if (big.sign) {
-			*longPtr = - (long) value;
+			if (value <= 1 + (unsigned long)LONG_MAX) {
+			    *longPtr = - (long) value;
+			    return TCL_OK;
+			}
 		    } else {
-			*longPtr = (long) value;
+			if (value <= (unsigned long)ULONG_MAX) {
+			    *longPtr = (long) value;
+			    return TCL_OK;
+			}
 		    }
-		    return TCL_OK;
 		}
 	    }
 #ifndef TCL_WIDE_INT_IS_LONG
@@ -3082,11 +3283,16 @@ Tcl_GetWideIntFromObj(
 			value = (value << CHAR_BIT) | *bytes++;
 		    }
 		    if (big.sign) {
-			*wideIntPtr = - (Tcl_WideInt) value;
+			if (value <= 1 + ~(Tcl_WideUInt)WIDE_MIN) {
+			    *wideIntPtr = - (Tcl_WideInt) value;
+			    return TCL_OK;
+			}
 		    } else {
-			*wideIntPtr = (Tcl_WideInt) value;
+			if (value <= (Tcl_WideUInt)WIDE_MAX) {
+			    *wideIntPtr = (Tcl_WideInt) value;
+			    return TCL_OK;
+			}
 		    }
-		    return TCL_OK;
 		}
 	    }
 	    if (interp != NULL) {
@@ -3158,10 +3364,7 @@ TclGetWideBitsFromObj(
 	    while (numBytes-- > 0) {
 		value = (value << CHAR_BIT) | *bytes++;
 	    }
-	    if (big.sign) {
-		value = -value;
-	    }
-	    *wideIntPtr = (Tcl_WideInt) value;
+	    *wideIntPtr = !big.sign ? (Tcl_WideInt)value : -(Tcl_WideInt)value;
 	    mp_clear(&big);
 	    return TCL_OK;
 	}
@@ -3255,12 +3458,10 @@ UpdateStringOfBignum(
 {
     mp_int bignumVal;
     int size;
-    int status;
     char *stringVal;
 
     UNPACK_BIGNUM(objPtr, bignumVal);
-    status = mp_radix_size(&bignumVal, 10, &size);
-    if (status != MP_OKAY) {
+    if (MP_OKAY != mp_radix_size(&bignumVal, 10, &size)) {
 	Tcl_Panic("radix size failure in UpdateStringOfBignum");
     }
     if (size < 2) {
@@ -3275,13 +3476,14 @@ UpdateStringOfBignum(
 
 	Tcl_Panic("UpdateStringOfBignum: string length limit exceeded");
     }
-    stringVal = ckalloc(size);
-    status = mp_toradix_n(&bignumVal, stringVal, 10, size);
-    if (status != MP_OKAY) {
+
+    stringVal = Tcl_InitStringRep(objPtr, NULL, size - 1);
+
+    TclOOM(stringVal, size);
+    if (MP_OKAY != mp_toradix_n(&bignumVal, stringVal, 10, size)) {
 	Tcl_Panic("conversion failure in UpdateStringOfBignum");
     }
-    objPtr->bytes = stringVal;
-    objPtr->length = size - 1;	/* size includes a trailing NUL byte. */
+    (void) Tcl_InitStringRep(objPtr, NULL, size - 1);
 }
 
 /*
@@ -3401,11 +3603,17 @@ GetBignumFromObj(
 		mp_init_copy(bignumValue, &temp);
 	    } else {
 		UNPACK_BIGNUM(objPtr, *bignumValue);
+		/* Optimized TclFreeIntRep */
 		objPtr->internalRep.twoPtrValue.ptr1 = NULL;
 		objPtr->internalRep.twoPtrValue.ptr2 = NULL;
 		objPtr->typePtr = NULL;
+		/*
+		 * TODO: If objPtr has a string rep, this leaves
+		 * it undisturbed.  Not clear that's proper. Pure
+		 * bignum values are converted to empty string.
+		 */
 		if (objPtr->bytes == NULL) {
-		    TclInitStringRep(objPtr, &tclEmptyString, 0);
+		    TclInitStringRep(objPtr, NULL, 0);
 		}
 	    }
 	    return TCL_OK;
@@ -3629,7 +3837,7 @@ TclGetNumberFromObj(
 	    return TCL_OK;
 	}
 	if (objPtr->typePtr == &tclIntType) {
-	    *typePtr = TCL_NUMBER_WIDE;
+	    *typePtr = TCL_NUMBER_INT;
 	    *clientDataPtr = &objPtr->internalRep.wideValue;
 	    return TCL_OK;
 	}

generic/tclPathObj.c

@@ -36,7 +36,7 @@ static int		MakePathFromNormalized(Tcl_Interp *interp,
  * internally.
  */
 
-static const Tcl_ObjType tclFsPathType = {
+static const Tcl_ObjType fsPathType = {
     "path",				/* name */
     FreeFsPathInternalRep,		/* freeIntRepProc */
     DupFsPathInternalRep,		/* dupIntRepProc */
@@ -51,19 +51,14 @@ static const Tcl_ObjType tclFsPathType = {
  * represent relative or absolute paths, and has certain optimisations when
  * used to represent paths which are already normalized and absolute.
  *
- * Note that both 'translatedPathPtr' and 'normPathPtr' can be a circular
- * reference to the container Tcl_Obj of this FsPath.
- *
  * There are two cases, with the first being the most common:
  *
  * (i) flags == 0, => Ordinary path.
  *
- * translatedPathPtr contains the translated path (which may be a circular
- * reference to the object itself). If it is NULL then the path is pure
- * normalized (and the normPathPtr will be a circular reference). cwdPtr is
- * null for an absolute path, and non-null for a relative path (unless the cwd
- * has never been set, in which case the cwdPtr may also be null for a
- * relative path).
+ * translatedPathPtr contains the translated path. If it is NULL then the path
+ * is pure normalized. cwdPtr is null for an absolute path, and non-null for a
+ * relative path (unless the cwd has never been set, in which case the cwdPtr
+ * may also be null for a relative path).
  *
  * (ii) flags != 0, => Special path, see TclNewFSPathObj
  *
@@ -79,11 +74,7 @@ typedef struct FsPath {
 				 * Tcl_Obj's string rep is already both
 				 * translated and normalized. */
     Tcl_Obj *normPathPtr;	/* Normalized absolute path, without ., .. or
-				 * ~user sequences. If the Tcl_Obj containing
-				 * this FsPath is already normalized, this may
-				 * be a circular reference back to the
-				 * container. If that is NOT the case, we have
-				 * a refCount on the object. */
+				 * ~user sequences. */
     Tcl_Obj *cwdPtr;		/* If null, path is absolute, else this points
 				 * to the cwd object used for this path. We
 				 * have a refCount on the object. */
@@ -110,9 +101,14 @@ typedef struct FsPath {
  * fields.
  */
 
-#define PATHOBJ(pathPtr) ((FsPath *) (pathPtr)->internalRep.twoPtrValue.ptr1)
+#define PATHOBJ(pathPtr) ((FsPath *) (Tcl_FetchIntRep((pathPtr), &fsPathType)->twoPtrValue.ptr1))
 #define SETPATHOBJ(pathPtr,fsPathPtr) \
-	((pathPtr)->internalRep.twoPtrValue.ptr1 = (void *) (fsPathPtr))
+	do {							\
+		Tcl_ObjIntRep ir;				\
+		ir.twoPtrValue.ptr1 = (void *) (fsPathPtr);	\
+		ir.twoPtrValue.ptr2 = NULL;			\
+		Tcl_StoreIntRep((pathPtr), &fsPathType, &ir);	\
+	} while (0)
 #define PATHFLAGS(pathPtr) (PATHOBJ(pathPtr)->flags)
 
 /*
@@ -564,7 +560,9 @@ TclPathPart(
     Tcl_Obj *pathPtr,		/* Path to take dirname of */
     Tcl_PathPart portion)	/* Requested portion of name */
 {
-    if (pathPtr->typePtr == &tclFsPathType) {
+    Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(pathPtr, &fsPathType);
+
+    if (irPtr) {
 	FsPath *fsPathPtr = PATHOBJ(pathPtr);
 
 	if (PATHFLAGS(pathPtr) != 0) {
@@ -864,6 +862,7 @@ TclJoinPath(
 
     if (elements == 2) {
 	Tcl_Obj *elt = objv[0];
+	Tcl_ObjIntRep *eltIr = Tcl_FetchIntRep(elt, &fsPathType);
 
 	/*
 	 * This is a special case where we can be much more efficient, where
@@ -877,7 +876,7 @@ TclJoinPath(
 	 * to be an absolute path. Added a check for that elt is absolute.
 	 */
 
-	if ((elt->typePtr == &tclFsPathType)
+	if ((eltIr)
 		&& !((elt->bytes != NULL) && (elt->bytes[0] == '\0'))
                 && TclGetPathType(elt, NULL, NULL, NULL) == TCL_PATH_ABSOLUTE) {
             Tcl_Obj *tailObj = objv[1];
@@ -1154,6 +1153,8 @@ Tcl_FSConvertToPathType(
     Tcl_Obj *pathPtr)		/* Object to convert to a valid, current path
 				 * type. */
 {
+    Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(pathPtr, &fsPathType);
+
     /*
      * While it is bad practice to examine an object's type directly, this is
      * actually the best thing to do here. The reason is that if we are
@@ -1164,39 +1165,16 @@ Tcl_FSConvertToPathType(
      * path.
      */
 
-    if (pathPtr->typePtr == &tclFsPathType) {
+    if (irPtr) {
 	if (TclFSEpochOk(PATHOBJ(pathPtr)->filesystemEpoch)) {
 	    return TCL_OK;
 	}
 
-	if (pathPtr->bytes == NULL) {
-	    UpdateStringOfFsPath(pathPtr);
-	}
-	FreeFsPathInternalRep(pathPtr);
+	TclGetString(pathPtr);
+	Tcl_StoreIntRep(pathPtr, &fsPathType, NULL);
     }
 
     return SetFsPathFromAny(interp, pathPtr);
-
-    /*
-     * We used to have more complex code here:
-     *
-     * FsPath *fsPathPtr = PATHOBJ(pathPtr);
-     * if (fsPathPtr->cwdPtr == NULL || PATHFLAGS(pathPtr) != 0) {
-     *     return TCL_OK;
-     * } else {
-     *     if (TclFSCwdPointerEquals(&fsPathPtr->cwdPtr)) {
-     *         return TCL_OK;
-     *     } else {
-     *         if (pathPtr->bytes == NULL) {
-     *             UpdateStringOfFsPath(pathPtr);
-     *         }
-     *         FreeFsPathInternalRep(pathPtr);
-     *         return Tcl_ConvertToType(interp, pathPtr, &tclFsPathType);
-     *     }
-     * }
-     *
-     * But we no longer believe this is necessary.
-     */
 }
 
 /*
@@ -1328,9 +1306,7 @@ TclNewFSPathObj(
 
     SETPATHOBJ(pathPtr, fsPathPtr);
     PATHFLAGS(pathPtr) = TCLPATH_APPENDED;
-    pathPtr->typePtr = &tclFsPathType;
-    pathPtr->bytes = NULL;
-    pathPtr->length = 0;
+    TclInvalidateStringRep(pathPtr);
 
     /*
      * Look for path components made up of only "."
@@ -1430,8 +1406,9 @@ TclFSMakePathRelative(
 {
     int cwdLen, len;
     const char *tempStr;
+    Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(pathPtr, &fsPathType);
 
-    if (pathPtr->typePtr == &tclFsPathType) {
+    if (irPtr) {
 	FsPath *fsPathPtr = PATHOBJ(pathPtr);
 
 	if (PATHFLAGS(pathPtr) != 0 && fsPathPtr->cwdPtr == cwdPtr) {
@@ -1498,31 +1475,12 @@ MakePathFromNormalized(
     Tcl_Obj *pathPtr)		/* The object to convert. */
 {
     FsPath *fsPathPtr;
+    Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(pathPtr, &fsPathType);
 
-    if (pathPtr->typePtr == &tclFsPathType) {
+    if (irPtr) {
 	return TCL_OK;
     }
 
-    /*
-     * Free old representation
-     */
-
-    if (pathPtr->typePtr != NULL) {
-	if (pathPtr->bytes == NULL) {
-	    if (pathPtr->typePtr->updateStringProc == NULL) {
-		if (interp != NULL) {
-		    Tcl_SetObjResult(interp, Tcl_NewStringObj(
-			    "can't find object string representation", -1));
-		    Tcl_SetErrorCode(interp, "TCL", "VALUE", "PATH", "WTF",
-			    NULL);
-		}
-		return TCL_ERROR;
-	    }
-	    pathPtr->typePtr->updateStringProc(pathPtr);
-	}
-	TclFreeIntRep(pathPtr);
-    }
-
     fsPathPtr = ckalloc(sizeof(FsPath));
 
     /*
@@ -1531,11 +1489,7 @@ MakePathFromNormalized(
 
     fsPathPtr->translatedPathPtr = NULL;
 
-    /*
-     * Circular reference by design.
-     */
-
-    fsPathPtr->normPathPtr = pathPtr;
+    Tcl_IncrRefCount(fsPathPtr->normPathPtr = Tcl_DuplicateObj(pathPtr));
     fsPathPtr->cwdPtr = NULL;
     fsPathPtr->nativePathPtr = NULL;
     fsPathPtr->fsPtr = NULL;
@@ -1544,7 +1498,6 @@ MakePathFromNormalized(
 
     SETPATHOBJ(pathPtr, fsPathPtr);
     PATHFLAGS(pathPtr) = 0;
-    pathPtr->typePtr = &tclFsPathType;
 
     return TCL_OK;
 }
@@ -1595,25 +1548,12 @@ Tcl_FSNewNativePath(
      * safe.
      */
 
-    if (pathPtr->typePtr != NULL) {
-	if (pathPtr->bytes == NULL) {
-	    if (pathPtr->typePtr->updateStringProc == NULL) {
-		return NULL;
-	    }
-	    pathPtr->typePtr->updateStringProc(pathPtr);
-	}
-	TclFreeIntRep(pathPtr);
-    }
-
+    Tcl_StoreIntRep(pathPtr, &fsPathType, NULL);
     fsPathPtr = ckalloc(sizeof(FsPath));
 
     fsPathPtr->translatedPathPtr = NULL;
 
-    /*
-     * Circular reference, by design.
-     */
-
-    fsPathPtr->normPathPtr = pathPtr;
+    Tcl_IncrRefCount(fsPathPtr->normPathPtr = Tcl_DuplicateObj(pathPtr));
     fsPathPtr->cwdPtr = NULL;
     fsPathPtr->nativePathPtr = clientData;
     fsPathPtr->fsPtr = fromFilesystem;
@@ -1621,7 +1561,6 @@ Tcl_FSNewNativePath(
 
     SETPATHOBJ(pathPtr, fsPathPtr);
     PATHFLAGS(pathPtr) = 0;
-    pathPtr->typePtr = &tclFsPathType;
 
     return pathPtr;
 }
@@ -1668,20 +1607,22 @@ Tcl_FSGetTranslatedPath(
 
 	    Tcl_Obj *translatedCwdPtr = Tcl_FSGetTranslatedPath(interp,
 		    srcFsPathPtr->cwdPtr);
+	    Tcl_ObjIntRep *translatedCwdIrPtr;
+
 	    if (translatedCwdPtr == NULL) {
 		return NULL;
 	    }
 
 	    retObj = Tcl_FSJoinToPath(translatedCwdPtr, 1,
 		    &srcFsPathPtr->normPathPtr);
-	    srcFsPathPtr->translatedPathPtr = retObj;
-	    if (translatedCwdPtr->typePtr == &tclFsPathType) {
+	    Tcl_IncrRefCount(srcFsPathPtr->translatedPathPtr = retObj);
+	    translatedCwdIrPtr = Tcl_FetchIntRep(translatedCwdPtr, &fsPathType);
+	    if (translatedCwdIrPtr) {
 		srcFsPathPtr->filesystemEpoch
 			= PATHOBJ(translatedCwdPtr)->filesystemEpoch;
 	    } else {
 		srcFsPathPtr->filesystemEpoch = 0;
 	    }
-	    Tcl_IncrRefCount(retObj);
 	    Tcl_DecrRefCount(translatedCwdPtr);
 	} else {
 	    /*
@@ -1791,9 +1732,7 @@ Tcl_FSGetNormalizedPath(
 	    return NULL;
 	}
 	/* TODO: Figure out why this is needed. */
-	if (pathPtr->bytes == NULL) {
-	    UpdateStringOfFsPath(pathPtr);
-	}
+	TclGetString(pathPtr);
 
 	TclGetStringFromObj(fsPathPtr->normPathPtr, &tailLen);
 	if (tailLen) {
@@ -1845,7 +1784,7 @@ Tcl_FSGetNormalizedPath(
 
 	    /*
 	     * NOTE: here we are (dangerously?) assuming that origDir points
-	     * to a Tcl_Obj with Tcl_ObjType == &tclFsPathType. The
+	     * to a Tcl_Obj with Tcl_ObjType == &fsPathType. The
 	     *     pathType = Tcl_FSGetPathType(fsPathPtr->cwdPtr);
 	     * above that set the pathType value should have established that,
 	     * but it's far less clear on what basis we know there's been no
@@ -1863,6 +1802,7 @@ Tcl_FSGetNormalizedPath(
 	    /*
 	     * That's our reference to copy used.
 	     */
+	    copy = NULL;
 
 	    TclDecrRefCount(dir);
 	    TclDecrRefCount(origDir);
@@ -1875,7 +1815,7 @@ Tcl_FSGetNormalizedPath(
 	    /*
 	     * That's our reference to copy used.
 	     */
-
+	    copy = NULL;
 	    TclDecrRefCount(dir);
 	}
 	PATHFLAGS(pathPtr) = 0;
@@ -1887,10 +1827,8 @@ Tcl_FSGetNormalizedPath(
 
     if (fsPathPtr->cwdPtr != NULL) {
 	if (!TclFSCwdPointerEquals(&fsPathPtr->cwdPtr)) {
-	    if (pathPtr->bytes == NULL) {
-		UpdateStringOfFsPath(pathPtr);
-	    }
-	    FreeFsPathInternalRep(pathPtr);
+	    TclGetString(pathPtr);
+	    Tcl_StoreIntRep(pathPtr, &fsPathType, NULL);
 	    if (SetFsPathFromAny(interp, pathPtr) != TCL_OK) {
 		return NULL;
 	    }
@@ -1916,7 +1854,6 @@ Tcl_FSGetNormalizedPath(
     }
     if (fsPathPtr->normPathPtr == NULL) {
 	Tcl_Obj *useThisCwd = NULL;
-	int pureNormalized = 1;
 
 	/*
 	 * Since normPathPtr is NULL, but this is a valid path object, we know
@@ -1966,7 +1903,6 @@ Tcl_FSGetNormalizedPath(
 		    return NULL;
 		}
 
-		pureNormalized = 0;
 		Tcl_DecrRefCount(absolutePath);
 		absolutePath = Tcl_FSJoinToPath(useThisCwd, 1, &absolutePath);
 		Tcl_IncrRefCount(absolutePath);
@@ -1986,7 +1922,6 @@ Tcl_FSGetNormalizedPath(
 		if (absolutePath == NULL) {
 		    return NULL;
 		}
-		pureNormalized = 0;
 #endif /* _WIN32 */
 	    }
 	}
@@ -1995,35 +1930,12 @@ Tcl_FSGetNormalizedPath(
 	 * Already has refCount incremented.
 	 */
 
+	if (fsPathPtr->normPathPtr) {
+	    Tcl_DecrRefCount(fsPathPtr->normPathPtr);
+	}
 	fsPathPtr->normPathPtr = TclFSNormalizeAbsolutePath(interp,
 		absolutePath);
 
-	/*
-	 * Check if path is pure normalized (this can only be the case if it
-	 * is an absolute path).
-	 */
-
-	if (pureNormalized) {
-	    int normPathLen, pathLen;
-	    const char *normPath;
-
-	    path = TclGetStringFromObj(pathPtr, &pathLen);
-	    normPath = TclGetStringFromObj(fsPathPtr->normPathPtr, &normPathLen);
-	    if ((pathLen == normPathLen) && !memcmp(path, normPath, pathLen)) {
-		/*
-		 * The path was already normalized. Get rid of the duplicate.
-		 */
-
-		TclDecrRefCount(fsPathPtr->normPathPtr);
-
-		/*
-		 * We do *not* increment the refCount for this circular
-		 * reference.
-		 */
-
-		fsPathPtr->normPathPtr = pathPtr;
-	    }
-	}
 	if (useThisCwd != NULL) {
 	    /*
 	     * We just need to free an object we allocated above for relative
@@ -2169,8 +2081,9 @@ TclFSEnsureEpochOk(
     const Tcl_Filesystem **fsPtrPtr)
 {
     FsPath *srcFsPathPtr;
+    Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(pathPtr, &fsPathType);
 
-    if (pathPtr->typePtr != &tclFsPathType) {
+    if (irPtr == NULL) {
 	return TCL_OK;
     }
 
@@ -2186,10 +2099,8 @@ TclFSEnsureEpochOk(
 	 * We have to discard the stale representation and recalculate it.
 	 */
 
-	if (pathPtr->bytes == NULL) {
-	    UpdateStringOfFsPath(pathPtr);
-	}
-	FreeFsPathInternalRep(pathPtr);
+	TclGetString(pathPtr);
+	Tcl_StoreIntRep(pathPtr, &fsPathType, NULL);
 	if (SetFsPathFromAny(NULL, pathPtr) != TCL_OK) {
 	    return TCL_ERROR;
 	}
@@ -2229,12 +2140,13 @@ TclFSSetPathDetails(
     ClientData clientData)
 {
     FsPath *srcFsPathPtr;
+    Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(pathPtr, &fsPathType);;
 
     /*
      * Make sure pathPtr is of the correct type.
      */
 
-    if (pathPtr->typePtr != &tclFsPathType) {
+    if (irPtr == NULL) {
 	if (SetFsPathFromAny(NULL, pathPtr) != TCL_OK) {
 	    return;
 	}
@@ -2332,8 +2244,9 @@ SetFsPathFromAny(
     FsPath *fsPathPtr;
     Tcl_Obj *transPtr;
     char *name;
+    Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(pathPtr, &fsPathType);
 
-    if (pathPtr->typePtr == &tclFsPathType) {
+    if (irPtr) {
 	return TCL_OK;
     }
 
@@ -2475,27 +2388,21 @@ SetFsPathFromAny(
 
     fsPathPtr = ckalloc(sizeof(FsPath));
 
-    fsPathPtr->translatedPathPtr = transPtr;
-    if (transPtr != pathPtr) {
-	Tcl_IncrRefCount(fsPathPtr->translatedPathPtr);
-	/* Redo translation when $env(HOME) changes */
-	fsPathPtr->filesystemEpoch = TclFSEpoch();
+    if (transPtr == pathPtr) {
+        transPtr = Tcl_DuplicateObj(pathPtr);
+        fsPathPtr->filesystemEpoch = 0;
     } else {
-	fsPathPtr->filesystemEpoch = 0;
+        fsPathPtr->filesystemEpoch = TclFSEpoch();
     }
+    Tcl_IncrRefCount(transPtr);
+    fsPathPtr->translatedPathPtr = transPtr;
     fsPathPtr->normPathPtr = NULL;
     fsPathPtr->cwdPtr = NULL;
     fsPathPtr->nativePathPtr = NULL;
     fsPathPtr->fsPtr = NULL;
 
-    /*
-     * Free old representation before installing our new one.
-     */
-
-    TclFreeIntRep(pathPtr);
     SETPATHOBJ(pathPtr, fsPathPtr);
     PATHFLAGS(pathPtr) = 0;
-    pathPtr->typePtr = &tclFsPathType;
     return TCL_OK;
 }
 
@@ -2518,6 +2425,7 @@ FreeFsPathInternalRep(
     }
     if (fsPathPtr->cwdPtr != NULL) {
 	TclDecrRefCount(fsPathPtr->cwdPtr);
+	fsPathPtr->cwdPtr = NULL;
     }
     if (fsPathPtr->nativePathPtr != NULL && fsPathPtr->fsPtr != NULL) {
 	Tcl_FSFreeInternalRepProc *freeProc =
@@ -2530,7 +2438,6 @@ FreeFsPathInternalRep(
     }
 
     ckfree(fsPathPtr);
-    pathPtr->typePtr = NULL;
 }
 
 static void
@@ -2543,24 +2450,14 @@ DupFsPathInternalRep(
 
     SETPATHOBJ(copyPtr, copyFsPathPtr);
 
-    if (srcFsPathPtr->translatedPathPtr == srcPtr) {
-	/* Cycle in src -> make cycle in copy. */
-	copyFsPathPtr->translatedPathPtr = copyPtr;
-    } else {
-	copyFsPathPtr->translatedPathPtr = srcFsPathPtr->translatedPathPtr;
-	if (copyFsPathPtr->translatedPathPtr != NULL) {
-	    Tcl_IncrRefCount(copyFsPathPtr->translatedPathPtr);
-	}
+    copyFsPathPtr->translatedPathPtr = srcFsPathPtr->translatedPathPtr;
+    if (copyFsPathPtr->translatedPathPtr != NULL) {
+	Tcl_IncrRefCount(copyFsPathPtr->translatedPathPtr);
     }
 
-    if (srcFsPathPtr->normPathPtr == srcPtr) {
-	/* Cycle in src -> make cycle in copy. */
-	copyFsPathPtr->normPathPtr = copyPtr;
-    } else {
-	copyFsPathPtr->normPathPtr = srcFsPathPtr->normPathPtr;
-	if (copyFsPathPtr->normPathPtr != NULL) {
-	    Tcl_IncrRefCount(copyFsPathPtr->normPathPtr);
-	}
+    copyFsPathPtr->normPathPtr = srcFsPathPtr->normPathPtr;
+    if (copyFsPathPtr->normPathPtr != NULL) {
+	Tcl_IncrRefCount(copyFsPathPtr->normPathPtr);
     }
 
     copyFsPathPtr->cwdPtr = srcFsPathPtr->cwdPtr;
@@ -2586,8 +2483,6 @@ DupFsPathInternalRep(
     }
     copyFsPathPtr->fsPtr = srcFsPathPtr->fsPtr;
     copyFsPathPtr->filesystemEpoch = srcFsPathPtr->filesystemEpoch;
-
-    copyPtr->typePtr = &tclFsPathType;
 }
 
 /*
@@ -2619,11 +2514,15 @@ UpdateStringOfFsPath(
     }
 
     copy = AppendPath(fsPathPtr->cwdPtr, fsPathPtr->normPathPtr);
+    if (Tcl_IsShared(copy)) {
+	copy = Tcl_DuplicateObj(copy);
+    }
 
+    Tcl_IncrRefCount(copy);
+    /* Steal copy's string rep */
     pathPtr->bytes = TclGetStringFromObj(copy, &cwdLen);
     pathPtr->length = cwdLen;
-    copy->bytes = &tclEmptyString;
-    copy->length = 0;
+    TclInitStringRep(copy, NULL, 0);
     TclDecrRefCount(copy);
 }
 
@@ -2653,6 +2552,8 @@ TclNativePathInFilesystem(
     Tcl_Obj *pathPtr,
     ClientData *clientDataPtr)
 {
+    Tcl_ObjIntRep *irPtr = Tcl_FetchIntRep(pathPtr, &fsPathType);
+
     /*
      * A special case is required to handle the empty path "". This is a valid
      * path (i.e. the user should be able to do 'file exists ""' without
@@ -2660,7 +2561,7 @@ TclNativePathInFilesystem(
      * semantics of Tcl (at present anyway), so we have to abide by them here.
      */
 
-    if (pathPtr->typePtr == &tclFsPathType) {
+    if (irPtr) {
 	if (pathPtr->bytes != NULL && pathPtr->bytes[0] == '\0') {
 	    /*
 	     * We reject the empty path "".
@@ -2675,7 +2576,7 @@ TclNativePathInFilesystem(
     } else {
 	/*
 	 * It is somewhat unusual to reach this code path without the object
-	 * being of tclFsPathType. However, we do our best to deal with the
+	 * being of fsPathType. However, we do our best to deal with the
 	 * situation.
 	 */
 

generic/tclProc.c

@@ -15,6 +15,7 @@
 
 #include "tclInt.h"
 #include "tclCompile.h"
+#include <assert.h>
 
 /*
  * Variables that are part of the [apply] command implementation and which
@@ -67,6 +68,22 @@ const Tcl_ObjType tclProcBodyType = {
 				 * should panic instead. */
 };
 
+#define ProcSetIntRep(objPtr, procPtr)					\
+    do {								\
+	Tcl_ObjIntRep ir;						\
+	(procPtr)->refCount++;						\
+	ir.twoPtrValue.ptr1 = (procPtr);				\
+	ir.twoPtrValue.ptr2 = NULL;					\
+	Tcl_StoreIntRep((objPtr), &tclProcBodyType, &ir);		\
+    } while (0)
+
+#define ProcGetIntRep(objPtr, procPtr)					\
+    do {								\
+	const Tcl_ObjIntRep *irPtr;					\
+	irPtr = Tcl_FetchIntRep((objPtr), &tclProcBodyType);		\
+	(procPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL;		\
+    } while (0)
+
 /*
  * The [upvar]/[uplevel] level reference type. Uses the longValue field
  * to remember the integer value of a parsed #<integer> format.
@@ -89,13 +106,31 @@ static const Tcl_ObjType levelReferenceType = {
  * will execute within. IF YOU CHANGE THIS, CHECK IN tclDisassemble.c TOO.
  */
 
-const Tcl_ObjType tclLambdaType = {
+static const Tcl_ObjType lambdaType = {
     "lambdaExpr",		/* name */
     FreeLambdaInternalRep,	/* freeIntRepProc */
     DupLambdaInternalRep,	/* dupIntRepProc */
     NULL,			/* updateStringProc */
     SetLambdaFromAny		/* setFromAnyProc */
 };
+
+#define LambdaSetIntRep(objPtr, procPtr, nsObjPtr)			\
+    do {								\
+	Tcl_ObjIntRep ir;						\
+	ir.twoPtrValue.ptr1 = (procPtr);				\
+	ir.twoPtrValue.ptr2 = (nsObjPtr);				\
+	Tcl_IncrRefCount((nsObjPtr));					\
+	Tcl_StoreIntRep((objPtr), &lambdaType, &ir);			\
+    } while (0)
+
+#define LambdaGetIntRep(objPtr, procPtr, nsObjPtr)			\
+    do {								\
+	const Tcl_ObjIntRep *irPtr;					\
+	irPtr = Tcl_FetchIntRep((objPtr), &lambdaType);			\
+	(procPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL;		\
+	(nsObjPtr) = irPtr ? irPtr->twoPtrValue.ptr2 : NULL;		\
+    } while (0)
+
 
 /*
  *----------------------------------------------------------------------
@@ -294,7 +329,7 @@ Tcl_ProcObjCmd(
      *	   of all procs whose argument list is just _args_
      */
 
-    if (objv[3]->typePtr == &tclProcBodyType) {
+    if (Tcl_FetchIntRep(objv[3], &tclProcBodyType)) {
 	goto done;
     }
 
@@ -370,7 +405,7 @@ TclCreateProc(
 {
     Interp *iPtr = (Interp *) interp;
 
-    register Proc *procPtr;
+    register Proc *procPtr = NULL;
     int i, result, numArgs, plen;
     const char *bytes, *argname, *argnamei;
     char argnamelast;
@@ -378,7 +413,8 @@ TclCreateProc(
     Tcl_Obj *defPtr, *errorObj, **argArray;
     int precompiled = 0;
 
-    if (bodyPtr->typePtr == &tclProcBodyType) {
+    ProcGetIntRep(bodyPtr, procPtr);
+    if (procPtr != NULL) {
 	/*
 	 * Because the body is a TclProProcBody, the actual body is already
 	 * compiled, and it is not shared with anyone else, so it's OK not to
@@ -391,7 +427,6 @@ TclCreateProc(
 	 * will be holding a reference to it.
 	 */
 
-	procPtr = bodyPtr->internalRep.twoPtrValue.ptr1;
 	procPtr->iPtr = iPtr;
 	procPtr->refCount++;
 	precompiled = 1;
@@ -733,6 +768,7 @@ TclObjGetFrame(
 {
     register Interp *iPtr = (Interp *) interp;
     int curLevel, level, result;
+    const Tcl_ObjIntRep *irPtr;
     const char *name = NULL;
     Tcl_WideInt w;
 
@@ -758,8 +794,8 @@ TclObjGetFrame(
 	    level = curLevel - level;
 	    result = 1;
 	}
-    } else if (objPtr->typePtr == &levelReferenceType) {
-	level = (int) objPtr->internalRep.wideValue;
+    } else if ((irPtr = Tcl_FetchIntRep(objPtr, &levelReferenceType))) {
+	level = irPtr->wideValue;
 	result = 1;
     } else {
 	name = TclGetString(objPtr);
@@ -768,9 +804,10 @@ TclObjGetFrame(
 		if (level < 0 || (level > 0 && name[1] == '-')) {
 		    result = -1;
 		} else {
-		    TclFreeIntRep(objPtr);
-		    objPtr->typePtr = &levelReferenceType;
-		    objPtr->internalRep.wideValue = level;
+		    Tcl_ObjIntRep ir;
+
+		    ir.wideValue = level;
+		    Tcl_StoreIntRep(objPtr, &levelReferenceType, &ir);
 		    result = 1;
 		}
 	    } else {
@@ -1094,10 +1131,10 @@ TclInitCompiledLocals(
     ByteCode *codePtr;
 
     bodyPtr = framePtr->procPtr->bodyPtr;
-    if (bodyPtr->typePtr != &tclByteCodeType) {
+    ByteCodeGetIntRep(bodyPtr, &tclByteCodeType, codePtr);
+    if (codePtr == NULL) {
 	Tcl_Panic("body object for proc attached to frame is not a byte code type");
     }
-    codePtr = bodyPtr->internalRep.twoPtrValue.ptr1;
 
     if (framePtr->numCompiledLocals) {
 	if (!codePtr->localCachePtr) {
@@ -1260,7 +1297,7 @@ InitLocalCache(
     Proc *procPtr)
 {
     Interp *iPtr = procPtr->iPtr;
-    ByteCode *codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;
+    ByteCode *codePtr;
     int localCt = procPtr->numCompiledLocals;
     int numArgs = procPtr->numArgs, i = 0;
 
@@ -1270,6 +1307,8 @@ InitLocalCache(
     CompiledLocal *localPtr;
     int new;
 
+    ByteCodeGetIntRep(procPtr->bodyPtr, &tclByteCodeType, codePtr);
+
     /*
      * Cache the names and initial values of local variables; store the
      * cache in both the framePtr for this execution and in the codePtr
@@ -1337,11 +1376,13 @@ InitArgsAndLocals(
 {
     CallFrame *framePtr = ((Interp *)interp)->varFramePtr;
     register Proc *procPtr = framePtr->procPtr;
-    ByteCode *codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;
+    ByteCode *codePtr;
     register Var *varPtr, *defPtr;
     int localCt = procPtr->numCompiledLocals, numArgs, argCt, i, imax;
     Tcl_Obj *const *argObjs;
 
+    ByteCodeGetIntRep(procPtr->bodyPtr, &tclByteCodeType, codePtr);
+
     /*
      * Make sure that the local cache of variable names and initial values has
      * been initialised properly .
@@ -1516,7 +1557,8 @@ TclPushProcCallFrame(
      * local variables are found while compiling.
      */
 
-    if (procPtr->bodyPtr->typePtr == &tclByteCodeType) {
+    ByteCodeGetIntRep(procPtr->bodyPtr, &tclByteCodeType, codePtr);
+    if (codePtr != NULL) {
 	Interp *iPtr = (Interp *) interp;
 
 	/*
@@ -1528,7 +1570,6 @@ TclPushProcCallFrame(
 	 * commands and/or resolver changes are considered).
 	 */
 
-	codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;
 	if (((Interp *) *codePtr->interpHandle != iPtr)
 		|| (codePtr->compileEpoch != iPtr->compileEpoch)
 		|| (codePtr->nsPtr != nsPtr)
@@ -1726,7 +1767,7 @@ TclNRInterpProcCore(
      */
 
     procPtr->refCount++;
-    codePtr = procPtr->bodyPtr->internalRep.twoPtrValue.ptr1;
+    ByteCodeGetIntRep(procPtr->bodyPtr, &tclByteCodeType, codePtr);
 
     TclNRAddCallback(interp, InterpProcNR2, procNameObj, errorProc,
 	    NULL, NULL);
@@ -1860,7 +1901,9 @@ TclProcCompileProc(
 {
     Interp *iPtr = (Interp *) interp;
     Tcl_CallFrame *framePtr;
-    ByteCode *codePtr = bodyPtr->internalRep.twoPtrValue.ptr1;
+    ByteCode *codePtr;
+
+    ByteCodeGetIntRep(bodyPtr, &tclByteCodeType, codePtr);
 
     /*
      * If necessary, compile the procedure's body. The compiler will allocate
@@ -1876,7 +1919,7 @@ TclProcCompileProc(
      * are not recompiled, even if things have changed.
      */
 
-    if (bodyPtr->typePtr == &tclByteCodeType) {
+    if (codePtr != NULL) {
 	if (((Interp *) *codePtr->interpHandle == iPtr)
 		&& (codePtr->compileEpoch == iPtr->compileEpoch)
 		&& (codePtr->nsPtr == nsPtr)
@@ -1895,11 +1938,12 @@ TclProcCompileProc(
 	    codePtr->compileEpoch = iPtr->compileEpoch;
 	    codePtr->nsPtr = nsPtr;
 	} else {
-	    TclFreeIntRep(bodyPtr);
+	    Tcl_StoreIntRep(bodyPtr, &tclByteCodeType, NULL);
+	    codePtr = NULL;
 	}
     }
 
-    if (bodyPtr->typePtr != &tclByteCodeType) {
+    if (codePtr == NULL) {
 	Tcl_HashEntry *hePtr;
 
 #ifdef TCL_COMPILE_DEBUG
@@ -2248,10 +2292,7 @@ TclNewProcBodyObj(
 
     TclNewObj(objPtr);
     if (objPtr) {
-	objPtr->typePtr = &tclProcBodyType;
-	objPtr->internalRep.twoPtrValue.ptr1 = procPtr;
-
-	procPtr->refCount++;
+	ProcSetIntRep(objPtr, procPtr);
     }
 
     return objPtr;
@@ -2279,11 +2320,10 @@ ProcBodyDup(
     Tcl_Obj *srcPtr,		/* Object to copy. */
     Tcl_Obj *dupPtr)		/* Target object for the duplication. */
 {
-    Proc *procPtr = srcPtr->internalRep.twoPtrValue.ptr1;
+    Proc *procPtr;
+    ProcGetIntRep(srcPtr, procPtr);
 
-    dupPtr->typePtr = &tclProcBodyType;
-    dupPtr->internalRep.twoPtrValue.ptr1 = procPtr;
-    procPtr->refCount++;
+    ProcSetIntRep(dupPtr, procPtr);
 }
 
 /*
@@ -2309,7 +2349,9 @@ static void
 ProcBodyFree(
     Tcl_Obj *objPtr)		/* The object to clean up. */
 {
-    Proc *procPtr = objPtr->internalRep.twoPtrValue.ptr1;
+    Proc *procPtr;
+
+    ProcGetIntRep(objPtr, procPtr);
 
     if (procPtr->refCount-- <= 1) {
 	TclProcCleanupProc(procPtr);
@@ -2335,15 +2377,15 @@ DupLambdaInternalRep(
     Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
     register Tcl_Obj *copyPtr)	/* Object with internal rep to set. */
 {
-    Proc *procPtr = srcPtr->internalRep.twoPtrValue.ptr1;
-    Tcl_Obj *nsObjPtr = srcPtr->internalRep.twoPtrValue.ptr2;
+    Proc *procPtr;
+    Tcl_Obj *nsObjPtr;
 
-    copyPtr->internalRep.twoPtrValue.ptr1 = procPtr;
-    copyPtr->internalRep.twoPtrValue.ptr2 = nsObjPtr;
+    LambdaGetIntRep(srcPtr, procPtr, nsObjPtr);
+    assert(procPtr != NULL);
 
     procPtr->refCount++;
-    Tcl_IncrRefCount(nsObjPtr);
-    copyPtr->typePtr = &tclLambdaType;
+
+    LambdaSetIntRep(copyPtr, procPtr, nsObjPtr);
 }
 
 static void
@@ -2351,14 +2393,16 @@ FreeLambdaInternalRep(
     register Tcl_Obj *objPtr)	/* CmdName object with internal representation
 				 * to free. */
 {
-    Proc *procPtr = objPtr->internalRep.twoPtrValue.ptr1;
-    Tcl_Obj *nsObjPtr = objPtr->internalRep.twoPtrValue.ptr2;
+    Proc *procPtr;
+    Tcl_Obj *nsObjPtr;
+
+    LambdaGetIntRep(objPtr, procPtr, nsObjPtr);
+    assert(procPtr != NULL);
 
     if (procPtr->refCount-- <= 1) {
 	TclProcCleanupProc(procPtr);
     }
     TclDecrRefCount(nsObjPtr);
-    objPtr->typePtr = NULL;
 }
 
 static int
@@ -2379,7 +2423,7 @@ SetLambdaFromAny(
 
     /*
      * Convert objPtr to list type first; if it cannot be converted, or if its
-     * length is not 2, then it cannot be converted to tclLambdaType.
+     * length is not 2, then it cannot be converted to lambdaType.
      */
 
     result = TclListObjGetElements(NULL, objPtr, &objc, &objv);
@@ -2520,21 +2564,42 @@ SetLambdaFromAny(
 	}
     }
 
-    Tcl_IncrRefCount(nsObjPtr);
-
     /*
      * Free the list internalrep of objPtr - this will free argsPtr, but
      * bodyPtr retains a reference from the Proc structure. Then finish the
-     * conversion to tclLambdaType.
+     * conversion to lambdaType.
      */
 
-    TclFreeIntRep(objPtr);
-
-    objPtr->internalRep.twoPtrValue.ptr1 = procPtr;
-    objPtr->internalRep.twoPtrValue.ptr2 = nsObjPtr;
-    objPtr->typePtr = &tclLambdaType;
+    LambdaSetIntRep(objPtr, procPtr, nsObjPtr);
     return TCL_OK;
 }
+
+Proc *
+TclGetLambdaFromObj(
+    Tcl_Interp *interp,
+    Tcl_Obj *objPtr,
+    Tcl_Obj **nsObjPtrPtr)
+{
+    Proc *procPtr;
+    Tcl_Obj *nsObjPtr;
+
+    LambdaGetIntRep(objPtr, procPtr, nsObjPtr);
+
+    if (procPtr == NULL) {
+	if (SetLambdaFromAny(interp, objPtr) != TCL_OK) {
+	    return NULL;
+	}
+	LambdaGetIntRep(objPtr, procPtr, nsObjPtr);
+    }
+
+    assert(procPtr != NULL);
+    if (procPtr->iPtr != (Interp *)interp) {
+	return NULL;
+    }
+
+    *nsObjPtrPtr = nsObjPtr;
+    return procPtr;
+}
 
 /*
  *----------------------------------------------------------------------
@@ -2570,7 +2635,6 @@ TclNRApplyObjCmd(
     int objc,			/* Number of arguments. */
     Tcl_Obj *const objv[])	/* Argument objects. */
 {
-    Interp *iPtr = (Interp *) interp;
     Proc *procPtr = NULL;
     Tcl_Obj *lambdaPtr, *nsObjPtr;
     int result;
@@ -2588,24 +2652,17 @@ TclNRApplyObjCmd(
      */
 
     lambdaPtr = objv[1];
-    if (lambdaPtr->typePtr == &tclLambdaType) {
-	procPtr = lambdaPtr->internalRep.twoPtrValue.ptr1;
-    }
+    procPtr = TclGetLambdaFromObj(interp, lambdaPtr, &nsObjPtr);
 
-    if ((procPtr == NULL) || (procPtr->iPtr != iPtr)) {
-	result = SetLambdaFromAny(interp, lambdaPtr);
-	if (result != TCL_OK) {
-	    return result;
-	}
-	procPtr = lambdaPtr->internalRep.twoPtrValue.ptr1;
+    if (procPtr == NULL) {
+	return TCL_ERROR;
     }
 
     /*
-     * Find the namespace where this lambda should run, and push a call frame
-     * for that namespace. Note that TclObjInterpProc() will pop it.
+     * Push a call frame for the lambda namespace.
+     * Note that TclObjInterpProc() will pop it.
      */
 
-    nsObjPtr = lambdaPtr->internalRep.twoPtrValue.ptr2;
     result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr);
     if (result != TCL_OK) {
 	return TCL_ERROR;

generic/tclRegexp.c

@@ -13,6 +13,7 @@
 
 #include "tclInt.h"
 #include "tclRegexp.h"
+#include <assert.h>
 
 /*
  *----------------------------------------------------------------------
@@ -107,6 +108,23 @@ const Tcl_ObjType tclRegexpType = {
     NULL,				/* updateStringProc */
     SetRegexpFromAny			/* setFromAnyProc */
 };
+
+#define RegexpSetIntRep(objPtr, rePtr)					\
+    do {								\
+	Tcl_ObjIntRep ir;						\
+	(rePtr)->refCount++;						\
+	ir.twoPtrValue.ptr1 = (rePtr);					\
+	ir.twoPtrValue.ptr2 = NULL;					\
+	Tcl_StoreIntRep((objPtr), &tclRegexpType, &ir);			\
+    } while (0)
+
+#define RegexpGetIntRep(objPtr, rePtr)					\
+    do {								\
+	const Tcl_ObjIntRep *irPtr;					\
+	irPtr = Tcl_FetchIntRep((objPtr), &tclRegexpType);		\
+	(rePtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL;		\
+    } while (0)
+
 
 /*
  *----------------------------------------------------------------------
@@ -580,14 +598,9 @@ Tcl_GetRegExpFromObj(
     TclRegexp *regexpPtr;
     const char *pattern;
 
-    /*
-     * This is OK because we only actually interpret this value properly as a
-     * TclRegexp* when the type is tclRegexpType.
-     */
+    RegexpGetIntRep(objPtr, regexpPtr);
 
-    regexpPtr = objPtr->internalRep.twoPtrValue.ptr1;
-
-    if ((objPtr->typePtr != &tclRegexpType) || (regexpPtr->flags != flags)) {
+    if ((regexpPtr == NULL) || (regexpPtr->flags != flags)) {
 	pattern = TclGetStringFromObj(objPtr, &length);
 
 	regexpPtr = CompileRegexp(interp, pattern, length, flags);
@@ -595,21 +608,7 @@ Tcl_GetRegExpFromObj(
 	    return NULL;
 	}
 
-	/*
-	 * Add a reference to the regexp so it will persist even if it is
-	 * pushed out of the current thread's regexp cache. This reference
-	 * will be removed when the object's internal rep is freed.
-	 */
-
-	regexpPtr->refCount++;
-
-	/*
-	 * Free the old representation and set our type.
-	 */
-
-	TclFreeIntRep(objPtr);
-	objPtr->internalRep.twoPtrValue.ptr1 = regexpPtr;
-	objPtr->typePtr = &tclRegexpType;
+	RegexpSetIntRep(objPtr, regexpPtr);
     }
     return (Tcl_RegExp) regexpPtr;
 }
@@ -756,7 +755,11 @@ static void
 FreeRegexpInternalRep(
     Tcl_Obj *objPtr)		/* Regexp object with internal rep to free. */
 {
-    TclRegexp *regexpRepPtr = objPtr->internalRep.twoPtrValue.ptr1;
+    TclRegexp *regexpRepPtr;
+
+    RegexpGetIntRep(objPtr, regexpRepPtr);
+
+    assert(regexpRepPtr != NULL);
 
     /*
      * If this is the last reference to the regexp, free it.
@@ -765,7 +768,6 @@ FreeRegexpInternalRep(
     if (regexpRepPtr->refCount-- <= 1) {
 	FreeRegexp(regexpRepPtr);
     }
-    objPtr->typePtr = NULL;
 }
 
 /*
@@ -790,11 +792,13 @@ DupRegexpInternalRep(
     Tcl_Obj *srcPtr,		/* Object with internal rep to copy. */
     Tcl_Obj *copyPtr)		/* Object with internal rep to set. */
 {
-    TclRegexp *regexpPtr = srcPtr->internalRep.twoPtrValue.ptr1;
+    TclRegexp *regexpPtr;
 
-    regexpPtr->refCount++;
-    copyPtr->internalRep.twoPtrValue.ptr1 = srcPtr->internalRep.twoPtrValue.ptr1;
-    copyPtr->typePtr = &tclRegexpType;
+    RegexpGetIntRep(srcPtr, regexpPtr);
+
+    assert(regexpPtr != NULL);
+
+    RegexpSetIntRep(copyPtr, regexpPtr);
 }
 
 /*

generic/tclScan.c

@@ -932,8 +932,7 @@ Tcl_ScanObjCmd(
 		    }
 		}
 		if ((flags & SCAN_UNSIGNED) && (wideValue < 0)) {
-		    sprintf(buf, "%" TCL_LL_MODIFIER "u",
-			    (Tcl_WideUInt)wideValue);
+		    sprintf(buf, "%" TCL_LL_MODIFIER "u", wideValue);
 		    Tcl_SetStringObj(objPtr, buf, -1);
 		} else {
 		    TclSetIntObj(objPtr, wideValue);
@@ -1010,8 +1009,10 @@ Tcl_ScanObjCmd(
 		double dvalue;
 		if (Tcl_GetDoubleFromObj(NULL, objPtr, &dvalue) != TCL_OK) {
 #ifdef ACCEPT_NAN
-		    if (objPtr->typePtr == &tclDoubleType) {
-			dvalue = objPtr->internalRep.doubleValue;
+		    const Tcl_ObjIntRep *irPtr
+			    = Tcl_FetchIntRep(objPtr, &tclDoubleType);
+		    if (irPtr) {
+			dvalue = irPtr->doubleValue;
 		    } else
 #endif
 		    {

generic/tclStringObj.c

@@ -4211,7 +4211,7 @@ UpdateStringOfString(
     stringPtr->allocated = 0;
 
     if (stringPtr->numChars == 0) {
-	TclInitStringRep(objPtr, &tclEmptyString, 0);
+	TclInitStringRep(objPtr, NULL, 0);
     } else {
 	(void) ExtendStringRepWithUnicode(objPtr, stringPtr->unicode,
 		stringPtr->numChars);

generic/tclStubInit.c

@@ -12,6 +12,10 @@
 #include "tclInt.h"
 #include "tommath.h"
 
+#ifdef __CYGWIN__
+#   include <wchar.h>
+#endif
+
 #ifdef __GNUC__
 #pragma GCC dependency "tcl.decls"
 #pragma GCC dependency "tclInt.decls"
@@ -225,31 +229,11 @@ Tcl_WinUtfToTChar(
     int len,
     Tcl_DString *dsPtr)
 {
-    WCHAR *wp, *p;
-    int size = MultiByteToWideChar(CP_UTF8, 0, string, len, 0, 0);
-
     Tcl_DStringInit(dsPtr);
-    Tcl_DStringSetLength(dsPtr, 2*size+2);
-    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;
+    if (!string) {
+	return NULL;
     }
-    Tcl_DStringSetLength(dsPtr, 2*size);
-    wp[size] = 0;
-    return (char *) wp;
+    return (char *)Tcl_UtfToUniCharDString(string, len, dsPtr);
 }
 
 char *
@@ -258,31 +242,16 @@ Tcl_WinTCharToUtf(
     int len,
     Tcl_DString *dsPtr)
 {
-    char *p;
-    int size, i = 0;
-
-    if (len > 0) {
+    Tcl_DStringInit(dsPtr);
+    if (!string) {
+	return NULL;
+    }
+    if (len < 0) {
+	len = wcslen((wchar_t *)string);
+    } else {
 	len /= 2;
     }
-    size = WideCharToMultiByte(CP_UTF8, 0, string, len, 0, 0, NULL, NULL);
-    Tcl_DStringInit(dsPtr);
-    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;
+    return Tcl_UniCharToUtfDString((Tcl_UniChar *)string, len, dsPtr);
 }
 
 #if defined(TCL_WIDE_INT_IS_LONG)
@@ -295,7 +264,7 @@ static int exprInt(Tcl_Interp *interp, const char *expr, int *ptr){
     long longValue;
     int result = Tcl_ExprLong(interp, expr, &longValue);
     if (result == TCL_OK) {
-	    if ((longValue >= -(long)(UINT_MAX))
+	    if ((longValue >= (long)(INT_MIN))
 		    && (longValue <= (long)(UINT_MAX))) {
 	    *ptr = (int)longValue;
 	} else {
@@ -311,7 +280,7 @@ static int exprIntObj(Tcl_Interp *interp, Tcl_Obj*expr, int *ptr){
     long longValue;
     int result = Tcl_ExprLongObj(interp, expr, &longValue);
     if (result == TCL_OK) {
-	    if ((longValue >= -(long)(UINT_MAX))
+	    if ((longValue >= (long)(INT_MIN))
 		    && (longValue <= (long)(UINT_MAX))) {
 	    *ptr = (int)longValue;
 	} else {
@@ -1611,7 +1580,12 @@ const TclStubs tclStubs = {
     TclZipfs_Mount, /* 632 */
     TclZipfs_Unmount, /* 633 */
     TclZipfs_TclLibrary, /* 634 */
-    TclZipfs_Mount_Buffer, /* 635 */
+    TclZipfs_MountBuffer, /* 635 */
+    Tcl_FreeIntRep, /* 636 */
+    Tcl_InitStringRep, /* 637 */
+    Tcl_FetchIntRep, /* 638 */
+    Tcl_StoreIntRep, /* 639 */
+    Tcl_HasStringRep, /* 640 */
 };
 
 /* !END!: Do not edit above this line. */