merge 8.7

- gcc compiler warning in tclDate.c
- protect Tcl_UtfToUniCharDString() from ever reading more than "length" bytes from its input, not even in the case of invalid UTF-8. 
- update to latest tzdata
- fix 2 failing test-cases on MacOSX

.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/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/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/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

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/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/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

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/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

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/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/zipfs.n

@@ -16,10 +16,13 @@ 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\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 indir\fR ?\fIstrip\fR? ?\fIpassword\fR?
@@ -27,21 +30,33 @@ zipfs \- Mount and work with ZIP files within Tcl
 \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 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 file as a virtual file system.
+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
+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
@@ -63,7 +78,7 @@ 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\fR|\fB\-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, or just those matching
 \fIpattern\fR (optionally controlled by the option parameters).  The order of
@@ -79,6 +94,13 @@ in \fIzipfile\fR will appear to Tcl to be regular files at the mount point.
 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
@@ -97,40 +119,135 @@ Unmounts a previously mounted ZIP archive mounted to \fImountpoint\fR.
 This package also provides several commands to aid the creation of ZIP
 archives as Tcl applications.
 .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. 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 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 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.
+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
-Caution: the choice of the \fIindir\fR parameter (less the optional stripped
-prefix) determines the later root name of the archive's content.
+\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

@@ -2346,6 +2346,24 @@ declare 635 {
 	    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

@@ -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;
 
 /*

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;
@@ -1593,9 +1593,9 @@ StringIsCmd(
 	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 +1623,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 +1670,6 @@ StringIsCmd(
 	    break;
 	}
 
-    failedIntParse:
 	string1 = TclGetStringFromObj(objPtr, &length1);
 	if (length1 == 0) {
 	    if (strict) {
@@ -1849,7 +1844,7 @@ static int
 UniCharIsHexDigit(
     int character)
 {
-    return (character >= 0) && (character < 0x80) && isxdigit(character);
+    return (character >= 0) && (character < 0x80) && isxdigit(UCHAR(character));
 }
 
 /*
@@ -1908,7 +1903,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

@@ -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);
@@ -1353,7 +1350,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

generic/tclDecls.h

@@ -1875,6 +1875,20 @@ EXTERN Tcl_Obj *	TclZipfs_TclLibrary(void);
 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;
@@ -2546,6 +2560,11 @@ typedef struct TclStubs {
     int (*tclZipfs_Unmount) (Tcl_Interp *interp, const char *mountPoint); /* 633 */
     Tcl_Obj * (*tclZipfs_TclLibrary) (void); /* 634 */
     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;
@@ -3848,6 +3867,16 @@ extern const TclStubs *tclStubsPtr;
 	(tclStubsPtr->tclZipfs_TclLibrary) /* 634 */
 #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/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

@@ -409,7 +409,7 @@ Tcl_Init(
 "	} else {\n"
 "	    lappend scripts {::tcl::pkgconfig get scriptdir,runtime}\n"
 "	}\n"
-"   lappend scripts {zipfs tcl_library}\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");
 	}
     }
 
@@ -1059,6 +1057,7 @@ ReleaseClassContents(
     if (IsRootClass(oPtr) && !Deleted(fPtr->objectCls->thisPtr)) {
 	Tcl_DeleteCommandFromToken(interp, fPtr->objectCls->thisPtr->command);
     }
+    oPtr->classPtr = NULL;
 }
 
 /*
@@ -1108,7 +1107,7 @@ ObjectNamespaceDeleted(
 
     /* Let the dominoes fall */
     if (oPtr->classPtr) {
-	DeleteDescendants(interp, oPtr);
+	TclOODeleteDescendants(interp, oPtr);
     }
 
     /*
@@ -1237,8 +1236,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 +1252,7 @@ ObjectNamespaceDeleted(
     }
 
     if (oPtr->classPtr != NULL) {
-	ReleaseClassContents(interp, oPtr);
+	TclOOReleaseClassContents(interp, oPtr);
     }
 
     /*
@@ -1357,6 +1356,37 @@ 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;
+	}
+    }
+    return res;
+}
+
 /*
  * ----------------------------------------------------------------------
  *
@@ -1489,10 +1519,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 +1546,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 +1788,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

@@ -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,26 @@ 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);
+	} 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) {
@@ -3252,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) {
@@ -3272,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);
 }
 
 /*
@@ -3398,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;
@@ -3626,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

@@ -230,6 +230,9 @@ Tcl_WinUtfToTChar(
     Tcl_DString *dsPtr)
 {
     Tcl_DStringInit(dsPtr);
+    if (!string) {
+	return NULL;
+    }
     return (char *)Tcl_UtfToUniCharDString(string, len, dsPtr);
 }
 
@@ -239,12 +242,15 @@ Tcl_WinTCharToUtf(
     int len,
     Tcl_DString *dsPtr)
 {
-    if (len > 0) {
-	len /= 2;
-    } else if (len == -1) {
-	len = wcslen((wchar_t *)string);
-    }
     Tcl_DStringInit(dsPtr);
+    if (!string) {
+	return NULL;
+    }
+    if (len < 0) {
+	len = wcslen((wchar_t *)string);
+    } else {
+	len /= 2;
+    }
     return Tcl_UniCharToUtfDString((Tcl_UniChar *)string, len, dsPtr);
 }
 
@@ -258,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 {
@@ -274,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 {
@@ -1575,6 +1581,11 @@ const TclStubs tclStubs = {
     TclZipfs_Unmount, /* 633 */
     TclZipfs_TclLibrary, /* 634 */
     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. */

generic/tclTest.c

@@ -2394,7 +2394,7 @@ ExitProcOdd(
     char buf[16 + TCL_INTEGER_SPACE];
     size_t len;
 
-    sprintf(buf, "odd %d\n", PTR2INT(clientData));
+    sprintf(buf, "odd %" TCL_Z_MODIFIER "d\n", (size_t)PTR2INT(clientData));
     len = strlen(buf);
     if (len != (size_t) write(1, buf, len)) {
 	Tcl_Panic("ExitProcOdd: unable to write to stdout");
@@ -2408,7 +2408,7 @@ ExitProcEven(
     char buf[16 + TCL_INTEGER_SPACE];
     size_t len;
 
-    sprintf(buf, "even %d\n", PTR2INT(clientData));
+    sprintf(buf, "even %" TCL_Z_MODIFIER "d\n", (size_t)PTR2INT(clientData));
     len = strlen(buf);
     if (len != (size_t) write(1, buf, len)) {
 	Tcl_Panic("ExitProcEven: unable to write to stdout");
@@ -7082,17 +7082,11 @@ TestconcatobjCmd(
 
     list1Ptr = Tcl_NewStringObj("foo bar sum", -1);
     Tcl_ListObjLength(NULL, list1Ptr, &len);
-    if (list1Ptr->bytes != NULL) {
-	ckfree(list1Ptr->bytes);
-	list1Ptr->bytes = NULL;
-    }
+    Tcl_InvalidateStringRep(list1Ptr);
 
     list2Ptr = Tcl_NewStringObj("eeny meeny", -1);
     Tcl_ListObjLength(NULL, list2Ptr, &len);
-    if (list2Ptr->bytes != NULL) {
-	ckfree(list2Ptr->bytes);
-	list2Ptr->bytes = NULL;
-    }
+    Tcl_InvalidateStringRep(list2Ptr);
 
     /*
      * Verify that concat'ing a list obj with one or more empty strings does

generic/tclTimer.c

@@ -789,7 +789,7 @@ Tcl_AfterObjCmd(
     AfterInfo *afterPtr;
     AfterAssocData *assocPtr;
     int length;
-    int index;
+    int index = -1;
     static const char *const afterSubCmds[] = {
 	"cancel", "idle", "info", NULL
     };
@@ -818,12 +818,9 @@ Tcl_AfterObjCmd(
      * First lets see if the command was passed a number as the first argument.
      */
 
-    if (objv[1]->typePtr == &tclIntType
-	    || objv[1]->typePtr == &tclBignumType
-	    || (Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "", 0,
-		    &index) != TCL_OK)) {
-	index = -1;
-	if (Tcl_GetWideIntFromObj(NULL, objv[1], &ms) != TCL_OK) {
+    if (Tcl_GetWideIntFromObj(NULL, objv[1], &ms) != TCL_OK) {
+	if (Tcl_GetIndexFromObj(NULL, objv[1], afterSubCmds, "", 0, &index)
+		!= TCL_OK) {
             const char *arg = Tcl_GetString(objv[1]);
 
 	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(

generic/tclTomMath.h

@@ -9,8 +9,6 @@
  *
  * The library is free for all purposes without any express
  * guarantee it works.
- *
- * Tom St Denis, tstdenis82@gmail.com, http://math.libtomcrypt.com
  */
 #ifndef BN_H_
 #define BN_H_
@@ -27,14 +25,20 @@ extern "C" {
 #endif
 
 /* MS Visual C++ doesn't have a 128bit type for words, so fall back to 32bit MPI's (where words are 64bit) */
-#if defined(_MSC_VER) || defined(__LLP64__)
+#if defined(_MSC_VER) || defined(__LLP64__) || defined(__e2k__) || defined(__LCC__)
 #   define MP_32BIT
 #endif
 
 /* detect 64-bit mode if possible */
 #if defined(NEVER)
-#   if !(defined(MP_32BIT) || defined(MP_16BIT) || defined(MP_8BIT) || defined(_MSC_VER))
-#      define MP_64BIT
+#   if !(defined(MP_32BIT) || defined(MP_16BIT) || defined(MP_8BIT))
+#      if defined(__GNUC__)
+/* we support 128bit integers only via: __attribute__((mode(TI))) */
+#         define MP_64BIT
+#      else
+/* otherwise we fall back to MP_32BIT even on 64bit platforms */
+#         define MP_32BIT
+#      endif
 #   endif
 #endif
 
@@ -48,11 +52,11 @@ extern "C" {
  */
 #ifdef MP_8BIT
 #ifndef MP_DIGIT_DECLARED
-typedef uint8_t              mp_digit;
+typedef unsigned char        mp_digit;
 #define MP_DIGIT_DECLARED
 #endif
 #ifndef MP_WORD_DECLARED
-typedef uint16_t             mp_word;
+typedef unsigned short       mp_word;
 #define MP_WORD_DECLARED
 #endif
 #   define MP_SIZEOF_MP_DIGIT 1
@@ -61,11 +65,11 @@ typedef uint16_t             mp_word;
 #   endif
 #elif defined(MP_16BIT)
 #ifndef MP_DIGIT_DECLARED
-typedef uint16_t             mp_digit;
+typedef unsigned short       mp_digit;
 #define MP_DIGIT_DECLARED
 #endif
 #ifndef MP_WORD_DECLARED
-typedef uint32_t             mp_word;
+typedef unsigned int         mp_word;
 #define MP_WORD_DECLARED
 #endif
 #   define MP_SIZEOF_MP_DIGIT 2
@@ -75,31 +79,21 @@ typedef uint32_t             mp_word;
 #elif defined(MP_64BIT)
 /* for GCC only on supported platforms */
 #ifndef MP_DIGIT_DECLARED
-typedef uint64_t mp_digit;
+typedef unsigned long long   mp_digit;
 #define MP_DIGIT_DECLARED
 #endif
-#   if defined(__GNUC__)
 typedef unsigned long        mp_word __attribute__((mode(TI)));
-#   else
-/* it seems you have a problem
- * but we assume you can somewhere define your own uint128_t */
-#ifndef MP_WORD_DECLARED
-typedef uint128_t            mp_word;
-#define MP_WORD_DECLARED
-#endif
-#   endif
-
 #   define DIGIT_BIT 60
 #else
 /* this is the default case, 28-bit digits */
 
 /* this is to make porting into LibTomCrypt easier :-) */
 #ifndef MP_DIGIT_DECLARED
-typedef uint32_t             mp_digit;
+typedef unsigned int         mp_digit;
 #define MP_DIGIT_DECLARED
 #endif
 #ifndef MP_WORD_DECLARED
-typedef uint64_t             mp_word;
+typedef unsigned long long   mp_word;
 #define MP_WORD_DECLARED
 #endif
 
@@ -116,23 +110,11 @@ typedef uint64_t             mp_word;
 /* otherwise the bits per digit is calculated automatically from the size of a mp_digit */
 #ifndef DIGIT_BIT
 #   define DIGIT_BIT (((CHAR_BIT * MP_SIZEOF_MP_DIGIT) - 1))  /* bits per digit */
-typedef uint_least32_t mp_min_u32;
+typedef unsigned long mp_min_u32;
 #else
 typedef mp_digit mp_min_u32;
 #endif
 
-/* use arc4random on platforms that support it */
-#if defined(__FreeBSD__) || defined(__OpenBSD__) || defined(__NetBSD__) || defined(__DragonFly__)
-#   define MP_GEN_RANDOM()    arc4random()
-#   define MP_GEN_RANDOM_MAX  0xffffffffu
-#endif
-
-/* use rand() as fall-back if there's no better rand function */
-#ifndef MP_GEN_RANDOM
-#   define MP_GEN_RANDOM()    rand()
-#   define MP_GEN_RANDOM_MAX  RAND_MAX
-#endif
-
 #define MP_DIGIT_BIT     DIGIT_BIT
 #define MP_MASK          ((((mp_digit)1)<<((mp_digit)DIGIT_BIT))-((mp_digit)1))
 #define MP_DIGIT_MAX     MP_MASK
@@ -271,9 +253,9 @@ int mp_set_int(mp_int *a, unsigned long b);
 int mp_set_long(mp_int *a, unsigned long b);
 */
 
-/* set a platform dependent Tcl_WideUInt value */
+/* set a platform dependent unsigned long long value */
 /*
-int mp_set_long_long(mp_int *a, Tcl_WideUInt b);
+int mp_set_long_long(mp_int *a, unsigned long long b);
 */
 
 /* get a 32-bit value */
@@ -286,9 +268,9 @@ unsigned long mp_get_int(const mp_int *a);
 unsigned long mp_get_long(const mp_int *a);
 */
 
-/* get a platform dependent Tcl_WideUInt value */
+/* get a platform dependent unsigned long long value */
 /*
-Tcl_WideUInt mp_get_long_long(const mp_int *a);
+unsigned long long mp_get_long_long(const mp_int *a);
 */
 
 /* initialize and set a digit */
@@ -380,6 +362,14 @@ int mp_cnt_lsb(const mp_int *a);
 int mp_rand(mp_int *a, int digits);
 */
 
+#ifdef MP_PRNG_ENABLE_LTM_RNG
+/* as last resort we will fall back to libtomcrypt's rng_get_bytes()
+ * in case you don't use libtomcrypt or use it w/o rng_get_bytes()
+ * you have to implement it somewhere else, as it's required */
+extern unsigned long (*ltm_rng)(unsigned char *out, unsigned long outlen, void (*callback)(void));
+extern void (*ltm_rng_callback)(void);
+#endif
+
 /* ---> binary operations <--- */
 /* c = a XOR b  */
 /*
@@ -396,8 +386,33 @@ int mp_or(const mp_int *a, const mp_int *b, mp_int *c);
 int mp_and(const mp_int *a, const mp_int *b, mp_int *c);
 */
 
+/* c = a XOR b (two complement) */
+/*
+int mp_tc_xor(const mp_int *a, const mp_int *b, mp_int *c);
+*/
+
+/* c = a OR b (two complement) */
+/*
+int mp_tc_or(const mp_int *a, const mp_int *b, mp_int *c);
+*/
+
+/* c = a AND b (two complement) */
+/*
+int mp_tc_and(const mp_int *a, const mp_int *b, mp_int *c);
+*/
+
+/* right shift (two complement) */
+/*
+int mp_tc_div_2d(const mp_int *a, int b, mp_int *c);
+*/
+
 /* ---> Basic arithmetic <--- */
 
+/* b = ~a */
+/*
+int mp_complement(const mp_int *a, mp_int *b);
+*/
+
 /* b = -a */
 /*
 int mp_neg(const mp_int *a, mp_int *b);

generic/tclUtf.c

@@ -451,9 +451,9 @@ Tcl_UtfToUniCharDString(
 	if (Tcl_UtfCharComplete(p, end-p)) {
 	    p += TclUtfToUniChar(p, &ch);
 	} else if ((unsigned)((UCHAR(*p)-0x80)) < (unsigned) 0x20) {
-	    ch = (Tcl_UniChar) cp1252[UCHAR(*p)-0x80];
+	    ch = (Tcl_UniChar) cp1252[UCHAR(*p++)-0x80];
 	} else {
-	    ch = UCHAR(*p);
+	    ch = UCHAR(*p++);
 	}
 	*w++ = ch;
     }
@@ -783,8 +783,8 @@ Tcl_UniCharAtIndex(
  *
  *	Returns a pointer to the specified character (not byte) position in
  *	the UTF-8 string. If TCL_UTF_MAX <= 4, characters > U+FFFF count as
- *      2 positions, but then the pointer should never be placed between
- *      the two positions.
+ *	2 positions, but then the pointer should never be placed between
+ *	the two positions.
  *
  * Results:
  *	As above.

generic/tclUtil.c

@@ -15,6 +15,7 @@
 #include "tclInt.h"
 #include "tclParse.h"
 #include "tclStringTrim.h"
+#include "tommath.h"
 #include <math.h>
 
 /*
@@ -107,11 +108,11 @@ static Tcl_ThreadDataKey precisionKey;
 static void		ClearHash(Tcl_HashTable *tablePtr);
 static void		FreeProcessGlobalValue(ClientData clientData);
 static void		FreeThreadHash(ClientData clientData);
-static int		GetEndOffsetFromObj(Tcl_Obj *objPtr, int endValue,
-			    int *indexPtr);
+static int		GetEndOffsetFromObj(Tcl_Obj *objPtr,
+			    Tcl_WideInt endValue, Tcl_WideInt *indexPtr);
 static Tcl_HashTable *	GetThreadHash(Tcl_ThreadDataKey *keyPtr);
-static int		SetEndOffsetFromAny(Tcl_Interp *interp,
-			    Tcl_Obj *objPtr);
+static int		GetWideForIndex(Tcl_Interp *interp, Tcl_Obj *objPtr,
+			    Tcl_WideInt endValue, Tcl_WideInt *widePtr);
 static int		FindElement(Tcl_Interp *interp, const char *string,
 			    int stringLength, const char *typeStr,
 			    const char *typeCode, const char **elementPtr,
@@ -124,7 +125,8 @@ static int		FindElement(Tcl_Interp *interp, const char *string,
  * stored directly in the wideValue, so no memory management is required
  * for it. This is a caching intrep, keeping the result of a parse
  * around. This type is only created from a pre-existing string, so an
- * updateStringProc will never be called and need not exist.
+ * updateStringProc will never be called and need not exist. The type
+ * is unregistered, so has no need of a setFromAnyProc either.
  */
 
 static const Tcl_ObjType endOffsetType = {
@@ -132,7 +134,7 @@ static const Tcl_ObjType endOffsetType = {
     NULL,				/* freeIntRepProc */
     NULL,				/* dupIntRepProc */
     NULL,				/* updateStringProc */
-    SetEndOffsetFromAny
+    NULL				/* setFromAnyProc */
 };
 
 /*
@@ -1388,9 +1390,9 @@ TclConvertElement(
      */
 
     if ((src == NULL) || (length == 0) || (*src == '\0' && length == -1)) {
-	src = &tclEmptyString;
-	length = 0;
-	conversion = CONVERT_BRACE;
+	p[0] = '{';
+	p[1] = '}';
+	return 2;
     }
 
     /*
@@ -2087,7 +2089,7 @@ Tcl_ConcatObj(
 	resPtr = NULL;
 	for (i = 0;  i < objc;  i++) {
 	    objPtr = objv[i];
-	    if (objPtr->bytes && objPtr->length == 0) {
+	    if (!TclListObjIsCanonical(objPtr)) {
 		continue;
 	    }
 	    if (resPtr) {
@@ -3651,6 +3653,206 @@ TclFormatInt(
     return numFormatted;
 }
 
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetWideForIndex --
+ *
+ *	This function produces a wide integer value corresponding to the
+ *	index value held in *objPtr. The parsing supports all values
+ *	recognized as any size of integer, and the syntaxes end[-+]$integer
+ *	and $integer[-+]$integer. The argument endValue is used to give
+ *	the meaning of the literal index value "end". Index arithmetic
+ *	on arguments outside the wide integer range are only accepted
+ *	when interp is a working interpreter, not NULL.
+ *
+ * Results:
+ *	When parsing of *objPtr successfully recognizes an index value,
+ *	TCL_OK is returned, and the wide integer value corresponding to
+ *	the recognized index value is written to *widePtr. When parsing
+ *	fails, TCL_ERROR is returned and error information is written to
+ *	interp, if non-NULL.
+ *
+ * Side effects:
+ *	The type of *objPtr may change.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetWideForIndex(
+    Tcl_Interp *interp,         /* Interpreter to use for error reporting. If
+                                 * NULL, then no error message is left after
+                                 * errors. */
+    Tcl_Obj *objPtr,            /* Points to the value to be parsed */
+    Tcl_WideInt endValue,       /* The value to be stored at *widePtr if
+                                 * objPtr holds "end".
+				 * NOTE: this value may be negative. */
+    Tcl_WideInt *widePtr)       /* Location filled in with a wide integer
+                                 * representing an index. */
+{
+    ClientData cd;
+    const char *opPtr;
+    int numType, length, t1 = 0, t2 = 0;
+    int code = TclGetNumberFromObj(NULL, objPtr, &cd, &numType);
+
+    if (code == TCL_OK) {
+	if (numType == TCL_NUMBER_INT) {
+	    /* objPtr holds an integer in the signed wide range */
+	    *widePtr = (Tcl_WideInt)(*(Tcl_WideInt *)cd);
+	    return TCL_OK;
+	}
+	if (numType == TCL_NUMBER_BIG) {
+	    /* objPtr holds an integer outside the signed wide range */
+	    /* Truncate to the signed wide range. */
+	    if (mp_isneg((mp_int *)cd)) {
+		*widePtr = LLONG_MIN;
+	    } else {
+		*widePtr = LLONG_MAX;
+	    }
+	    return TCL_OK;
+	}
+	/* Must be a double -> not a valid index */
+	goto parseError;
+    }
+
+    /* objPtr does not hold a number, check the end+/- format... */
+    if (GetEndOffsetFromObj(objPtr, endValue, widePtr) == TCL_OK) {
+	return TCL_OK;
+    }
+
+    /* If we reach here, the string rep of objPtr exists. */
+
+    /*
+     * The valid index syntax does not include any value that is
+     * a list of more than one element. This is necessary so that
+     * lists of index values can be reliably distinguished from any
+     * single index value.
+     */
+
+    /*
+     * Quick scan to see if multi-value list is even possible.
+     * This relies on TclGetString() returning a NUL-terminated string.
+     */
+    if ((TclMaxListLength(TclGetString(objPtr), -1, NULL) > 1)
+
+	    /* If it's possible, do the full list parse. */
+            && (TCL_OK == Tcl_ListObjLength(NULL, objPtr, &length))
+            && (length > 1)) {
+        goto parseError;
+    }
+
+    /* Passed the list screen, so parse for index arithmetic expression */
+    if (TCL_OK == TclParseNumber(NULL, objPtr, NULL, NULL, -1, &opPtr,
+            TCL_PARSE_INTEGER_ONLY)) {
+	Tcl_WideInt w1=0, w2=0;
+
+	/* value starts with valid integer... */
+
+        if ((*opPtr == '-') || (*opPtr == '+')) {
+	    /* ... value continues with [-+] ... */
+
+	    /* Save first integer as wide if possible */
+	    TclGetNumberFromObj(NULL, objPtr, &cd, &t1);
+	    if (t1 == TCL_NUMBER_INT) {
+		w1 = (*(Tcl_WideInt *)cd);
+	    }
+
+	    if (TCL_OK == TclParseNumber(NULL, objPtr, NULL, opPtr + 1,
+		    -1, NULL, TCL_PARSE_INTEGER_ONLY)) {
+		/* ... value concludes with second valid integer */
+
+		/* Save second integer as wide if possible */
+		TclGetNumberFromObj(NULL, objPtr, &cd, &t2);
+		if (t2 == TCL_NUMBER_INT) {
+		    w2 = (*(Tcl_WideInt *)cd);
+		}
+	    }
+        }
+	/* Clear invalid intreps left by TclParseNumber */
+	TclFreeIntRep(objPtr);
+
+	if (t1 && t2) {
+	    /* We have both integer values */
+	    if ((t1 == TCL_NUMBER_INT) && (t2 == TCL_NUMBER_INT)) {
+		/* Both are wide, do wide-integer math */
+		if (*opPtr == '-') {
+		    if ((w2 == LLONG_MIN) && (interp != NULL)) {
+			goto extreme;
+		    }
+		    w2 = -w2;
+		}
+
+		if ((w1 ^ w2) < 0) {
+		    /* Different signs, sum cannot overflow */
+		    *widePtr = w1 + w2;
+		} else if (w1 >= 0) {
+		    if (w1 < LLONG_MAX - w2) {
+			*widePtr = w1 + w2;
+		    } else {
+			*widePtr = LLONG_MAX;
+		    }
+		} else {
+		    if (w1 > LLONG_MIN - w2) {
+			*widePtr = w1 + w2;
+		    } else {
+			*widePtr = LLONG_MIN;
+		    }
+		}
+	    } else if (interp == NULL) {
+		/*
+		 * We use an interp to do bignum index calculations.
+		 * If we don't get one, call all indices with bignums errors,
+		 * and rely on callers to handle it.
+		 */
+		return TCL_ERROR;
+	    } else {
+		/*
+		 * At least one is big, do bignum math. Little reason to
+		 * value performance here. Re-use code.  Parse has verified
+		 * objPtr is an expression. Compute it.
+		 */
+
+		Tcl_Obj *sum;
+
+	    extreme:
+		Tcl_ExprObj(interp, objPtr, &sum);
+		TclGetNumberFromObj(NULL, sum, &cd, &numType);
+
+		if (numType == TCL_NUMBER_INT) {
+		    /* sum holds an integer in the signed wide range */
+		    *widePtr = (Tcl_WideInt)(*(Tcl_WideInt *)cd);
+		} else {
+		    /* sum holds an integer outside the signed wide range */
+		    /* Truncate to the signed wide range. */
+		    if (mp_isneg((mp_int *)cd)) {
+			*widePtr = LLONG_MIN;
+		    } else {
+			*widePtr = LLONG_MAX;
+		    }
+		}
+		Tcl_DecrRefCount(sum);
+	    }
+	    return TCL_OK;
+	}
+    }
+
+    /* Report a parse error. */
+  parseError:
+    if (interp != NULL) {
+        char * bytes = TclGetString(objPtr);
+        Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+                "bad index \"%s\": must be integer?[+-]integer? or"
+                " end?[+-]integer?", bytes));
+        if (!strncmp(bytes, "end-", 4)) {
+            bytes += 4;
+        }
+        TclCheckBadOctal(interp, bytes);
+        Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
+    }
+    return TCL_ERROR;
+}
+
 /*
  *----------------------------------------------------------------------
  *
@@ -3687,91 +3889,33 @@ TclGetIntForIndex(
     int *indexPtr)		/* Location filled in with an integer
 				 * representing an index. */
 {
-    size_t length;
-    char *opPtr;
-    const char *bytes;
+    Tcl_WideInt wide;
 
-    if (TclGetIntFromObj(NULL, objPtr, indexPtr) == TCL_OK) {
-	return TCL_OK;
+    if (GetWideForIndex(interp, objPtr, endValue, &wide) == TCL_ERROR) {
+	return TCL_ERROR;
     }
-
-    if (GetEndOffsetFromObj(objPtr, endValue, indexPtr) == TCL_OK) {
-	return TCL_OK;
+    if (wide < INT_MIN) {
+	*indexPtr = INT_MIN;
+    } else if (wide > INT_MAX) {
+	*indexPtr = INT_MAX;
+    } else {
+	*indexPtr = (int) wide;
     }
-
-    bytes = TclGetString(objPtr);
-    length = objPtr->length;
-
-    /*
-     * Leading whitespace is acceptable in an index.
-     */
-
-    while (length && TclIsSpaceProc(*bytes)) {
-	bytes++;
-	length--;
-    }
-
-    if (TclParseNumber(NULL, NULL, NULL, bytes, length, (const char **)&opPtr,
-	    TCL_PARSE_INTEGER_ONLY | TCL_PARSE_NO_WHITESPACE) == TCL_OK) {
-	int code, first, second;
-	char savedOp = *opPtr;
-
-	if ((savedOp != '+') && (savedOp != '-')) {
-	    goto parseError;
-	}
-	if (TclIsSpaceProc(opPtr[1])) {
-	    goto parseError;
-	}
-	*opPtr = '\0';
-	code = Tcl_GetInt(interp, bytes, &first);
-	*opPtr = savedOp;
-	if (code == TCL_ERROR) {
-	    goto parseError;
-	}
-	if (TCL_ERROR == Tcl_GetInt(interp, opPtr+1, &second)) {
-	    goto parseError;
-	}
-	if (savedOp == '+') {
-	    *indexPtr = first + second;
-	} else {
-	    *indexPtr = first - second;
-	}
-	return TCL_OK;
-    }
-
-    /*
-     * Report a parse error.
-     */
-
-  parseError:
-    if (interp != NULL) {
-	bytes = TclGetString(objPtr);
-	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		"bad index \"%s\": must be integer?[+-]integer? or"
-		" end?[+-]integer?", bytes));
-	if (!strncmp(bytes, "end-", 4)) {
-	    bytes += 4;
-	}
-	TclCheckBadOctal(interp, bytes);
-	Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
-    }
-
-    return TCL_ERROR;
+    return TCL_OK;
 }
-
 /*
  *----------------------------------------------------------------------
  *
  * GetEndOffsetFromObj --
  *
- *      Look for a string of the form "end[+-]offset" and convert it to an
- *      internal representation holding the offset.
+ *	Look for a string of the form "end[+-]offset" and convert it to an
+ *	internal representation holding the offset.
  *
  * Results:
- *      Tcl return code.
+ *	Tcl return code.
  *
  * Side effects:
- *      May store a Tcl_ObjType.
+ *	May store a Tcl_ObjType.
  *
  *----------------------------------------------------------------------
  */
@@ -3779,122 +3923,92 @@ TclGetIntForIndex(
 static int
 GetEndOffsetFromObj(
     Tcl_Obj *objPtr,            /* Pointer to the object to parse */
-    int endValue,               /* The value to be stored at "indexPtr" if
+    Tcl_WideInt endValue,       /* The value to be stored at "indexPtr" if
                                  * "objPtr" holds "end". */
-    int *indexPtr)              /* Location filled in with an integer
+    Tcl_WideInt *widePtr)       /* Location filled in with an integer
                                  * representing an index. */
 {
-    if (SetEndOffsetFromAny(NULL, objPtr) != TCL_OK) {
-	return TCL_ERROR;
-    }
+    Tcl_ObjIntRep *irPtr;
+    Tcl_WideInt offset = 0;	/* Offset in the "end-offset" expression */
 
-    /* TODO: Handle overflow cases sensibly */
-    *indexPtr = endValue + (int)objPtr->internalRep.wideValue;
-    return TCL_OK;
-}
+    while ((irPtr = Tcl_FetchIntRep(objPtr, &endOffsetType)) == NULL) {
+	Tcl_ObjIntRep ir;
+	int length;
+	const char *bytes = TclGetStringFromObj(objPtr, &length);
 
-
-/*
- *----------------------------------------------------------------------
- *
- * SetEndOffsetFromAny --
- *
- *	Look for a string of the form "end[+-]offset" and convert it to an
- *	internal representation holding the offset.
- *
- * Results:
- *	Returns TCL_OK if ok, TCL_ERROR if the string was badly formed.
- *
- * Side effects:
- *	If interp is not NULL, stores an error message in the interpreter
- *	result.
- *
- *----------------------------------------------------------------------
- */
-
-static int
-SetEndOffsetFromAny(
-    Tcl_Interp *interp,		/* Tcl interpreter or NULL */
-    Tcl_Obj *objPtr)		/* Pointer to the object to parse */
-{
-    Tcl_WideInt offset;			/* Offset in the "end-offset" expression */
-    register const char *bytes;	/* String rep of the object */
-    int length;			/* Length of the object's string rep */
-
-    /*
-     * If it's already the right type, we're fine.
-     */
-
-    if (objPtr->typePtr == &endOffsetType) {
-	return TCL_OK;
-    }
-
-    /*
-     * Check for a string rep of the right form.
-     */
-
-    bytes = TclGetStringFromObj(objPtr, &length);
-    if ((*bytes != 'e') || (strncmp(bytes, "end",
-	    (size_t)((length > 3) ? 3 : length)) != 0)) {
-	if (interp != NULL) {
-	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		    "bad index \"%s\": must be end?[+-]integer?", bytes));
-	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
-	}
-	return TCL_ERROR;
-    }
-
-    /*
-     * Convert the string rep.
-     */
-
-    if (length <= 3) {
-	offset = 0;
-    } else if ((length > 4) && ((bytes[3] == '-') || (bytes[3] == '+'))) {
-	/*
-	 * This is our limited string expression evaluator. Pass everything
-	 * after "end-" to TclParseNumber.
-	 */
-
-	if (TclIsSpaceProc(bytes[4])) {
-	    goto badIndexFormat;
-	}
-	if (TclParseNumber(NULL, objPtr, NULL, bytes+4, length-4, NULL,
-		TCL_PARSE_INTEGER_ONLY) != TCL_OK) {
+	if ((length < 3) || (length == 4)) {
+	    /* Too short to be "end" or to be "end-$integer" */
 	    return TCL_ERROR;
 	}
-	if (objPtr->typePtr != &tclIntType) {
-		goto badIndexFormat;
+	if ((*bytes != 'e') || (strncmp(bytes, "end", 3) != 0)) {
+	    /* Value doesn't start with "end" */
+	    return TCL_ERROR;
 	}
-	offset = objPtr->internalRep.wideValue;
-	if (bytes[3] == '-') {
 
-	    /* TODO: Review overflow concerns here! */
-	    offset = -offset;
-	}
-    } else {
-	/*
-	 * Conversion failed. Report the error.
-	 */
+	if (length > 4) {
+	    ClientData cd;
+	    int t;
 
-    badIndexFormat:
-	if (interp != NULL) {
-	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
-		    "bad index \"%s\": must be end?[+-]integer?", bytes));
-	    Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
+	    /* Parse for the "end-..." or "end+..." formats */
+
+	    if ((bytes[3] != '-') && (bytes[3] != '+')) {
+		/* No operator where we need one */
+		return TCL_ERROR;
+	    }
+	    if (TclIsSpaceProc(bytes[4])) {
+		/* Space after + or - not permitted. */
+		return TCL_ERROR;
+	    }
+
+	    /* Parse the integer offset */
+	    if (TCL_OK != TclParseNumber(NULL, objPtr, NULL,
+			bytes+4, length-4, NULL, TCL_PARSE_INTEGER_ONLY)) {
+		/* Not a recognized integer format */
+		return TCL_ERROR;
+	    }
+
+	    /* Got an integer offset; pull it from where parser left it. */
+	    TclGetNumberFromObj(NULL, objPtr, &cd, &t);
+
+	    if (t == TCL_NUMBER_BIG) {
+		/* Truncate to the signed wide range. */
+		if (mp_isneg((mp_int *)cd)) {
+		    offset = (bytes[3] == '-') ? LLONG_MAX : LLONG_MIN;
+		} else {
+		    offset = (bytes[3] == '-') ? LLONG_MIN : LLONG_MAX;
+		}
+	    } else {
+		/* assert (t == TCL_NUMBER_INT); */
+		offset = (*(Tcl_WideInt *)cd);
+		if (bytes[3] == '-') {
+		    offset = (offset == LLONG_MIN) ? LLONG_MAX : -offset;
+		}
+	    }
 	}
-	return TCL_ERROR;
+
+	/* Success. Store the new internal rep. */
+	ir.wideValue = offset;
+	Tcl_StoreIntRep(objPtr, &endOffsetType, &ir);
     }
 
-    /*
-     * The conversion succeeded. Free the old internal rep and set the new
-     * one.
-     */
-
-    TclFreeIntRep(objPtr);
-    objPtr->internalRep.wideValue = offset;
-    objPtr->typePtr = &endOffsetType;
+    offset = irPtr->wideValue;
 
+    if ((endValue ^ offset) < 0) {
+        /* Different signs, sum cannot overflow */
+        *widePtr = endValue + offset;
+    } else if (endValue >= 0) {
+        if (endValue < LLONG_MAX - offset) {
+            *widePtr = endValue + offset;
+        } else {
+            *widePtr = LLONG_MAX;
+        }
+    } else {
+        if (endValue > LLONG_MIN - offset) {
+            *widePtr = endValue + offset;
+        } else {
+            *widePtr = LLONG_MIN;
+        }
+    }
     return TCL_OK;
 }
 
@@ -3961,43 +4075,48 @@ TclIndexEncode(
     int after,		/* Value to return for index after end */
     int *indexPtr)	/* Where to write the encoded answer, not NULL */
 {
-    int idx;
+    ClientData cd;
+    Tcl_WideInt wide;
+    int idx, numType, code = TclGetNumberFromObj(NULL, objPtr, &cd, &numType);
 
-    if (TCL_OK == TclGetIntFromObj(NULL, objPtr, &idx)) {
-        /* We parsed a value in the range INT_MIN...INT_MAX */
+    if ((code == TCL_OK) && (numType == TCL_NUMBER_INT)) {
+        /* We parsed a value in the range LLONG_MIN...LLONG_MAX */
+	wide = (*(Tcl_WideInt *)cd);
     integerEncode:
-        if (idx < TCL_INDEX_START) {
+        if (wide < TCL_INDEX_START) {
             /* All negative absolute indices are "before the beginning" */
             idx = before;
-        } else if (idx == INT_MAX) {
+        } else if (wide >= INT_MAX) {
             /* This index value is always "after the end" */
             idx = after;
-        }
+        } else {
+	    idx = (int) wide;
+	}
         /* usual case, the absolute index value encodes itself */
-    } else if (TCL_OK == GetEndOffsetFromObj(objPtr, 0, &idx)) {
+    } else if (TCL_OK == GetEndOffsetFromObj(objPtr, 0, &wide)) {
         /*
          * We parsed an end+offset index value.
-         * idx holds the offset value in the range INT_MIN...INT_MAX.
+         * wide holds the offset value in the range LLONG_MIN...LLONG_MAX.
          */
-        if (idx > 0) {
+        if (wide > 0) {
             /*
              * All end+postive or end-negative expressions
              * always indicate "after the end".
              */
             idx = after;
-        } else if (idx < INT_MIN - TCL_INDEX_END) {
+        } else if (wide < INT_MIN - TCL_INDEX_END) {
             /* These indices always indicate "before the beginning */
             idx = before;
         } else {
             /* Encoded end-positive (or end+negative) are offset */
-            idx += TCL_INDEX_END;
+            idx = (int)wide + TCL_INDEX_END;
         }
 
     /* TODO: Consider flag to suppress repeated end-offset parse. */
-    } else if (TCL_OK == TclGetIntForIndexM(interp, objPtr, 0, &idx)) {
+    } else if (TCL_OK == GetWideForIndex(interp, objPtr, 0, &wide)) {
         /*
          * Only reach this case when the index value is a
-         * constant index arithmetic expression, and idx
+         * constant index arithmetic expression, and wide
          * holds the result. Treat it the same as if it were
          * parsed as an absolute integer value.
          */
@@ -4316,7 +4435,7 @@ TclGetProcessGlobalValue(
 	    ckfree(pgvPtr->value);
 	    pgvPtr->value = ckalloc(Tcl_DStringLength(&newValue) + 1);
 	    memcpy(pgvPtr->value, Tcl_DStringValue(&newValue),
-		    (size_t) Tcl_DStringLength(&newValue) + 1);
+		    Tcl_DStringLength(&newValue) + 1);
 	    Tcl_DStringFree(&newValue);
 	    Tcl_FreeEncoding(pgvPtr->encoding);
 	    pgvPtr->encoding = current;

generic/tclVar.c

@@ -254,10 +254,49 @@ static const Tcl_ObjType localVarNameType = {
     FreeLocalVarName, DupLocalVarName, NULL, NULL
 };
 
-static const Tcl_ObjType tclParsedVarNameType = {
+#define LocalSetIntRep(objPtr, index, namePtr)				\
+    do {								\
+	Tcl_ObjIntRep ir;						\
+	Tcl_Obj *ptr = (namePtr);					\
+	if (ptr) {Tcl_IncrRefCount(ptr);}				\
+	ir.twoPtrValue.ptr1 = ptr;					\
+	ir.twoPtrValue.ptr2 = INT2PTR(index);				\
+	Tcl_StoreIntRep((objPtr), &localVarNameType, &ir);		\
+    } while (0)
+
+#define LocalGetIntRep(objPtr, index, name)				\
+    do {								\
+	const Tcl_ObjIntRep *irPtr;					\
+	irPtr = Tcl_FetchIntRep((objPtr), &localVarNameType);		\
+	(name) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL;		\
+	(index) = irPtr ? PTR2INT(irPtr->twoPtrValue.ptr2) : -1;	\
+    } while (0)
+
+static const Tcl_ObjType parsedVarNameType = {
     "parsedVarName",
     FreeParsedVarName, DupParsedVarName, NULL, NULL
 };
+
+#define ParsedSetIntRep(objPtr, arrayPtr, elem)				\
+    do {								\
+	Tcl_ObjIntRep ir;						\
+	Tcl_Obj *ptr1 = (arrayPtr);					\
+	Tcl_Obj *ptr2 = (elem);						\
+	if (ptr1) {Tcl_IncrRefCount(ptr1);}				\
+	if (ptr2) {Tcl_IncrRefCount(ptr2);}				\
+	ir.twoPtrValue.ptr1 = ptr1;					\
+	ir.twoPtrValue.ptr2 = ptr2;					\
+	Tcl_StoreIntRep((objPtr), &parsedVarNameType, &ir);		\
+    } while (0)
+
+#define ParsedGetIntRep(objPtr, parsed, array, elem)			\
+    do {								\
+	const Tcl_ObjIntRep *irPtr;					\
+	irPtr = Tcl_FetchIntRep((objPtr), &parsedVarNameType);		\
+	(parsed) = (irPtr != NULL);					\
+	(array) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL;		\
+	(elem) = irPtr ? irPtr->twoPtrValue.ptr2 : NULL;		\
+    } while (0)
 
 Var *
 TclVarHashCreateVar(
@@ -482,9 +521,8 @@ TclLookupVar(
  *
  * Side effects:
  *	New hashtable entries may be created if createPart1 or createPart2
- *	are 1. The object part1Ptr is converted to one of localVarNameType,
- *	tclNsVarNameType or tclParsedVarNameType and caches as much of the
- *	lookup as it can.
+ *	are 1. The object part1Ptr is converted to one of localVarNameType
+ *	or parsedVarNameType and caches as much of the lookup as it can.
  *	When createPart1 is 1, callers must IncrRefCount part1Ptr if they
  *	plan to DecrRefCount it.
  *
@@ -571,15 +609,15 @@ TclObjLookupVarEx(
 				 * structure. */
     const char *errMsg = NULL;
     int index, parsed = 0;
-    const Tcl_ObjType *typePtr = part1Ptr->typePtr;
+
+    int localIndex;
+    Tcl_Obj *namePtr, *arrayPtr, *elem;
 
     *arrayPtrPtr = NULL;
 
-    if (typePtr == &localVarNameType) {
-	int localIndex;
-
-    localVarNameTypeHandling:
-	localIndex = PTR2INT(part1Ptr->internalRep.twoPtrValue.ptr2);
+  restart:
+    LocalGetIntRep(part1Ptr, localIndex, namePtr);
+    if (localIndex >= 0) {
 	if (HasLocalVars(varFramePtr)
 		&& !(flags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY))
 		&& (localIndex < varFramePtr->numCompiledLocals)) {
@@ -587,7 +625,6 @@ TclObjLookupVarEx(
 	     * Use the cached index if the names coincide.
 	     */
 
-	    Tcl_Obj *namePtr = part1Ptr->internalRep.twoPtrValue.ptr1;
 	    Tcl_Obj *checkNamePtr = localName(varFramePtr, localIndex);
 
 	    if ((!namePtr && (checkNamePtr == part1Ptr)) ||
@@ -600,12 +637,11 @@ TclObjLookupVarEx(
     }
 
     /*
-     * If part1Ptr is a tclParsedVarNameType, separate it into the pre-parsed
-     * parts.
+     * If part1Ptr is a parsedVarNameType, retrieve the pre-parsed parts.
      */
 
-    if (typePtr == &tclParsedVarNameType) {
-	if (part1Ptr->internalRep.twoPtrValue.ptr1 != NULL) {
+    ParsedGetIntRep(part1Ptr, parsed, arrayPtr, elem);
+    if (parsed && arrayPtr) {
 	    if (part2Ptr != NULL) {
 		/*
 		 * ERROR: part1Ptr is already an array element, cannot specify
@@ -619,14 +655,9 @@ TclObjLookupVarEx(
 		}
 		return NULL;
 	    }
-	    part2Ptr = part1Ptr->internalRep.twoPtrValue.ptr2;
-	    part1Ptr = part1Ptr->internalRep.twoPtrValue.ptr1;
-	    typePtr = part1Ptr->typePtr;
-	    if (typePtr == &localVarNameType) {
-		goto localVarNameTypeHandling;
-	    }
-	}
-	parsed = 1;
+	    part2Ptr = elem;
+	    part1Ptr = arrayPtr;
+	    goto restart;
     }
 
     if (!parsed) {
@@ -641,8 +672,6 @@ TclObjLookupVarEx(
 	    const char *part2 = strchr(part1, '(');
 
 	    if (part2) {
-		Tcl_Obj *arrayPtr;
-
 		if (part2Ptr != NULL) {
 		    if (flags & TCL_LEAVE_ERR_MSG) {
 			TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg,
@@ -657,13 +686,7 @@ TclObjLookupVarEx(
 		part2Ptr = Tcl_NewStringObj(part2 + 1,
 			len - (part2 - part1) - 2);
 
-		TclFreeIntRep(part1Ptr);
-
-		Tcl_IncrRefCount(arrayPtr);
-		part1Ptr->internalRep.twoPtrValue.ptr1 = arrayPtr;
-		Tcl_IncrRefCount(part2Ptr);
-		part1Ptr->internalRep.twoPtrValue.ptr2 = part2Ptr;
-		part1Ptr->typePtr = &tclParsedVarNameType;
+		ParsedSetIntRep(part1Ptr, arrayPtr, part2Ptr);
 
 		part1Ptr = arrayPtr;
 	    }
@@ -691,7 +714,6 @@ TclObjLookupVarEx(
      * Cache the newly found variable if possible.
      */
 
-    TclFreeIntRep(part1Ptr);
     if (index >= 0) {
 	/*
 	 * An indexed local variable.
@@ -699,26 +721,36 @@ TclObjLookupVarEx(
 
 	Tcl_Obj *cachedNamePtr = localName(varFramePtr, index);
 
-	part1Ptr->typePtr = &localVarNameType;
-	if (part1Ptr != cachedNamePtr) {
-	    part1Ptr->internalRep.twoPtrValue.ptr1 = cachedNamePtr;
-	    Tcl_IncrRefCount(cachedNamePtr);
-	    if (cachedNamePtr->typePtr != &localVarNameType
-		    || cachedNamePtr->internalRep.twoPtrValue.ptr1 != NULL) {
-		TclFreeIntRep(cachedNamePtr);
-	    }
+	if (part1Ptr == cachedNamePtr) {
+	    cachedNamePtr = NULL;
 	} else {
-	    part1Ptr->internalRep.twoPtrValue.ptr1 = NULL;
+	    /*
+	     * [80304238ac] Trickiness here.  We will store and incr the
+	     * refcount on cachedNamePtr.  Trouble is that it's possible
+	     * (see test var-22.1) for cachedNamePtr to have an intrep
+	     * that contains a stored and refcounted part1Ptr.  This
+	     * would be a reference cycle which leads to a memory leak.
+	     *
+	     * The solution here is to wipe away all intrep(s) in
+	     * cachedNamePtr and leave it as string only.  This is
+	     * radical and destructive, so a better idea would be welcome.
+	     */
+	    TclFreeIntRep(cachedNamePtr);
+
+	    /*
+	     * Now go ahead and convert it the the "localVarName" type,
+	     * since we suspect at least some use of the value as a
+	     * varname and we want to resolve it quickly.
+	     */
+	    LocalSetIntRep(cachedNamePtr, index, NULL);
 	}
-	part1Ptr->internalRep.twoPtrValue.ptr2 = INT2PTR(index);
+	LocalSetIntRep(part1Ptr, index, cachedNamePtr);
     } else {
 	/*
 	 * At least mark part1Ptr as already parsed.
 	 */
 
-	part1Ptr->typePtr = &tclParsedVarNameType;
-	part1Ptr->internalRep.twoPtrValue.ptr1 = NULL;
-	part1Ptr->internalRep.twoPtrValue.ptr2 = NULL;
+	ParsedSetIntRep(part1Ptr, NULL, NULL);
     }
 
   donePart1:
@@ -5764,12 +5796,15 @@ static void
 FreeLocalVarName(
     Tcl_Obj *objPtr)
 {
-    Tcl_Obj *namePtr = objPtr->internalRep.twoPtrValue.ptr1;
+    int index;
+    Tcl_Obj *namePtr;
 
+    LocalGetIntRep(objPtr, index, namePtr);
+
+    index++;	/* Compiler warning bait. */
     if (namePtr) {
 	Tcl_DecrRefCount(namePtr);
     }
-    objPtr->typePtr = NULL;
 }
 
 static void
@@ -5777,17 +5812,14 @@ DupLocalVarName(
     Tcl_Obj *srcPtr,
     Tcl_Obj *dupPtr)
 {
-    Tcl_Obj *namePtr = srcPtr->internalRep.twoPtrValue.ptr1;
+    int index;
+    Tcl_Obj *namePtr;
 
+    LocalGetIntRep(srcPtr, index, namePtr);
     if (!namePtr) {
 	namePtr = srcPtr;
     }
-    dupPtr->internalRep.twoPtrValue.ptr1 = namePtr;
-    Tcl_IncrRefCount(namePtr);
-
-    dupPtr->internalRep.twoPtrValue.ptr2 =
-	    srcPtr->internalRep.twoPtrValue.ptr2;
-    dupPtr->typePtr = &localVarNameType;
+    LocalSetIntRep(dupPtr, index, namePtr);
 }
 
 /*
@@ -5803,14 +5835,16 @@ static void
 FreeParsedVarName(
     Tcl_Obj *objPtr)
 {
-    register Tcl_Obj *arrayPtr = objPtr->internalRep.twoPtrValue.ptr1;
-    register Tcl_Obj *elem = objPtr->internalRep.twoPtrValue.ptr2;
+    register Tcl_Obj *arrayPtr, *elem;
+    int parsed;
 
+    ParsedGetIntRep(objPtr, parsed, arrayPtr, elem);
+
+    parsed++;				/* Silence compiler. */
     if (arrayPtr != NULL) {
 	TclDecrRefCount(arrayPtr);
 	TclDecrRefCount(elem);
     }
-    objPtr->typePtr = NULL;
 }
 
 static void
@@ -5818,17 +5852,13 @@ DupParsedVarName(
     Tcl_Obj *srcPtr,
     Tcl_Obj *dupPtr)
 {
-    register Tcl_Obj *arrayPtr = srcPtr->internalRep.twoPtrValue.ptr1;
-    register Tcl_Obj *elem = srcPtr->internalRep.twoPtrValue.ptr2;
+    register Tcl_Obj *arrayPtr, *elem;
+    int parsed;
 
-    if (arrayPtr != NULL) {
-	Tcl_IncrRefCount(arrayPtr);
-	Tcl_IncrRefCount(elem);
-    }
+    ParsedGetIntRep(srcPtr, parsed, arrayPtr, elem);
 
-    dupPtr->internalRep.twoPtrValue.ptr1 = arrayPtr;
-    dupPtr->internalRep.twoPtrValue.ptr2 = elem;
-    dupPtr->typePtr = &tclParsedVarNameType;
+    parsed++;				/* Silence compiler. */
+    ParsedSetIntRep(dupPtr, arrayPtr, elem);
 }
 
 /*

generic/tclZlib.c

@@ -117,7 +117,7 @@ typedef struct {
     z_stream outStream;		/* Structure used by zlib for compression of
 				 * output. */
     char *inBuffer, *outBuffer;	/* Working buffers. */
-    int inAllocated, outAllocated;
+    size_t inAllocated, outAllocated;
 				/* Sizes of working buffers. */
     GzipHeader inHeader;	/* Header read from input stream, when
 				 * decompressing a gzip stream. */
@@ -1515,7 +1515,7 @@ Tcl_ZlibStreamGet(
 	    Tcl_ListObjIndex(NULL, zshPtr->outData, 0, &itemObj);
 	    itemPtr = Tcl_GetByteArrayFromObj(itemObj, &itemLen);
 	    if (itemLen-zshPtr->outPos >= count-dataPos) {
-		unsigned len = count - dataPos;
+		size_t len = count - dataPos;
 
 		memcpy(dataPtr + dataPos, itemPtr + zshPtr->outPos, len);
 		zshPtr->outPos += len;
@@ -1524,7 +1524,7 @@ Tcl_ZlibStreamGet(
 		    zshPtr->outPos = 0;
 		}
 	    } else {
-		unsigned len = itemLen - zshPtr->outPos;
+		size_t len = itemLen - zshPtr->outPos;
 
 		memcpy(dataPtr + dataPos, itemPtr + zshPtr->outPos, len);
 		dataPos += len;

library/dde/pkgIndex.tcl

@@ -1,7 +1,7 @@
 if {([info commands ::tcl::pkgconfig] eq "")
 	|| ([info sharedlibextension] ne ".dll")} return
 if {[::tcl::pkgconfig get debug]} {
-    package ifneeded dde 1.4.0 [list load [file join $dir tcldde14g.dll] dde]
+    package ifneeded dde 1.4.1 [list load [file join $dir tcldde14g.dll] dde]
 } else {
-    package ifneeded dde 1.4.0 [list load [file join $dir tcldde14.dll] dde]
+    package ifneeded dde 1.4.1 [list load [file join $dir tcldde14.dll] dde]
 }

library/init.tcl

@@ -810,7 +810,7 @@ foreach {safe package version file} {
   1 opt             0.4.7  {opt optparse.tcl}
   0 platform        1.0.14 {platform platform.tcl}
   0 platform::shell 1.1.4  {platform shell.tcl}
-  1 tcltest         2.4.1  {tcltest tcltest.tcl}
+  1 tcltest         2.5.0  {tcltest tcltest.tcl}
 } {
   if {$isafe && !$safe} continue
   package ifneeded $package $version  [list source [file join $dir {*}$file]]

library/safe.tcl

@@ -455,37 +455,35 @@ proc ::safe::InterpInit {
     foreach {command alias} {
 	source   AliasSource
 	load     AliasLoad
-	encoding AliasEncoding
 	exit     interpDelete
 	glob     AliasGlob
     } {
 	::interp alias $slave $command {} [namespace current]::$alias $slave
     }
 
+    # UGLY POINT! These commands are safe (they're ensembles with unsafe
+    # subcommands), but is assumed to not be by existing policies so it is
+    # hidden by default. Hack it...
+    foreach command {encoding file} {
+	::interp alias $slave $command {} interp invokehidden $slave $command
+    }
+
     # This alias lets the slave have access to a subset of the 'file'
     # command functionality.
 
-    ::interp expose $slave file
     foreach subcommand {dirname extension rootname tail} {
 	::interp alias $slave ::tcl::file::$subcommand {} \
 	    ::safe::AliasFileSubcommand $slave $subcommand
     }
-    foreach subcommand {
-	atime attributes copy delete executable exists isdirectory isfile
-	link lstat mtime mkdir nativename normalize owned readable readlink
-	rename size stat tempfile type volumes writable
-    } {
-	::interp alias $slave ::tcl::file::$subcommand {} \
-	    ::safe::BadSubcommand $slave file $subcommand
-    }
+
+    # Subcommand of 'encoding' that has special handling; [encoding system] is
+    # OK provided it has no other arguments passed to it.
+    ::interp alias $slave ::tcl::encoding::system {} \
+	::safe::AliasEncodingSystem $slave
 
     # Subcommands of info
-    foreach {subcommand alias} {
-	nameofexecutable   AliasExeName
-    } {
-	::interp alias $slave ::tcl::info::$subcommand \
-	    {} [namespace current]::$alias $slave
-    }
+    ::interp alias $slave ::tcl::info::nameofexecutable {} \
+	::safe::AliasExeName $slave
 
     # The allowed slave variables already have been set by Tcl_MakeSafe(3)
 
@@ -1027,16 +1025,13 @@ proc ::safe::BadSubcommand {slave command subcommand args} {
     return -code error -errorcode {TCL SAFE SUBCOMMAND} $msg
 }
 
-# AliasEncoding is the target of the "encoding" alias in safe interpreters.
-
-proc ::safe::AliasEncoding {slave option args} {
-    # Note that [encoding dirs] is not supported in safe slaves at all
-    set subcommands {convertfrom convertto names system}
+# AliasEncodingSystem is the target of the "encoding system" alias in safe
+# interpreters.
+proc ::safe::AliasEncodingSystem {slave args} {
     try {
-	set option [tcl::prefix match -error [list -level 1 -errorcode \
-		[list TCL LOOKUP INDEX option $option]] $subcommands $option]
-	# Special case: [encoding system] ok, but [encoding system foo] not
-	if {$option eq "system" && [llength $args]} {
+	# Must not pass extra arguments; safe slaves may not set the system
+	# encoding but they may read it.
+	if {[llength $args]} {
 	    return -code error -errorcode {TCL WRONGARGS} \
 		"wrong # args: should be \"encoding system\""
 	}
@@ -1044,7 +1039,7 @@ proc ::safe::AliasEncoding {slave option args} {
 	Log $slave $msg
 	return -options $options $msg
     }
-    tailcall ::interp invokehidden $slave encoding $option {*}$args
+    tailcall ::interp invokehidden $slave tcl:encoding:system
 }
 
 # Various minor hiding of platform features. [Bug 2913625]

library/tcltest/pkgIndex.tcl

@@ -9,4 +9,4 @@
 # full path name of this file's directory.
 
 if {![package vsatisfies [package provide Tcl] 8.5-]} {return}
-package ifneeded tcltest 2.4.1 [list source [file join $dir tcltest.tcl]]
+package ifneeded tcltest 2.5.0 [list source [file join $dir tcltest.tcl]]

library/tcltest/tcltest.tcl

@@ -22,7 +22,7 @@ namespace eval tcltest {
     # When the version number changes, be sure to update the pkgIndex.tcl file,
     # and the install directory in the Makefiles.  When the minor version
     # changes (new feature) be sure to update the man page as well.
-    variable Version 2.4.1
+    variable Version 2.5.0
 
     # Compatibility support for dumb variables defined in tcltest 1
     # Do not use these.  Call [package provide Tcl] and [info patchlevel]
@@ -1254,10 +1254,6 @@ proc tcltest::DefineConstraintInitializers {} {
     ConstraintInitializer interactive \
 	    {expr {[info exists ::tcl_interactive] && $::tcl_interactive}}
 
-    # Skip slow tests (to enable slow tests add parameter `-constraints slowTest`)
-
-    ConstraintInitializer slowTest {format 0}
-
     # Some tests can only be run if the installation came from a CD
     # image instead of a web image.  Some tests must be skipped if you
     # are running as root on Unix.  Other tests can only be run if you
@@ -1845,6 +1841,9 @@ proc tcltest::SubstArguments {argList} {
 #                       is optional; default is {}.
 #   returnCodes -       Expected return codes.  This attribute is
 #                       optional; default is {0 2}.
+#   errorCode -         Expected error code.  This attribute is
+#                       optional; default is {*}. It is a glob pattern.
+#                       If given, returnCodes defaults to {1}.
 #   setup -             Code to run before $script (above).  This
 #                       attribute is optional; default is {}.
 #   cleanup -           Code to run after $script (above).  This
@@ -1886,7 +1885,7 @@ proc tcltest::test {name description args} {
     # Pre-define everything to null except output and errorOutput.  We
     # determine whether or not to trap output based on whether or not
     # these variables (output & errorOutput) are defined.
-    lassign {} constraints setup cleanup body result returnCodes match
+    lassign {} constraints setup cleanup body result returnCodes errorCode match
 
     # Set the default match mode
     set match exact
@@ -1896,6 +1895,9 @@ proc tcltest::test {name description args} {
     # 'return' being used in the test script).
     set returnCodes [list 0 2]
 
+    # Set the default error code pattern
+    set errorCode "*"
+
     # The old test format can't have a 3rd argument (constraints or
     # script) that starts with '-'.
     if {[string match -* [lindex $args 0]] || ([llength $args] <= 1)} {
@@ -1905,7 +1907,7 @@ proc tcltest::test {name description args} {
 		set testAttributes($element) $value
 	    }
 	    foreach item {constraints match setup body cleanup \
-		    result returnCodes output errorOutput} {
+		    result returnCodes errorCode output errorOutput} {
 		if {[info exists testAttributes(-$item)]} {
 		    set testAttributes(-$item) [uplevel 1 \
 			    ::concat $testAttributes(-$item)]
@@ -1916,7 +1918,7 @@ proc tcltest::test {name description args} {
 	}
 
 	set validFlags {-setup -cleanup -body -result -returnCodes \
-		-match -output -errorOutput -constraints}
+		-errorCode -match -output -errorOutput -constraints}
 
 	foreach flag [array names testAttributes] {
 	    if {$flag ni $validFlags} {
@@ -1948,6 +1950,10 @@ proc tcltest::test {name description args} {
 	foreach {strcode numcode} {ok 0 normal 0 error 1 return 2 break 3 continue 4} {
 	    set returnCodes [string map -nocase [list $strcode $numcode] $returnCodes]
 	}
+        # errorCode without returnCode 1 is meaningless
+        if {$errorCode ne "*" && 1 ni $returnCodes} {
+            set returnCodes 1
+        }
     } else {
 	# This is parsing for the old test command format; it is here
 	# for backward compatibility.
@@ -1980,7 +1986,7 @@ proc tcltest::test {name description args} {
     set code [catch {uplevel 1 $setup} setupMsg]
     if {$code == 1} {
 	set errorInfo(setup) $::errorInfo
-	set errorCode(setup) $::errorCode
+	set errorCodeRes(setup) $::errorCode
     }
     set setupFailure [expr {$code != 0}]
 
@@ -2007,7 +2013,7 @@ proc tcltest::test {name description args} {
 	lassign $testResult actualAnswer returnCode
 	if {$returnCode == 1} {
 	    set errorInfo(body) $::errorInfo
-	    set errorCode(body) $::errorCode
+	    set errorCodeRes(body) $::errorCode
 	}
     }
 
@@ -2016,6 +2022,11 @@ proc tcltest::test {name description args} {
     if {!$setupFailure && ($returnCode ni $returnCodes)} {
 	set codeFailure 1
     }
+    set errorCodeFailure 0
+    if {!$setupFailure && !$codeFailure && $returnCode == 1 && \
+                ![string match $errorCode $errorCodeRes(body)]} {
+	set errorCodeFailure 1
+    }
 
     # If expected output/error strings exist, we have to compare
     # them.  If the comparison fails, then so did the test.
@@ -2059,7 +2070,7 @@ proc tcltest::test {name description args} {
     set code [catch {uplevel 1 $cleanup} cleanupMsg]
     if {$code == 1} {
 	set errorInfo(cleanup) $::errorInfo
-	set errorCode(cleanup) $::errorCode
+	set errorCodeRes(cleanup) $::errorCode
     }
     set cleanupFailure [expr {$code != 0}]
 
@@ -2110,7 +2121,7 @@ proc tcltest::test {name description args} {
     variable numTests
     if {!($setupFailure || $cleanupFailure || $coreFailure
 	    || $outputFailure || $errorFailure || $codeFailure
-	    || $scriptFailure)} {
+	    || $errorCodeFailure || $scriptFailure)} {
 	if {$testLevel == 1} {
 	    incr numTests(Passed)
 	    if {[IsVerbose pass]} {
@@ -2163,7 +2174,7 @@ proc tcltest::test {name description args} {
 		failed:\n$setupMsg"
 	if {[info exists errorInfo(setup)]} {
 	    puts [outputChannel] "---- errorInfo(setup): $errorInfo(setup)"
-	    puts [outputChannel] "---- errorCode(setup): $errorCode(setup)"
+	    puts [outputChannel] "---- errorCode(setup): $errorCodeRes(setup)"
 	}
     }
     if {$scriptFailure} {
@@ -2175,6 +2186,10 @@ proc tcltest::test {name description args} {
 		    ($match matching):\n$result"
 	}
     }
+    if {$errorCodeFailure} {
+	puts [outputChannel] "---- Error code was: '$errorCodeRes(body)'"
+	puts [outputChannel] "---- Error code should have been: '$errorCode'"
+    }
     if {$codeFailure} {
 	switch -- $returnCode {
 	    0 { set msg "Test completed normally" }
@@ -2190,7 +2205,7 @@ proc tcltest::test {name description args} {
 	if {[IsVerbose error]} {
 	    if {[info exists errorInfo(body)] && (1 ni $returnCodes)} {
 		puts [outputChannel] "---- errorInfo: $errorInfo(body)"
-		puts [outputChannel] "---- errorCode: $errorCode(body)"
+		puts [outputChannel] "---- errorCode: $errorCodeRes(body)"
 	    }
 	}
     }
@@ -2216,7 +2231,7 @@ proc tcltest::test {name description args} {
 	puts [outputChannel] "---- Test cleanup failed:\n$cleanupMsg"
 	if {[info exists errorInfo(cleanup)]} {
 	    puts [outputChannel] "---- errorInfo(cleanup): $errorInfo(cleanup)"
-	    puts [outputChannel] "---- errorCode(cleanup): $errorCode(cleanup)"
+	    puts [outputChannel] "---- errorCode(cleanup): $errorCodeRes(cleanup)"
 	}
     }
     if {$coreFailure} {
@@ -2726,7 +2741,7 @@ proc tcltest::GetMatchingDirectories {rootdir} {
 #	shell being tested
 #
 # Results:
-#	None.
+#	Whether there were any failures.
 #
 # Side effects:
 #	None.
@@ -2872,7 +2887,7 @@ proc tcltest::runAllTests { {shell ""} } {
 	puts [outputChannel] ""
 	puts [outputChannel] [string repeat ~ 44]
     }
-    return
+    return [info exists testFileFailures]
 }
 
 #####################################################################

library/tzdata/Africa/Casablanca

@@ -2,229 +2,59 @@
 
 set TZData(:Africa/Casablanca) {
     {-9223372036854775808 -1820 0 LMT}
-    {-1773012580 0 0 WET}
-    {-956361600 3600 1 WEST}
-    {-950490000 0 0 WET}
-    {-942019200 3600 1 WEST}
-    {-761187600 0 0 WET}
-    {-617241600 3600 1 WEST}
-    {-605149200 0 0 WET}
-    {-81432000 3600 1 WEST}
-    {-71110800 0 0 WET}
-    {141264000 3600 1 WEST}
-    {147222000 0 0 WET}
-    {199756800 3600 1 WEST}
-    {207702000 0 0 WET}
-    {231292800 3600 1 WEST}
-    {244249200 0 0 WET}
-    {265507200 3600 1 WEST}
-    {271033200 0 0 WET}
-    {448243200 3600 0 CET}
-    {504918000 0 0 WET}
-    {1212278400 3600 1 WEST}
-    {1220223600 0 0 WET}
-    {1243814400 3600 1 WEST}
-    {1250809200 0 0 WET}
-    {1272758400 3600 1 WEST}
-    {1281222000 0 0 WET}
-    {1301788800 3600 1 WEST}
-    {1312066800 0 0 WET}
-    {1335664800 3600 1 WEST}
-    {1342749600 0 0 WET}
-    {1345428000 3600 1 WEST}
-    {1348970400 0 0 WET}
-    {1367114400 3600 1 WEST}
-    {1373162400 0 0 WET}
-    {1376100000 3600 1 WEST}
-    {1382839200 0 0 WET}
-    {1396144800 3600 1 WEST}
-    {1403920800 0 0 WET}
-    {1406944800 3600 1 WEST}
-    {1414288800 0 0 WET}
-    {1427594400 3600 1 WEST}
-    {1434247200 0 0 WET}
-    {1437271200 3600 1 WEST}
-    {1445738400 0 0 WET}
-    {1459044000 3600 1 WEST}
-    {1465092000 0 0 WET}
-    {1468116000 3600 1 WEST}
-    {1477792800 0 0 WET}
-    {1490493600 3600 1 WEST}
-    {1495332000 0 0 WET}
-    {1498960800 3600 1 WEST}
-    {1509242400 0 0 WET}
-    {1521943200 3600 1 WEST}
-    {1526176800 0 0 WET}
-    {1529200800 3600 1 WEST}
-    {1540692000 0 0 WET}
-    {1553997600 3600 1 WEST}
-    {1557021600 0 0 WET}
-    {1560045600 3600 1 WEST}
-    {1572141600 0 0 WET}
-    {1585447200 3600 1 WEST}
-    {1587261600 0 0 WET}
-    {1590285600 3600 1 WEST}
-    {1603591200 0 0 WET}
-    {1616896800 3600 1 WEST}
-    {1618106400 0 0 WET}
-    {1621130400 3600 1 WEST}
-    {1635645600 0 0 WET}
-    {1651975200 3600 1 WEST}
-    {1667095200 0 0 WET}
-    {1682215200 3600 1 WEST}
-    {1698544800 0 0 WET}
-    {1713060000 3600 1 WEST}
-    {1729994400 0 0 WET}
-    {1743904800 3600 1 WEST}
-    {1761444000 0 0 WET}
-    {1774749600 3600 1 WEST}
-    {1792893600 0 0 WET}
-    {1806199200 3600 1 WEST}
-    {1824948000 0 0 WET}
-    {1837648800 3600 1 WEST}
-    {1856397600 0 0 WET}
-    {1869098400 3600 1 WEST}
-    {1887847200 0 0 WET}
-    {1901152800 3600 1 WEST}
-    {1919296800 0 0 WET}
-    {1932602400 3600 1 WEST}
-    {1950746400 0 0 WET}
-    {1964052000 3600 1 WEST}
-    {1982800800 0 0 WET}
-    {1995501600 3600 1 WEST}
-    {2014250400 0 0 WET}
-    {2026951200 3600 1 WEST}
-    {2045700000 0 0 WET}
-    {2058400800 3600 1 WEST}
-    {2077149600 0 0 WET}
-    {2090455200 3600 1 WEST}
-    {2107994400 0 0 WET}
-    {2108602800 0 0 WET}
-    {2121904800 3600 1 WEST}
-    {2138234400 0 0 WET}
-    {2140052400 0 0 WET}
-    {2153354400 3600 1 WEST}
-    {2172103200 0 0 WET}
-    {2184804000 3600 1 WEST}
-    {2203552800 0 0 WET}
-    {2216253600 3600 1 WEST}
-    {2235002400 0 0 WET}
-    {2248308000 3600 1 WEST}
-    {2266452000 0 0 WET}
-    {2279757600 3600 1 WEST}
-    {2297901600 0 0 WET}
-    {2311207200 3600 1 WEST}
-    {2329351200 0 0 WET}
-    {2342656800 3600 1 WEST}
-    {2361405600 0 0 WET}
-    {2374106400 3600 1 WEST}
-    {2392855200 0 0 WET}
-    {2405556000 3600 1 WEST}
-    {2424304800 0 0 WET}
-    {2437610400 3600 1 WEST}
-    {2455754400 0 0 WET}
-    {2469060000 3600 1 WEST}
-    {2487204000 0 0 WET}
-    {2500509600 3600 1 WEST}
-    {2519258400 0 0 WET}
-    {2531959200 3600 1 WEST}
-    {2550708000 0 0 WET}
-    {2563408800 3600 1 WEST}
-    {2582157600 0 0 WET}
-    {2595463200 3600 1 WEST}
-    {2613607200 0 0 WET}
-    {2626912800 3600 1 WEST}
-    {2645056800 0 0 WET}
-    {2658362400 3600 1 WEST}
-    {2676506400 0 0 WET}
-    {2689812000 3600 1 WEST}
-    {2708560800 0 0 WET}
-    {2721261600 3600 1 WEST}
-    {2740010400 0 0 WET}
-    {2752711200 3600 1 WEST}
-    {2771460000 0 0 WET}
-    {2784765600 3600 1 WEST}
-    {2802909600 0 0 WET}
-    {2816215200 3600 1 WEST}
-    {2834359200 0 0 WET}
-    {2847664800 3600 1 WEST}
-    {2866413600 0 0 WET}
-    {2879114400 3600 1 WEST}
-    {2897863200 0 0 WET}
-    {2910564000 3600 1 WEST}
-    {2929312800 0 0 WET}
-    {2942013600 3600 1 WEST}
-    {2960762400 0 0 WET}
-    {2974068000 3600 1 WEST}
-    {2992212000 0 0 WET}
-    {3005517600 3600 1 WEST}
-    {3023661600 0 0 WET}
-    {3036967200 3600 1 WEST}
-    {3055716000 0 0 WET}
-    {3068416800 3600 1 WEST}
-    {3087165600 0 0 WET}
-    {3099866400 3600 1 WEST}
-    {3118615200 0 0 WET}
-    {3131920800 3600 1 WEST}
-    {3150064800 0 0 WET}
-    {3163370400 3600 1 WEST}
-    {3181514400 0 0 WET}
-    {3194820000 3600 1 WEST}
-    {3212964000 0 0 WET}
-    {3226269600 3600 1 WEST}
-    {3245018400 0 0 WET}
-    {3257719200 3600 1 WEST}
-    {3276468000 0 0 WET}
-    {3289168800 3600 1 WEST}
-    {3307917600 0 0 WET}
-    {3321223200 3600 1 WEST}
-    {3339367200 0 0 WET}
-    {3352672800 3600 1 WEST}
-    {3370816800 0 0 WET}
-    {3384122400 3600 1 WEST}
-    {3402871200 0 0 WET}
-    {3415572000 3600 1 WEST}
-    {3434320800 0 0 WET}
-    {3447021600 3600 1 WEST}
-    {3465770400 0 0 WET}
-    {3479076000 3600 1 WEST}
-    {3497220000 0 0 WET}
-    {3510525600 3600 1 WEST}
-    {3528669600 0 0 WET}
-    {3541975200 3600 1 WEST}
-    {3560119200 0 0 WET}
-    {3573424800 3600 1 WEST}
-    {3592173600 0 0 WET}
-    {3604874400 3600 1 WEST}
-    {3623623200 0 0 WET}
-    {3636324000 3600 1 WEST}
-    {3655072800 0 0 WET}
-    {3668378400 3600 1 WEST}
-    {3686522400 0 0 WET}
-    {3699828000 3600 1 WEST}
-    {3717972000 0 0 WET}
-    {3731277600 3600 1 WEST}
-    {3750026400 0 0 WET}
-    {3762727200 3600 1 WEST}
-    {3781476000 0 0 WET}
-    {3794176800 3600 1 WEST}
-    {3812925600 0 0 WET}
-    {3825626400 3600 1 WEST}
-    {3844375200 0 0 WET}
-    {3857680800 3600 1 WEST}
-    {3875824800 0 0 WET}
-    {3889130400 3600 1 WEST}
-    {3907274400 0 0 WET}
-    {3920580000 3600 1 WEST}
-    {3939328800 0 0 WET}
-    {3952029600 3600 1 WEST}
-    {3970778400 0 0 WET}
-    {3983479200 3600 1 WEST}
-    {4002228000 0 0 WET}
-    {4015533600 3600 1 WEST}
-    {4033677600 0 0 WET}
-    {4046983200 3600 1 WEST}
-    {4065127200 0 0 WET}
-    {4078432800 3600 1 WEST}
-    {4096576800 0 0 WET}
+    {-1773012580 0 0 +00}
+    {-956361600 3600 1 +00}
+    {-950490000 0 0 +00}
+    {-942019200 3600 1 +00}
+    {-761187600 0 0 +00}
+    {-617241600 3600 1 +00}
+    {-605149200 0 0 +00}
+    {-81432000 3600 1 +00}
+    {-71110800 0 0 +00}
+    {141264000 3600 1 +00}
+    {147222000 0 0 +00}
+    {199756800 3600 1 +00}
+    {207702000 0 0 +00}
+    {231292800 3600 1 +00}
+    {244249200 0 0 +00}
+    {265507200 3600 1 +00}
+    {271033200 0 0 +00}
+    {448243200 3600 0 +01}
+    {504918000 0 0 +00}
+    {1212278400 3600 1 +00}
+    {1220223600 0 0 +00}
+    {1243814400 3600 1 +00}
+    {1250809200 0 0 +00}
+    {1272758400 3600 1 +00}
+    {1281222000 0 0 +00}
+    {1301788800 3600 1 +00}
+    {1312066800 0 0 +00}
+    {1335664800 3600 1 +00}
+    {1342749600 0 0 +00}
+    {1345428000 3600 1 +00}
+    {1348970400 0 0 +00}
+    {1367114400 3600 1 +00}
+    {1373162400 0 0 +00}
+    {1376100000 3600 1 +00}
+    {1382839200 0 0 +00}
+    {1396144800 3600 1 +00}
+    {1403920800 0 0 +00}
+    {1406944800 3600 1 +00}
+    {1414288800 0 0 +00}
+    {1427594400 3600 1 +00}
+    {1434247200 0 0 +00}
+    {1437271200 3600 1 +00}
+    {1445738400 0 0 +00}
+    {1459044000 3600 1 +00}
+    {1465092000 0 0 +00}
+    {1468116000 3600 1 +00}
+    {1477792800 0 0 +00}
+    {1490493600 3600 1 +00}
+    {1495332000 0 0 +00}
+    {1498960800 3600 1 +00}
+    {1509242400 0 0 +00}
+    {1521943200 3600 1 +00}
+    {1526176800 0 0 +00}
+    {1529200800 3600 1 +00}
+    {1540598400 3600 0 +01}
 }

library/tzdata/Africa/Ceuta

@@ -15,6 +15,7 @@ set TZData(:Africa/Ceuta) {
     {-1316390400 3600 1 WEST}
     {-1301270400 0 0 WET}
     {-1293840000 0 0 WET}
+    {-94694400 0 0 WET}
     {-81432000 3600 1 WEST}
     {-71110800 0 0 WET}
     {141264000 3600 1 WEST}

library/tzdata/Africa/El_Aaiun

@@ -3,217 +3,47 @@
 set TZData(:Africa/El_Aaiun) {
     {-9223372036854775808 -3168 0 LMT}
     {-1136070432 -3600 0 -01}
-    {198291600 0 0 WET}
-    {199756800 3600 1 WEST}
-    {207702000 0 0 WET}
-    {231292800 3600 1 WEST}
-    {244249200 0 0 WET}
-    {265507200 3600 1 WEST}
-    {271033200 0 0 WET}
-    {1212278400 3600 1 WEST}
-    {1220223600 0 0 WET}
-    {1243814400 3600 1 WEST}
-    {1250809200 0 0 WET}
-    {1272758400 3600 1 WEST}
-    {1281222000 0 0 WET}
-    {1301788800 3600 1 WEST}
-    {1312066800 0 0 WET}
-    {1335664800 3600 1 WEST}
-    {1342749600 0 0 WET}
-    {1345428000 3600 1 WEST}
-    {1348970400 0 0 WET}
-    {1367114400 3600 1 WEST}
-    {1373162400 0 0 WET}
-    {1376100000 3600 1 WEST}
-    {1382839200 0 0 WET}
-    {1396144800 3600 1 WEST}
-    {1403920800 0 0 WET}
-    {1406944800 3600 1 WEST}
-    {1414288800 0 0 WET}
-    {1427594400 3600 1 WEST}
-    {1434247200 0 0 WET}
-    {1437271200 3600 1 WEST}
-    {1445738400 0 0 WET}
-    {1459044000 3600 1 WEST}
-    {1465092000 0 0 WET}
-    {1468116000 3600 1 WEST}
-    {1477792800 0 0 WET}
-    {1490493600 3600 1 WEST}
-    {1495332000 0 0 WET}
-    {1498960800 3600 1 WEST}
-    {1509242400 0 0 WET}
-    {1521943200 3600 1 WEST}
-    {1526176800 0 0 WET}
-    {1529200800 3600 1 WEST}
-    {1540692000 0 0 WET}
-    {1553997600 3600 1 WEST}
-    {1557021600 0 0 WET}
-    {1560045600 3600 1 WEST}
-    {1572141600 0 0 WET}
-    {1585447200 3600 1 WEST}
-    {1587261600 0 0 WET}
-    {1590285600 3600 1 WEST}
-    {1603591200 0 0 WET}
-    {1616896800 3600 1 WEST}
-    {1618106400 0 0 WET}
-    {1621130400 3600 1 WEST}
-    {1635645600 0 0 WET}
-    {1651975200 3600 1 WEST}
-    {1667095200 0 0 WET}
-    {1682215200 3600 1 WEST}
-    {1698544800 0 0 WET}
-    {1713060000 3600 1 WEST}
-    {1729994400 0 0 WET}
-    {1743904800 3600 1 WEST}
-    {1761444000 0 0 WET}
-    {1774749600 3600 1 WEST}
-    {1792893600 0 0 WET}
-    {1806199200 3600 1 WEST}
-    {1824948000 0 0 WET}
-    {1837648800 3600 1 WEST}
-    {1856397600 0 0 WET}
-    {1869098400 3600 1 WEST}
-    {1887847200 0 0 WET}
-    {1901152800 3600 1 WEST}
-    {1919296800 0 0 WET}
-    {1932602400 3600 1 WEST}
-    {1950746400 0 0 WET}
-    {1964052000 3600 1 WEST}
-    {1982800800 0 0 WET}
-    {1995501600 3600 1 WEST}
-    {2014250400 0 0 WET}
-    {2026951200 3600 1 WEST}
-    {2045700000 0 0 WET}
-    {2058400800 3600 1 WEST}
-    {2077149600 0 0 WET}
-    {2090455200 3600 1 WEST}
-    {2107994400 0 0 WET}
-    {2108602800 0 0 WET}
-    {2121904800 3600 1 WEST}
-    {2138234400 0 0 WET}
-    {2140052400 0 0 WET}
-    {2153354400 3600 1 WEST}
-    {2172103200 0 0 WET}
-    {2184804000 3600 1 WEST}
-    {2203552800 0 0 WET}
-    {2216253600 3600 1 WEST}
-    {2235002400 0 0 WET}
-    {2248308000 3600 1 WEST}
-    {2266452000 0 0 WET}
-    {2279757600 3600 1 WEST}
-    {2297901600 0 0 WET}
-    {2311207200 3600 1 WEST}
-    {2329351200 0 0 WET}
-    {2342656800 3600 1 WEST}
-    {2361405600 0 0 WET}
-    {2374106400 3600 1 WEST}
-    {2392855200 0 0 WET}
-    {2405556000 3600 1 WEST}
-    {2424304800 0 0 WET}
-    {2437610400 3600 1 WEST}
-    {2455754400 0 0 WET}
-    {2469060000 3600 1 WEST}
-    {2487204000 0 0 WET}
-    {2500509600 3600 1 WEST}
-    {2519258400 0 0 WET}
-    {2531959200 3600 1 WEST}
-    {2550708000 0 0 WET}
-    {2563408800 3600 1 WEST}
-    {2582157600 0 0 WET}
-    {2595463200 3600 1 WEST}
-    {2613607200 0 0 WET}
-    {2626912800 3600 1 WEST}
-    {2645056800 0 0 WET}
-    {2658362400 3600 1 WEST}
-    {2676506400 0 0 WET}
-    {2689812000 3600 1 WEST}
-    {2708560800 0 0 WET}
-    {2721261600 3600 1 WEST}
-    {2740010400 0 0 WET}
-    {2752711200 3600 1 WEST}
-    {2771460000 0 0 WET}
-    {2784765600 3600 1 WEST}
-    {2802909600 0 0 WET}
-    {2816215200 3600 1 WEST}
-    {2834359200 0 0 WET}
-    {2847664800 3600 1 WEST}
-    {2866413600 0 0 WET}
-    {2879114400 3600 1 WEST}
-    {2897863200 0 0 WET}
-    {2910564000 3600 1 WEST}
-    {2929312800 0 0 WET}
-    {2942013600 3600 1 WEST}
-    {2960762400 0 0 WET}
-    {2974068000 3600 1 WEST}
-    {2992212000 0 0 WET}
-    {3005517600 3600 1 WEST}
-    {3023661600 0 0 WET}
-    {3036967200 3600 1 WEST}
-    {3055716000 0 0 WET}
-    {3068416800 3600 1 WEST}
-    {3087165600 0 0 WET}
-    {3099866400 3600 1 WEST}
-    {3118615200 0 0 WET}
-    {3131920800 3600 1 WEST}
-    {3150064800 0 0 WET}
-    {3163370400 3600 1 WEST}
-    {3181514400 0 0 WET}
-    {3194820000 3600 1 WEST}
-    {3212964000 0 0 WET}
-    {3226269600 3600 1 WEST}
-    {3245018400 0 0 WET}
-    {3257719200 3600 1 WEST}
-    {3276468000 0 0 WET}
-    {3289168800 3600 1 WEST}
-    {3307917600 0 0 WET}
-    {3321223200 3600 1 WEST}
-    {3339367200 0 0 WET}
-    {3352672800 3600 1 WEST}
-    {3370816800 0 0 WET}
-    {3384122400 3600 1 WEST}
-    {3402871200 0 0 WET}
-    {3415572000 3600 1 WEST}
-    {3434320800 0 0 WET}
-    {3447021600 3600 1 WEST}
-    {3465770400 0 0 WET}
-    {3479076000 3600 1 WEST}
-    {3497220000 0 0 WET}
-    {3510525600 3600 1 WEST}
-    {3528669600 0 0 WET}
-    {3541975200 3600 1 WEST}
-    {3560119200 0 0 WET}
-    {3573424800 3600 1 WEST}
-    {3592173600 0 0 WET}
-    {3604874400 3600 1 WEST}
-    {3623623200 0 0 WET}
-    {3636324000 3600 1 WEST}
-    {3655072800 0 0 WET}
-    {3668378400 3600 1 WEST}
-    {3686522400 0 0 WET}
-    {3699828000 3600 1 WEST}
-    {3717972000 0 0 WET}
-    {3731277600 3600 1 WEST}
-    {3750026400 0 0 WET}
-    {3762727200 3600 1 WEST}
-    {3781476000 0 0 WET}
-    {3794176800 3600 1 WEST}
-    {3812925600 0 0 WET}
-    {3825626400 3600 1 WEST}
-    {3844375200 0 0 WET}
-    {3857680800 3600 1 WEST}
-    {3875824800 0 0 WET}
-    {3889130400 3600 1 WEST}
-    {3907274400 0 0 WET}
-    {3920580000 3600 1 WEST}
-    {3939328800 0 0 WET}
-    {3952029600 3600 1 WEST}
-    {3970778400 0 0 WET}
-    {3983479200 3600 1 WEST}
-    {4002228000 0 0 WET}
-    {4015533600 3600 1 WEST}
-    {4033677600 0 0 WET}
-    {4046983200 3600 1 WEST}
-    {4065127200 0 0 WET}
-    {4078432800 3600 1 WEST}
-    {4096576800 0 0 WET}
+    {198291600 0 0 +00}
+    {199756800 3600 1 +00}
+    {207702000 0 0 +00}
+    {231292800 3600 1 +00}
+    {244249200 0 0 +00}
+    {265507200 3600 1 +00}
+    {271033200 0 0 +00}
+    {1212278400 3600 1 +00}
+    {1220223600 0 0 +00}
+    {1243814400 3600 1 +00}
+    {1250809200 0 0 +00}
+    {1272758400 3600 1 +00}
+    {1281222000 0 0 +00}
+    {1301788800 3600 1 +00}
+    {1312066800 0 0 +00}
+    {1335664800 3600 1 +00}
+    {1342749600 0 0 +00}
+    {1345428000 3600 1 +00}
+    {1348970400 0 0 +00}
+    {1367114400 3600 1 +00}
+    {1373162400 0 0 +00}
+    {1376100000 3600 1 +00}
+    {1382839200 0 0 +00}
+    {1396144800 3600 1 +00}
+    {1403920800 0 0 +00}
+    {1406944800 3600 1 +00}
+    {1414288800 0 0 +00}
+    {1427594400 3600 1 +00}
+    {1434247200 0 0 +00}
+    {1437271200 3600 1 +00}
+    {1445738400 0 0 +00}
+    {1459044000 3600 1 +00}
+    {1465092000 0 0 +00}
+    {1468116000 3600 1 +00}
+    {1477792800 0 0 +00}
+    {1490493600 3600 1 +00}
+    {1495332000 0 0 +00}
+    {1498960800 3600 1 +00}
+    {1509242400 0 0 +00}
+    {1521943200 3600 1 +00}
+    {1526176800 0 0 +00}
+    {1529200800 3600 1 +00}
+    {1540598400 3600 0 +01}
 }

library/tzdata/America/Santiago

@@ -124,166 +124,166 @@ set TZData(:America/Santiago) {
     {1502596800 -10800 1 -04}
     {1526180400 -14400 0 -04}
     {1534046400 -10800 1 -04}
-    {1557630000 -14400 0 -04}
-    {1565496000 -10800 1 -04}
-    {1589079600 -14400 0 -04}
-    {1596945600 -10800 1 -04}
-    {1620529200 -14400 0 -04}
-    {1629000000 -10800 1 -04}
-    {1652583600 -14400 0 -04}
-    {1660449600 -10800 1 -04}
-    {1684033200 -14400 0 -04}
-    {1691899200 -10800 1 -04}
-    {1715482800 -14400 0 -04}
-    {1723348800 -10800 1 -04}
-    {1746932400 -14400 0 -04}
-    {1754798400 -10800 1 -04}
-    {1778382000 -14400 0 -04}
-    {1786248000 -10800 1 -04}
-    {1809831600 -14400 0 -04}
-    {1818302400 -10800 1 -04}
-    {1841886000 -14400 0 -04}
-    {1849752000 -10800 1 -04}
-    {1873335600 -14400 0 -04}
-    {1881201600 -10800 1 -04}
-    {1904785200 -14400 0 -04}
-    {1912651200 -10800 1 -04}
-    {1936234800 -14400 0 -04}
-    {1944100800 -10800 1 -04}
-    {1967684400 -14400 0 -04}
-    {1976155200 -10800 1 -04}
-    {1999738800 -14400 0 -04}
-    {2007604800 -10800 1 -04}
-    {2031188400 -14400 0 -04}
-    {2039054400 -10800 1 -04}
-    {2062638000 -14400 0 -04}
-    {2070504000 -10800 1 -04}
-    {2094087600 -14400 0 -04}
-    {2101953600 -10800 1 -04}
-    {2125537200 -14400 0 -04}
-    {2133403200 -10800 1 -04}
-    {2156986800 -14400 0 -04}
-    {2165457600 -10800 1 -04}
-    {2189041200 -14400 0 -04}
-    {2196907200 -10800 1 -04}
-    {2220490800 -14400 0 -04}
-    {2228356800 -10800 1 -04}
-    {2251940400 -14400 0 -04}
-    {2259806400 -10800 1 -04}
-    {2283390000 -14400 0 -04}
-    {2291256000 -10800 1 -04}
-    {2314839600 -14400 0 -04}
-    {2322705600 -10800 1 -04}
-    {2346894000 -14400 0 -04}
-    {2354760000 -10800 1 -04}
-    {2378343600 -14400 0 -04}
-    {2386209600 -10800 1 -04}
-    {2409793200 -14400 0 -04}
-    {2417659200 -10800 1 -04}
-    {2441242800 -14400 0 -04}
-    {2449108800 -10800 1 -04}
-    {2472692400 -14400 0 -04}
-    {2480558400 -10800 1 -04}
-    {2504142000 -14400 0 -04}
-    {2512612800 -10800 1 -04}
-    {2536196400 -14400 0 -04}
-    {2544062400 -10800 1 -04}
-    {2567646000 -14400 0 -04}
-    {2575512000 -10800 1 -04}
-    {2599095600 -14400 0 -04}
-    {2606961600 -10800 1 -04}
-    {2630545200 -14400 0 -04}
-    {2638411200 -10800 1 -04}
-    {2661994800 -14400 0 -04}
-    {2669860800 -10800 1 -04}
-    {2693444400 -14400 0 -04}
-    {2701915200 -10800 1 -04}
-    {2725498800 -14400 0 -04}
-    {2733364800 -10800 1 -04}
-    {2756948400 -14400 0 -04}
-    {2764814400 -10800 1 -04}
-    {2788398000 -14400 0 -04}
-    {2796264000 -10800 1 -04}
-    {2819847600 -14400 0 -04}
-    {2827713600 -10800 1 -04}
-    {2851297200 -14400 0 -04}
-    {2859768000 -10800 1 -04}
-    {2883351600 -14400 0 -04}
-    {2891217600 -10800 1 -04}
-    {2914801200 -14400 0 -04}
-    {2922667200 -10800 1 -04}
-    {2946250800 -14400 0 -04}
-    {2954116800 -10800 1 -04}
-    {2977700400 -14400 0 -04}
-    {2985566400 -10800 1 -04}
-    {3009150000 -14400 0 -04}
-    {3017016000 -10800 1 -04}
-    {3040599600 -14400 0 -04}
-    {3049070400 -10800 1 -04}
-    {3072654000 -14400 0 -04}
-    {3080520000 -10800 1 -04}
-    {3104103600 -14400 0 -04}
-    {3111969600 -10800 1 -04}
-    {3135553200 -14400 0 -04}
-    {3143419200 -10800 1 -04}
-    {3167002800 -14400 0 -04}
-    {3174868800 -10800 1 -04}
-    {3198452400 -14400 0 -04}
-    {3206318400 -10800 1 -04}
-    {3230506800 -14400 0 -04}
-    {3238372800 -10800 1 -04}
-    {3261956400 -14400 0 -04}
-    {3269822400 -10800 1 -04}
-    {3293406000 -14400 0 -04}
-    {3301272000 -10800 1 -04}
-    {3324855600 -14400 0 -04}
-    {3332721600 -10800 1 -04}
-    {3356305200 -14400 0 -04}
-    {3364171200 -10800 1 -04}
-    {3387754800 -14400 0 -04}
-    {3396225600 -10800 1 -04}
-    {3419809200 -14400 0 -04}
-    {3427675200 -10800 1 -04}
-    {3451258800 -14400 0 -04}
-    {3459124800 -10800 1 -04}
-    {3482708400 -14400 0 -04}
-    {3490574400 -10800 1 -04}
-    {3514158000 -14400 0 -04}
-    {3522024000 -10800 1 -04}
-    {3545607600 -14400 0 -04}
-    {3553473600 -10800 1 -04}
-    {3577057200 -14400 0 -04}
-    {3585528000 -10800 1 -04}
-    {3609111600 -14400 0 -04}
-    {3616977600 -10800 1 -04}
-    {3640561200 -14400 0 -04}
-    {3648427200 -10800 1 -04}
-    {3672010800 -14400 0 -04}
-    {3679876800 -10800 1 -04}
-    {3703460400 -14400 0 -04}
-    {3711326400 -10800 1 -04}
-    {3734910000 -14400 0 -04}
-    {3743380800 -10800 1 -04}
-    {3766964400 -14400 0 -04}
-    {3774830400 -10800 1 -04}
-    {3798414000 -14400 0 -04}
-    {3806280000 -10800 1 -04}
-    {3829863600 -14400 0 -04}
-    {3837729600 -10800 1 -04}
-    {3861313200 -14400 0 -04}
-    {3869179200 -10800 1 -04}
-    {3892762800 -14400 0 -04}
-    {3900628800 -10800 1 -04}
-    {3924212400 -14400 0 -04}
-    {3932683200 -10800 1 -04}
-    {3956266800 -14400 0 -04}
-    {3964132800 -10800 1 -04}
-    {3987716400 -14400 0 -04}
-    {3995582400 -10800 1 -04}
-    {4019166000 -14400 0 -04}
-    {4027032000 -10800 1 -04}
-    {4050615600 -14400 0 -04}
-    {4058481600 -10800 1 -04}
-    {4082065200 -14400 0 -04}
-    {4089931200 -10800 1 -04}
+    {1554606000 -14400 0 -04}
+    {1567915200 -10800 1 -04}
+    {1586055600 -14400 0 -04}
+    {1599364800 -10800 1 -04}
+    {1617505200 -14400 0 -04}
+    {1630814400 -10800 1 -04}
+    {1648954800 -14400 0 -04}
+    {1662264000 -10800 1 -04}
+    {1680404400 -14400 0 -04}
+    {1693713600 -10800 1 -04}
+    {1712458800 -14400 0 -04}
+    {1725768000 -10800 1 -04}
+    {1743908400 -14400 0 -04}
+    {1757217600 -10800 1 -04}
+    {1775358000 -14400 0 -04}
+    {1788667200 -10800 1 -04}
+    {1806807600 -14400 0 -04}
+    {1820116800 -10800 1 -04}
+    {1838257200 -14400 0 -04}
+    {1851566400 -10800 1 -04}
+    {1870311600 -14400 0 -04}
+    {1883016000 -10800 1 -04}
+    {1901761200 -14400 0 -04}
+    {1915070400 -10800 1 -04}
+    {1933210800 -14400 0 -04}
+    {1946520000 -10800 1 -04}
+    {1964660400 -14400 0 -04}
+    {1977969600 -10800 1 -04}
+    {1996110000 -14400 0 -04}
+    {2009419200 -10800 1 -04}
+    {2027559600 -14400 0 -04}
+    {2040868800 -10800 1 -04}
+    {2059614000 -14400 0 -04}
+    {2072318400 -10800 1 -04}
+    {2091063600 -14400 0 -04}
+    {2104372800 -10800 1 -04}
+    {2122513200 -14400 0 -04}
+    {2135822400 -10800 1 -04}
+    {2153962800 -14400 0 -04}
+    {2167272000 -10800 1 -04}
+    {2185412400 -14400 0 -04}
+    {2198721600 -10800 1 -04}
+    {2217466800 -14400 0 -04}
+    {2230171200 -10800 1 -04}
+    {2248916400 -14400 0 -04}
+    {2262225600 -10800 1 -04}
+    {2280366000 -14400 0 -04}
+    {2293675200 -10800 1 -04}
+    {2311815600 -14400 0 -04}
+    {2325124800 -10800 1 -04}
+    {2343265200 -14400 0 -04}
+    {2356574400 -10800 1 -04}
+    {2374714800 -14400 0 -04}
+    {2388024000 -10800 1 -04}
+    {2406769200 -14400 0 -04}
+    {2419473600 -10800 1 -04}
+    {2438218800 -14400 0 -04}
+    {2451528000 -10800 1 -04}
+    {2469668400 -14400 0 -04}
+    {2482977600 -10800 1 -04}
+    {2501118000 -14400 0 -04}
+    {2514427200 -10800 1 -04}
+    {2532567600 -14400 0 -04}
+    {2545876800 -10800 1 -04}
+    {2564017200 -14400 0 -04}
+    {2577326400 -10800 1 -04}
+    {2596071600 -14400 0 -04}
+    {2609380800 -10800 1 -04}
+    {2627521200 -14400 0 -04}
+    {2640830400 -10800 1 -04}
+    {2658970800 -14400 0 -04}
+    {2672280000 -10800 1 -04}
+    {2690420400 -14400 0 -04}
+    {2703729600 -10800 1 -04}
+    {2721870000 -14400 0 -04}
+    {2735179200 -10800 1 -04}
+    {2753924400 -14400 0 -04}
+    {2766628800 -10800 1 -04}
+    {2785374000 -14400 0 -04}
+    {2798683200 -10800 1 -04}
+    {2816823600 -14400 0 -04}
+    {2830132800 -10800 1 -04}
+    {2848273200 -14400 0 -04}
+    {2861582400 -10800 1 -04}
+    {2879722800 -14400 0 -04}
+    {2893032000 -10800 1 -04}
+    {2911172400 -14400 0 -04}
+    {2924481600 -10800 1 -04}
+    {2943226800 -14400 0 -04}
+    {2955931200 -10800 1 -04}
+    {2974676400 -14400 0 -04}
+    {2987985600 -10800 1 -04}
+    {3006126000 -14400 0 -04}
+    {3019435200 -10800 1 -04}
+    {3037575600 -14400 0 -04}
+    {3050884800 -10800 1 -04}
+    {3069025200 -14400 0 -04}
+    {3082334400 -10800 1 -04}
+    {3101079600 -14400 0 -04}
+    {3113784000 -10800 1 -04}
+    {3132529200 -14400 0 -04}
+    {3145838400 -10800 1 -04}
+    {3163978800 -14400 0 -04}
+    {3177288000 -10800 1 -04}
+    {3195428400 -14400 0 -04}
+    {3208737600 -10800 1 -04}
+    {3226878000 -14400 0 -04}
+    {3240187200 -10800 1 -04}
+    {3258327600 -14400 0 -04}
+    {3271636800 -10800 1 -04}
+    {3290382000 -14400 0 -04}
+    {3303086400 -10800 1 -04}
+    {3321831600 -14400 0 -04}
+    {3335140800 -10800 1 -04}
+    {3353281200 -14400 0 -04}
+    {3366590400 -10800 1 -04}
+    {3384730800 -14400 0 -04}
+    {3398040000 -10800 1 -04}
+    {3416180400 -14400 0 -04}
+    {3429489600 -10800 1 -04}
+    {3447630000 -14400 0 -04}
+    {3460939200 -10800 1 -04}
+    {3479684400 -14400 0 -04}
+    {3492993600 -10800 1 -04}
+    {3511134000 -14400 0 -04}
+    {3524443200 -10800 1 -04}
+    {3542583600 -14400 0 -04}
+    {3555892800 -10800 1 -04}
+    {3574033200 -14400 0 -04}
+    {3587342400 -10800 1 -04}
+    {3605482800 -14400 0 -04}
+    {3618792000 -10800 1 -04}
+    {3637537200 -14400 0 -04}
+    {3650241600 -10800 1 -04}
+    {3668986800 -14400 0 -04}
+    {3682296000 -10800 1 -04}
+    {3700436400 -14400 0 -04}
+    {3713745600 -10800 1 -04}
+    {3731886000 -14400 0 -04}
+    {3745195200 -10800 1 -04}
+    {3763335600 -14400 0 -04}
+    {3776644800 -10800 1 -04}
+    {3794785200 -14400 0 -04}
+    {3808094400 -10800 1 -04}
+    {3826839600 -14400 0 -04}
+    {3839544000 -10800 1 -04}
+    {3858289200 -14400 0 -04}
+    {3871598400 -10800 1 -04}
+    {3889738800 -14400 0 -04}
+    {3903048000 -10800 1 -04}
+    {3921188400 -14400 0 -04}
+    {3934497600 -10800 1 -04}
+    {3952638000 -14400 0 -04}
+    {3965947200 -10800 1 -04}
+    {3984692400 -14400 0 -04}
+    {3997396800 -10800 1 -04}
+    {4016142000 -14400 0 -04}
+    {4029451200 -10800 1 -04}
+    {4047591600 -14400 0 -04}
+    {4060900800 -10800 1 -04}
+    {4079041200 -14400 0 -04}
+    {4092350400 -10800 1 -04}
 }

library/tzdata/Asia/Macau

@@ -1,20 +1,56 @@
 # created by tools/tclZIC.tcl - do not edit
 
 set TZData(:Asia/Macau) {
-    {-9223372036854775808 27260 0 LMT}
-    {-1830412800 28800 0 CST}
+    {-9223372036854775808 27250 0 LMT}
+    {-2056692850 28800 0 CST}
+    {-884509200 32400 0 +09}
+    {-873280800 36000 1 +09}
+    {-855918000 32400 0 +09}
+    {-841744800 36000 1 +09}
+    {-828529200 32400 0 +10}
+    {-765363600 28800 0 CT}
+    {-747046800 32400 1 CDT}
+    {-733827600 28800 0 CST}
+    {-716461200 32400 1 CDT}
+    {-697021200 28800 0 CST}
+    {-683715600 32400 1 CDT}
+    {-667990800 28800 0 CST}
+    {-654771600 32400 1 CDT}
+    {-636627600 28800 0 CST}
+    {-623322000 32400 1 CDT}
+    {-605178000 28800 0 CST}
+    {-591872400 32400 1 CDT}
+    {-573642000 28800 0 CST}
+    {-559818000 32400 1 CDT}
+    {-541674000 28800 0 CST}
+    {-528368400 32400 1 CDT}
+    {-510224400 28800 0 CST}
+    {-498128400 32400 1 CDT}
+    {-478774800 28800 0 CST}
+    {-466678800 32400 1 CDT}
+    {-446720400 28800 0 CST}
+    {-435229200 32400 1 CDT}
+    {-415258200 28800 0 CST}
+    {-403158600 32400 1 CDT}
+    {-383808600 28800 0 CST}
+    {-371709000 32400 1 CDT}
+    {-352359000 28800 0 CST}
+    {-340259400 32400 1 CDT}
+    {-320909400 28800 0 CST}
+    {-308809800 32400 1 CDT}
+    {-288855000 28800 0 CST}
     {-277360200 32400 1 CDT}
     {-257405400 28800 0 CST}
     {-245910600 32400 1 CDT}
     {-225955800 28800 0 CST}
-    {-214473600 32400 1 CDT}
+    {-213856200 32400 1 CDT}
     {-194506200 28800 0 CST}
     {-182406600 32400 1 CDT}
     {-163056600 28800 0 CST}
-    {-150969600 32400 1 CDT}
-    {-131619600 28800 0 CST}
+    {-148537800 32400 1 CDT}
+    {-132820200 28800 0 CST}
     {-117088200 32400 1 CDT}
-    {-101367000 28800 0 CST}
+    {-101370600 28800 0 CST}
     {-85638600 32400 1 CDT}
     {-69312600 28800 0 CST}
     {-53584200 32400 1 CDT}
@@ -25,22 +61,16 @@ set TZData(:Asia/Macau) {
     {25036200 28800 0 CST}
     {40764600 32400 1 CDT}
     {56485800 28800 0 CST}
-    {72201600 32400 1 CDT}
-    {87922800 28800 0 CST}
-    {103651200 32400 1 CDT}
-    {119977200 28800 0 CST}
-    {135705600 32400 1 CDT}
+    {72214200 32400 1 CDT}
+    {88540200 28800 0 CST}
+    {104268600 32400 1 CDT}
+    {119989800 28800 0 CST}
+    {126041400 32400 1 CDT}
     {151439400 28800 0 CST}
     {167167800 32400 1 CDT}
     {182889000 28800 0 CST}
     {198617400 32400 1 CDT}
     {214338600 28800 0 CST}
-    {230067000 32400 1 CDT}
-    {245788200 28800 0 CST}
-    {261504000 32400 1 CDT}
-    {277225200 28800 0 CST}
-    {292953600 32400 1 CDT}
-    {309279600 28800 0 CST}
-    {325008000 32400 1 CDT}
-    {340729200 28800 0 CST}
+    {295385400 32400 1 CDT}
+    {309292200 28800 0 CST}
 }

library/tzdata/Asia/Manila

@@ -3,13 +3,13 @@
 set TZData(:Asia/Manila) {
     {-9223372036854775808 -57360 0 LMT}
     {-3944621040 29040 0 LMT}
-    {-2229321840 28800 0 +08}
-    {-1046678400 32400 1 +08}
-    {-1038733200 28800 0 +08}
-    {-873273600 32400 0 +09}
-    {-794221200 28800 0 +08}
-    {-496224000 32400 1 +08}
-    {-489315600 28800 0 +08}
-    {259344000 32400 1 +08}
-    {275151600 28800 0 +08}
+    {-2229321840 28800 0 PST}
+    {-1046678400 32400 1 PDT}
+    {-1038733200 28800 0 PST}
+    {-873273600 32400 0 JST}
+    {-794221200 28800 0 PST}
+    {-496224000 32400 1 PDT}
+    {-489315600 28800 0 PST}
+    {259344000 32400 1 PDT}
+    {275151600 28800 0 PST}
 }

library/tzdata/Asia/Pyongyang

@@ -6,5 +6,5 @@ set TZData(:Asia/Pyongyang) {
     {-1830414600 32400 0 JST}
     {-768646800 32400 0 KST}
     {1439564400 30600 0 KST}
-    {1525447800 32400 0 KST}
+    {1525446000 32400 0 KST}
 }

library/tzdata/Asia/Shanghai

@@ -3,21 +3,30 @@
 set TZData(:Asia/Shanghai) {
     {-9223372036854775808 29143 0 LMT}
     {-2177481943 28800 0 CST}
-    {-933494400 32400 1 CDT}
-    {-923130000 28800 0 CST}
-    {-908784000 32400 1 CDT}
-    {-891594000 28800 0 CST}
-    {-662716800 28800 0 CST}
-    {515520000 32400 1 CDT}
-    {527007600 28800 0 CST}
-    {545155200 32400 1 CDT}
-    {558457200 28800 0 CST}
-    {576604800 32400 1 CDT}
-    {589906800 28800 0 CST}
-    {608659200 32400 1 CDT}
-    {621961200 28800 0 CST}
-    {640108800 32400 1 CDT}
-    {653410800 28800 0 CST}
-    {671558400 32400 1 CDT}
-    {684860400 28800 0 CST}
+    {-933667200 32400 1 CDT}
+    {-922093200 28800 0 CST}
+    {-908870400 32400 1 CDT}
+    {-888829200 28800 0 CST}
+    {-881049600 32400 1 CDT}
+    {-767869200 28800 0 CST}
+    {-745833600 32400 1 CDT}
+    {-733827600 28800 0 CST}
+    {-716889600 32400 1 CDT}
+    {-699613200 28800 0 CST}
+    {-683884800 32400 1 CDT}
+    {-670669200 28800 0 CST}
+    {-652348800 32400 1 CDT}
+    {-650016000 28800 0 CST}
+    {515527200 32400 1 CDT}
+    {527014800 28800 0 CST}
+    {545162400 32400 1 CDT}
+    {558464400 28800 0 CST}
+    {577216800 32400 1 CDT}
+    {589914000 28800 0 CST}
+    {608666400 32400 1 CDT}
+    {621968400 28800 0 CST}
+    {640116000 32400 1 CDT}
+    {653418000 28800 0 CST}
+    {671565600 32400 1 CDT}
+    {684867600 28800 0 CST}
 }

library/tzdata/Asia/Tokyo

@@ -4,11 +4,11 @@ set TZData(:Asia/Tokyo) {
     {-9223372036854775808 33539 0 LMT}
     {-2587712400 32400 0 JST}
     {-683802000 36000 1 JDT}
-    {-672314400 32400 0 JST}
+    {-672310800 32400 0 JST}
     {-654771600 36000 1 JDT}
-    {-640864800 32400 0 JST}
+    {-640861200 32400 0 JST}
     {-620298000 36000 1 JDT}
-    {-609415200 32400 0 JST}
+    {-609411600 32400 0 JST}
     {-588848400 36000 1 JDT}
-    {-577965600 32400 0 JST}
+    {-577962000 32400 0 JST}
 }

library/tzdata/Europe/Volgograd

@@ -68,4 +68,5 @@ set TZData(:Europe/Volgograd) {
     {1288479600 10800 0 +03}
     {1301180400 14400 0 +04}
     {1414274400 10800 0 +03}
+    {1540681200 14400 0 +04}
 }

library/tzdata/Pacific/Easter

@@ -103,166 +103,166 @@ set TZData(:Pacific/Easter) {
     {1502596800 -18000 1 -06}
     {1526180400 -21600 0 -06}
     {1534046400 -18000 1 -06}
-    {1557630000 -21600 0 -06}
-    {1565496000 -18000 1 -06}
-    {1589079600 -21600 0 -06}
-    {1596945600 -18000 1 -06}
-    {1620529200 -21600 0 -06}
-    {1629000000 -18000 1 -06}
-    {1652583600 -21600 0 -06}
-    {1660449600 -18000 1 -06}
-    {1684033200 -21600 0 -06}
-    {1691899200 -18000 1 -06}
-    {1715482800 -21600 0 -06}
-    {1723348800 -18000 1 -06}
-    {1746932400 -21600 0 -06}
-    {1754798400 -18000 1 -06}
-    {1778382000 -21600 0 -06}
-    {1786248000 -18000 1 -06}
-    {1809831600 -21600 0 -06}
-    {1818302400 -18000 1 -06}
-    {1841886000 -21600 0 -06}
-    {1849752000 -18000 1 -06}
-    {1873335600 -21600 0 -06}
-    {1881201600 -18000 1 -06}
-    {1904785200 -21600 0 -06}
-    {1912651200 -18000 1 -06}
-    {1936234800 -21600 0 -06}
-    {1944100800 -18000 1 -06}
-    {1967684400 -21600 0 -06}
-    {1976155200 -18000 1 -06}
-    {1999738800 -21600 0 -06}
-    {2007604800 -18000 1 -06}
-    {2031188400 -21600 0 -06}
-    {2039054400 -18000 1 -06}
-    {2062638000 -21600 0 -06}
-    {2070504000 -18000 1 -06}
-    {2094087600 -21600 0 -06}
-    {2101953600 -18000 1 -06}
-    {2125537200 -21600 0 -06}
-    {2133403200 -18000 1 -06}
-    {2156986800 -21600 0 -06}
-    {2165457600 -18000 1 -06}
-    {2189041200 -21600 0 -06}
-    {2196907200 -18000 1 -06}
-    {2220490800 -21600 0 -06}
-    {2228356800 -18000 1 -06}
-    {2251940400 -21600 0 -06}
-    {2259806400 -18000 1 -06}
-    {2283390000 -21600 0 -06}
-    {2291256000 -18000 1 -06}
-    {2314839600 -21600 0 -06}
-    {2322705600 -18000 1 -06}
-    {2346894000 -21600 0 -06}
-    {2354760000 -18000 1 -06}
-    {2378343600 -21600 0 -06}
-    {2386209600 -18000 1 -06}
-    {2409793200 -21600 0 -06}
-    {2417659200 -18000 1 -06}
-    {2441242800 -21600 0 -06}
-    {2449108800 -18000 1 -06}
-    {2472692400 -21600 0 -06}
-    {2480558400 -18000 1 -06}
-    {2504142000 -21600 0 -06}
-    {2512612800 -18000 1 -06}
-    {2536196400 -21600 0 -06}
-    {2544062400 -18000 1 -06}
-    {2567646000 -21600 0 -06}
-    {2575512000 -18000 1 -06}
-    {2599095600 -21600 0 -06}
-    {2606961600 -18000 1 -06}
-    {2630545200 -21600 0 -06}
-    {2638411200 -18000 1 -06}
-    {2661994800 -21600 0 -06}
-    {2669860800 -18000 1 -06}
-    {2693444400 -21600 0 -06}
-    {2701915200 -18000 1 -06}
-    {2725498800 -21600 0 -06}
-    {2733364800 -18000 1 -06}
-    {2756948400 -21600 0 -06}
-    {2764814400 -18000 1 -06}
-    {2788398000 -21600 0 -06}
-    {2796264000 -18000 1 -06}
-    {2819847600 -21600 0 -06}
-    {2827713600 -18000 1 -06}
-    {2851297200 -21600 0 -06}
-    {2859768000 -18000 1 -06}
-    {2883351600 -21600 0 -06}
-    {2891217600 -18000 1 -06}
-    {2914801200 -21600 0 -06}
-    {2922667200 -18000 1 -06}
-    {2946250800 -21600 0 -06}
-    {2954116800 -18000 1 -06}
-    {2977700400 -21600 0 -06}
-    {2985566400 -18000 1 -06}
-    {3009150000 -21600 0 -06}
-    {3017016000 -18000 1 -06}
-    {3040599600 -21600 0 -06}
-    {3049070400 -18000 1 -06}
-    {3072654000 -21600 0 -06}
-    {3080520000 -18000 1 -06}
-    {3104103600 -21600 0 -06}
-    {3111969600 -18000 1 -06}
-    {3135553200 -21600 0 -06}
-    {3143419200 -18000 1 -06}
-    {3167002800 -21600 0 -06}
-    {3174868800 -18000 1 -06}
-    {3198452400 -21600 0 -06}
-    {3206318400 -18000 1 -06}
-    {3230506800 -21600 0 -06}
-    {3238372800 -18000 1 -06}
-    {3261956400 -21600 0 -06}
-    {3269822400 -18000 1 -06}
-    {3293406000 -21600 0 -06}
-    {3301272000 -18000 1 -06}
-    {3324855600 -21600 0 -06}
-    {3332721600 -18000 1 -06}
-    {3356305200 -21600 0 -06}
-    {3364171200 -18000 1 -06}
-    {3387754800 -21600 0 -06}
-    {3396225600 -18000 1 -06}
-    {3419809200 -21600 0 -06}
-    {3427675200 -18000 1 -06}
-    {3451258800 -21600 0 -06}
-    {3459124800 -18000 1 -06}
-    {3482708400 -21600 0 -06}
-    {3490574400 -18000 1 -06}
-    {3514158000 -21600 0 -06}
-    {3522024000 -18000 1 -06}
-    {3545607600 -21600 0 -06}
-    {3553473600 -18000 1 -06}
-    {3577057200 -21600 0 -06}
-    {3585528000 -18000 1 -06}
-    {3609111600 -21600 0 -06}
-    {3616977600 -18000 1 -06}
-    {3640561200 -21600 0 -06}
-    {3648427200 -18000 1 -06}
-    {3672010800 -21600 0 -06}
-    {3679876800 -18000 1 -06}
-    {3703460400 -21600 0 -06}
-    {3711326400 -18000 1 -06}
-    {3734910000 -21600 0 -06}
-    {3743380800 -18000 1 -06}
-    {3766964400 -21600 0 -06}
-    {3774830400 -18000 1 -06}
-    {3798414000 -21600 0 -06}
-    {3806280000 -18000 1 -06}
-    {3829863600 -21600 0 -06}
-    {3837729600 -18000 1 -06}
-    {3861313200 -21600 0 -06}
-    {3869179200 -18000 1 -06}
-    {3892762800 -21600 0 -06}
-    {3900628800 -18000 1 -06}
-    {3924212400 -21600 0 -06}
-    {3932683200 -18000 1 -06}
-    {3956266800 -21600 0 -06}
-    {3964132800 -18000 1 -06}
-    {3987716400 -21600 0 -06}
-    {3995582400 -18000 1 -06}
-    {4019166000 -21600 0 -06}
-    {4027032000 -18000 1 -06}
-    {4050615600 -21600 0 -06}
-    {4058481600 -18000 1 -06}
-    {4082065200 -21600 0 -06}
-    {4089931200 -18000 1 -06}
+    {1554606000 -21600 0 -06}
+    {1567915200 -18000 1 -06}
+    {1586055600 -21600 0 -06}
+    {1599364800 -18000 1 -06}
+    {1617505200 -21600 0 -06}
+    {1630814400 -18000 1 -06}
+    {1648954800 -21600 0 -06}
+    {1662264000 -18000 1 -06}
+    {1680404400 -21600 0 -06}
+    {1693713600 -18000 1 -06}
+    {1712458800 -21600 0 -06}
+    {1725768000 -18000 1 -06}
+    {1743908400 -21600 0 -06}
+    {1757217600 -18000 1 -06}
+    {1775358000 -21600 0 -06}
+    {1788667200 -18000 1 -06}
+    {1806807600 -21600 0 -06}
+    {1820116800 -18000 1 -06}
+    {1838257200 -21600 0 -06}
+    {1851566400 -18000 1 -06}
+    {1870311600 -21600 0 -06}
+    {1883016000 -18000 1 -06}
+    {1901761200 -21600 0 -06}
+    {1915070400 -18000 1 -06}
+    {1933210800 -21600 0 -06}
+    {1946520000 -18000 1 -06}
+    {1964660400 -21600 0 -06}
+    {1977969600 -18000 1 -06}
+    {1996110000 -21600 0 -06}
+    {2009419200 -18000 1 -06}
+    {2027559600 -21600 0 -06}
+    {2040868800 -18000 1 -06}
+    {2059614000 -21600 0 -06}
+    {2072318400 -18000 1 -06}
+    {2091063600 -21600 0 -06}
+    {2104372800 -18000 1 -06}
+    {2122513200 -21600 0 -06}
+    {2135822400 -18000 1 -06}
+    {2153962800 -21600 0 -06}
+    {2167272000 -18000 1 -06}
+    {2185412400 -21600 0 -06}
+    {2198721600 -18000 1 -06}
+    {2217466800 -21600 0 -06}
+    {2230171200 -18000 1 -06}
+    {2248916400 -21600 0 -06}
+    {2262225600 -18000 1 -06}
+    {2280366000 -21600 0 -06}
+    {2293675200 -18000 1 -06}
+    {2311815600 -21600 0 -06}
+    {2325124800 -18000 1 -06}
+    {2343265200 -21600 0 -06}
+    {2356574400 -18000 1 -06}
+    {2374714800 -21600 0 -06}
+    {2388024000 -18000 1 -06}
+    {2406769200 -21600 0 -06}
+    {2419473600 -18000 1 -06}
+    {2438218800 -21600 0 -06}
+    {2451528000 -18000 1 -06}
+    {2469668400 -21600 0 -06}
+    {2482977600 -18000 1 -06}
+    {2501118000 -21600 0 -06}
+    {2514427200 -18000 1 -06}
+    {2532567600 -21600 0 -06}
+    {2545876800 -18000 1 -06}
+    {2564017200 -21600 0 -06}
+    {2577326400 -18000 1 -06}
+    {2596071600 -21600 0 -06}
+    {2609380800 -18000 1 -06}
+    {2627521200 -21600 0 -06}
+    {2640830400 -18000 1 -06}
+    {2658970800 -21600 0 -06}
+    {2672280000 -18000 1 -06}
+    {2690420400 -21600 0 -06}
+    {2703729600 -18000 1 -06}
+    {2721870000 -21600 0 -06}
+    {2735179200 -18000 1 -06}
+    {2753924400 -21600 0 -06}
+    {2766628800 -18000 1 -06}
+    {2785374000 -21600 0 -06}
+    {2798683200 -18000 1 -06}
+    {2816823600 -21600 0 -06}
+    {2830132800 -18000 1 -06}
+    {2848273200 -21600 0 -06}
+    {2861582400 -18000 1 -06}
+    {2879722800 -21600 0 -06}
+    {2893032000 -18000 1 -06}
+    {2911172400 -21600 0 -06}
+    {2924481600 -18000 1 -06}
+    {2943226800 -21600 0 -06}
+    {2955931200 -18000 1 -06}
+    {2974676400 -21600 0 -06}
+    {2987985600 -18000 1 -06}
+    {3006126000 -21600 0 -06}
+    {3019435200 -18000 1 -06}
+    {3037575600 -21600 0 -06}
+    {3050884800 -18000 1 -06}
+    {3069025200 -21600 0 -06}
+    {3082334400 -18000 1 -06}
+    {3101079600 -21600 0 -06}
+    {3113784000 -18000 1 -06}
+    {3132529200 -21600 0 -06}
+    {3145838400 -18000 1 -06}
+    {3163978800 -21600 0 -06}
+    {3177288000 -18000 1 -06}
+    {3195428400 -21600 0 -06}
+    {3208737600 -18000 1 -06}
+    {3226878000 -21600 0 -06}
+    {3240187200 -18000 1 -06}
+    {3258327600 -21600 0 -06}
+    {3271636800 -18000 1 -06}
+    {3290382000 -21600 0 -06}
+    {3303086400 -18000 1 -06}
+    {3321831600 -21600 0 -06}
+    {3335140800 -18000 1 -06}
+    {3353281200 -21600 0 -06}
+    {3366590400 -18000 1 -06}
+    {3384730800 -21600 0 -06}
+    {3398040000 -18000 1 -06}
+    {3416180400 -21600 0 -06}
+    {3429489600 -18000 1 -06}
+    {3447630000 -21600 0 -06}
+    {3460939200 -18000 1 -06}
+    {3479684400 -21600 0 -06}
+    {3492993600 -18000 1 -06}
+    {3511134000 -21600 0 -06}
+    {3524443200 -18000 1 -06}
+    {3542583600 -21600 0 -06}
+    {3555892800 -18000 1 -06}
+    {3574033200 -21600 0 -06}
+    {3587342400 -18000 1 -06}
+    {3605482800 -21600 0 -06}
+    {3618792000 -18000 1 -06}
+    {3637537200 -21600 0 -06}
+    {3650241600 -18000 1 -06}
+    {3668986800 -21600 0 -06}
+    {3682296000 -18000 1 -06}
+    {3700436400 -21600 0 -06}
+    {3713745600 -18000 1 -06}
+    {3731886000 -21600 0 -06}
+    {3745195200 -18000 1 -06}
+    {3763335600 -21600 0 -06}
+    {3776644800 -18000 1 -06}
+    {3794785200 -21600 0 -06}
+    {3808094400 -18000 1 -06}
+    {3826839600 -21600 0 -06}
+    {3839544000 -18000 1 -06}
+    {3858289200 -21600 0 -06}
+    {3871598400 -18000 1 -06}
+    {3889738800 -21600 0 -06}
+    {3903048000 -18000 1 -06}
+    {3921188400 -21600 0 -06}
+    {3934497600 -18000 1 -06}
+    {3952638000 -21600 0 -06}
+    {3965947200 -18000 1 -06}
+    {3984692400 -21600 0 -06}
+    {3997396800 -18000 1 -06}
+    {4016142000 -21600 0 -06}
+    {4029451200 -18000 1 -06}
+    {4047591600 -21600 0 -06}
+    {4060900800 -18000 1 -06}
+    {4079041200 -21600 0 -06}
+    {4092350400 -18000 1 -06}
 }

library/tzdata/Pacific/Fiji

@@ -26,7 +26,7 @@ set TZData(:Pacific/Fiji) {
     {1509804000 46800 1 +12}
     {1515852000 43200 0 +12}
     {1541253600 46800 1 +12}
-    {1547906400 43200 0 +12}
+    {1547301600 43200 0 +12}
     {1572703200 46800 1 +12}
     {1579356000 43200 0 +12}
     {1604152800 46800 1 +12}
@@ -48,7 +48,7 @@ set TZData(:Pacific/Fiji) {
     {1856959200 46800 1 +12}
     {1863007200 43200 0 +12}
     {1888408800 46800 1 +12}
-    {1895061600 43200 0 +12}
+    {1894456800 43200 0 +12}
     {1919858400 46800 1 +12}
     {1926511200 43200 0 +12}
     {1951308000 46800 1 +12}
@@ -60,7 +60,7 @@ set TZData(:Pacific/Fiji) {
     {2046261600 46800 1 +12}
     {2052309600 43200 0 +12}
     {2077711200 46800 1 +12}
-    {2084364000 43200 0 +12}
+    {2083759200 43200 0 +12}
     {2109160800 46800 1 +12}
     {2115813600 43200 0 +12}
     {2140610400 46800 1 +12}
@@ -70,7 +70,7 @@ set TZData(:Pacific/Fiji) {
     {2204114400 46800 1 +12}
     {2210162400 43200 0 +12}
     {2235564000 46800 1 +12}
-    {2242216800 43200 0 +12}
+    {2241612000 43200 0 +12}
     {2267013600 46800 1 +12}
     {2273666400 43200 0 +12}
     {2298463200 46800 1 +12}
@@ -82,7 +82,7 @@ set TZData(:Pacific/Fiji) {
     {2393416800 46800 1 +12}
     {2399464800 43200 0 +12}
     {2424866400 46800 1 +12}
-    {2431519200 43200 0 +12}
+    {2430914400 43200 0 +12}
     {2456316000 46800 1 +12}
     {2462968800 43200 0 +12}
     {2487765600 46800 1 +12}
@@ -104,7 +104,7 @@ set TZData(:Pacific/Fiji) {
     {2740572000 46800 1 +12}
     {2746620000 43200 0 +12}
     {2772021600 46800 1 +12}
-    {2778674400 43200 0 +12}
+    {2778069600 43200 0 +12}
     {2803471200 46800 1 +12}
     {2810124000 43200 0 +12}
     {2834920800 46800 1 +12}
@@ -116,7 +116,7 @@ set TZData(:Pacific/Fiji) {
     {2929874400 46800 1 +12}
     {2935922400 43200 0 +12}
     {2961324000 46800 1 +12}
-    {2967976800 43200 0 +12}
+    {2967372000 43200 0 +12}
     {2992773600 46800 1 +12}
     {2999426400 43200 0 +12}
     {3024223200 46800 1 +12}
@@ -126,7 +126,7 @@ set TZData(:Pacific/Fiji) {
     {3087727200 46800 1 +12}
     {3093775200 43200 0 +12}
     {3119176800 46800 1 +12}
-    {3125829600 43200 0 +12}
+    {3125224800 43200 0 +12}
     {3150626400 46800 1 +12}
     {3157279200 43200 0 +12}
     {3182076000 46800 1 +12}
@@ -138,7 +138,7 @@ set TZData(:Pacific/Fiji) {
     {3277029600 46800 1 +12}
     {3283077600 43200 0 +12}
     {3308479200 46800 1 +12}
-    {3315132000 43200 0 +12}
+    {3314527200 43200 0 +12}
     {3339928800 46800 1 +12}
     {3346581600 43200 0 +12}
     {3371378400 46800 1 +12}
@@ -160,7 +160,7 @@ set TZData(:Pacific/Fiji) {
     {3624184800 46800 1 +12}
     {3630232800 43200 0 +12}
     {3655634400 46800 1 +12}
-    {3662287200 43200 0 +12}
+    {3661682400 43200 0 +12}
     {3687084000 46800 1 +12}
     {3693736800 43200 0 +12}
     {3718533600 46800 1 +12}
@@ -172,7 +172,7 @@ set TZData(:Pacific/Fiji) {
     {3813487200 46800 1 +12}
     {3819535200 43200 0 +12}
     {3844936800 46800 1 +12}
-    {3851589600 43200 0 +12}
+    {3850984800 43200 0 +12}
     {3876386400 46800 1 +12}
     {3883039200 43200 0 +12}
     {3907836000 46800 1 +12}
@@ -182,7 +182,7 @@ set TZData(:Pacific/Fiji) {
     {3971340000 46800 1 +12}
     {3977388000 43200 0 +12}
     {4002789600 46800 1 +12}
-    {4009442400 43200 0 +12}
+    {4008837600 43200 0 +12}
     {4034239200 46800 1 +12}
     {4040892000 43200 0 +12}
     {4065688800 46800 1 +12}

library/tzdata/Pacific/Honolulu

@@ -4,8 +4,9 @@ set TZData(:Pacific/Honolulu) {
     {-9223372036854775808 -37886 0 LMT}
     {-2334101314 -37800 0 HST}
     {-1157283000 -34200 1 HDT}
-    {-1155436200 -37800 0 HST}
-    {-880198200 -34200 1 HDT}
+    {-1155436200 -34200 0 HST}
+    {-880201800 -34200 1 HWT}
+    {-769395600 -34200 1 HPT}
     {-765376200 -37800 0 HST}
     {-712150200 -36000 0 HST}
 }

libtommath/README.md

@@ -4,9 +4,11 @@ This is the git repository for [LibTomMath](http://www.libtom.net/LibTomMath/),
 
 ## Build Status
 
-master  - [![Build Status - master](https://travis-ci.org/libtom/libtommath.png?branch=master)](https://travis-ci.org/libtom/libtommath)
+master: [![Build Status](https://api.travis-ci.org/libtom/libtommath.png?branch=master)](https://travis-ci.org/libtom/libtommath)
 
-develop - [![Build Status - develop](https://travis-ci.org/libtom/libtommath.png?branch=develop)](https://travis-ci.org/libtom/libtommath)
+develop: [![Build Status](https://api.travis-ci.org/libtom/libtommath.png?branch=develop)](https://travis-ci.org/libtom/libtommath)
+
+API/ABI changes: [check here](https://abi-laboratory.pro/tracker/timeline/libtommath/)
 
 ## Summary
 

libtommath/bn_error.c

@@ -1,4 +1,4 @@
-#include <tommath_private.h>
+#include "tommath_private.h"
 #ifdef BN_ERROR_C
 /* LibTomMath, multiple-precision integer library -- Tom St Denis
  *
@@ -11,8 +11,6 @@
  *
  * The library is free for all purposes without any express
  * guarantee it works.
- *
- * Tom St Denis, tstdenis82@gmail.com, http://libtom.org
  */
 
 static const struct {

libtommath/bn_fast_mp_invmod.c

@@ -1,4 +1,4 @@
-#include <tommath_private.h>
+#include "tommath_private.h"
 #ifdef BN_FAST_MP_INVMOD_C
 /* LibTomMath, multiple-precision integer library -- Tom St Denis
  *
@@ -11,8 +11,6 @@
  *
  * The library is free for all purposes without any express
  * guarantee it works.
- *
- * Tom St Denis, tstdenis82@gmail.com, http://libtom.org
  */
 
 /* computes the modular inverse via binary extended euclidean algorithm,
@@ -140,6 +138,14 @@ top:
          goto LBL_ERR;
       }
    }
+
+   /* too big */
+   while (mp_cmp_mag(&D, b) != MP_LT) {
+      if ((res = mp_sub(&D, b, &D)) != MP_OKAY) {
+         goto LBL_ERR;
+      }
+   }
+
    mp_exch(&D, c);
    c->sign = neg;
    res = MP_OKAY;

libtommath/bn_fast_mp_montgomery_reduce.c

@@ -1,4 +1,4 @@
-#include <tommath_private.h>
+#include "tommath_private.h"
 #ifdef BN_FAST_MP_MONTGOMERY_REDUCE_C
 /* LibTomMath, multiple-precision integer library -- Tom St Denis
  *
@@ -11,8 +11,6 @@
  *
  * The library is free for all purposes without any express
  * guarantee it works.
- *
- * Tom St Denis, tstdenis82@gmail.com, http://libtom.org
  */
 
 /* computes xR**-1 == x (mod N) via Montgomery Reduction

libtommath/bn_fast_s_mp_mul_digs.c

@@ -1,4 +1,4 @@
-#include <tommath_private.h>
+#include "tommath_private.h"
 #ifdef BN_FAST_S_MP_MUL_DIGS_C
 /* LibTomMath, multiple-precision integer library -- Tom St Denis
  *
@@ -11,8 +11,6 @@
  *
  * The library is free for all purposes without any express
  * guarantee it works.
- *
- * Tom St Denis, tstdenis82@gmail.com, http://libtom.org
  */
 
 /* Fast (comba) multiplier

libtommath/bn_fast_s_mp_mul_high_digs.c

@@ -1,4 +1,4 @@
-#include <tommath_private.h>
+#include "tommath_private.h"
 #ifdef BN_FAST_S_MP_MUL_HIGH_DIGS_C
 /* LibTomMath, multiple-precision integer library -- Tom St Denis
  *
@@ -11,8 +11,6 @@
  *
  * The library is free for all purposes without any express
  * guarantee it works.
- *
- * Tom St Denis, tstdenis82@gmail.com, http://libtom.org
  */
 
 /* this is a modified version of fast_s_mul_digs that only produces

libtommath/bn_fast_s_mp_sqr.c

@@ -1,4 +1,4 @@
-#include <tommath_private.h>
+#include "tommath_private.h"
 #ifdef BN_FAST_S_MP_SQR_C
 /* LibTomMath, multiple-precision integer library -- Tom St Denis
  *
@@ -11,8 +11,6 @@
  *
  * The library is free for all purposes without any express
  * guarantee it works.
- *
- * Tom St Denis, tstdenis82@gmail.com, http://libtom.org
  */
 
 /* the jist of squaring...

libtommath/bn_mp_2expt.c

@@ -1,4 +1,4 @@
-#include <tommath_private.h>
+#include "tommath_private.h"
 #ifdef BN_MP_2EXPT_C
 /* LibTomMath, multiple-precision integer library -- Tom St Denis
  *
@@ -11,8 +11,6 @@
  *
  * The library is free for all purposes without any express
  * guarantee it works.
- *
- * Tom St Denis, tstdenis82@gmail.com, http://libtom.org
  */
 
 /* computes a = 2**b

libtommath/bn_mp_abs.c

@@ -1,4 +1,4 @@
-#include <tommath_private.h>
+#include "tommath_private.h"
 #ifdef BN_MP_ABS_C
 /* LibTomMath, multiple-precision integer library -- Tom St Denis
  *
@@ -11,8 +11,6 @@
  *
  * The library is free for all purposes without any express
  * guarantee it works.
- *
- * Tom St Denis, tstdenis82@gmail.com, http://libtom.org
  */
 
 /* b = |a|

libtommath/bn_mp_add.c

@@ -1,4 +1,4 @@
-#include <tommath_private.h>
+#include "tommath_private.h"
 #ifdef BN_MP_ADD_C
 /* LibTomMath, multiple-precision integer library -- Tom St Denis
  *
@@ -11,8 +11,6 @@
  *
  * The library is free for all purposes without any express
  * guarantee it works.
- *
- * Tom St Denis, tstdenis82@gmail.com, http://libtom.org
  */
 
 /* high level addition (handles signs) */

libtommath/bn_mp_add_d.c

@@ -1,4 +1,4 @@
-#include <tommath_private.h>
+#include "tommath_private.h"
 #ifdef BN_MP_ADD_D_C
 /* LibTomMath, multiple-precision integer library -- Tom St Denis
  *
@@ -11,8 +11,6 @@
  *
  * The library is free for all purposes without any express
  * guarantee it works.
- *
- * Tom St Denis, tstdenis82@gmail.com, http://libtom.org
  */
 
 /* single digit addition */

libtommath/bn_mp_addmod.c

@@ -1,4 +1,4 @@
-#include <tommath_private.h>
+#include "tommath_private.h"
 #ifdef BN_MP_ADDMOD_C
 /* LibTomMath, multiple-precision integer library -- Tom St Denis
  *
@@ -11,8 +11,6 @@
  *
  * The library is free for all purposes without any express
  * guarantee it works.
- *
- * Tom St Denis, tstdenis82@gmail.com, http://libtom.org
  */
 
 /* d = a + b (mod c) */

libtommath/bn_mp_and.c

@@ -1,4 +1,4 @@
-#include <tommath_private.h>
+#include "tommath_private.h"
 #ifdef BN_MP_AND_C
 /* LibTomMath, multiple-precision integer library -- Tom St Denis
  *
@@ -11,8 +11,6 @@
  *
  * The library is free for all purposes without any express
  * guarantee it works.
- *
- * Tom St Denis, tstdenis82@gmail.com, http://libtom.org
  */
 
 /* AND two ints together */

libtommath/bn_mp_clamp.c

@@ -1,4 +1,4 @@
-#include <tommath_private.h>
+#include "tommath_private.h"
 #ifdef BN_MP_CLAMP_C
 /* LibTomMath, multiple-precision integer library -- Tom St Denis
  *
@@ -11,8 +11,6 @@
  *
  * The library is free for all purposes without any express
  * guarantee it works.
- *
- * Tom St Denis, tstdenis82@gmail.com, http://libtom.org
  */
 
 /* trim unused digits

libtommath/bn_mp_clear.c

@@ -1,4 +1,4 @@
-#include <tommath_private.h>
+#include "tommath_private.h"
 #ifdef BN_MP_CLEAR_C
 /* LibTomMath, multiple-precision integer library -- Tom St Denis
  *
@@ -11,8 +11,6 @@
  *
  * The library is free for all purposes without any express
  * guarantee it works.
- *
- * Tom St Denis, tstdenis82@gmail.com, http://libtom.org
  */
 
 /* clear one (frees)  */