Updating hypnotoad branch

Reduced the code necessary to bootstrap a shell to a single C call.

Reduced the number of new stub entries to 1

Fixed a Makefile goof that was preventing kits from running properly.

changes

@@ -8452,3 +8452,5 @@ include ::oo::class (fellows)
 2014-08-25 (TIP 429) New command [string cat] (leitgeb,ferrieux)
 
 --- Released 8.6.2, August 27, 2014 --- http://core.tcl.tk/tcl/ for details 
+
+2014-08-29 (TIP TBD) Added a C Implementation of ZipVFS to provide Tcl/Wishkit building capbilities in the core (hypnotoad)

doc/TraceCmd.3

@@ -86,14 +86,11 @@ operation is being performed on the command.  The bit
 \fBTCL_TRACE_DESTROYED\fR will be set in \fIflags\fR if the trace is about
 to be destroyed; this information may be useful to \fIproc\fR so that
 it can clean up its own internal data structures (see the section
-\fBTCL_TRACE_DESTROYED\fR below for more details).  Because the
-deletion of commands can take place as part of the deletion of the interp
-that contains them, \fIproc\fR must be careful about checking what
-the passed in \fIinterp\fR value can be called upon to do.
-The routine \fBTcl_InterpDeleted\fR is an important tool for this.
-When \fBTcl_InterpDeleted\fR returns 1, \fIproc\fR will not be able
-to invoke any scripts in \fIinterp\fR.  The function of \fIproc\fR
-in that circumstance is limited to the cleanup of its own data structures.
+\fBTCL_TRACE_DESTROYED\fR below for more details).  Lastly, the bit
+\fBTCL_INTERP_DESTROYED\fR will be set if the entire interpreter is being
+destroyed.  When this bit is set, \fIproc\fR must be especially
+careful in the things it does (see the section \fBTCL_INTERP_DESTROYED\fR
+below).
 .PP
 \fBTcl_UntraceCommand\fR may be used to remove a trace.  If the
 command specified by \fIinterp\fR, \fIcmdName\fR, and \fIflags\fR has
@@ -126,8 +123,7 @@ traces for a given command that have the same \fIproc\fR.
 .PP
 During rename traces, the command being renamed is visible with both
 names simultaneously, and the command still exists during delete
-traces, unless the interp that contains it is being deleted.
-However, there is no
+traces (if \fBTCL_INTERP_DESTROYED\fR is not set).  However, there is no
 mechanism for signaling that an error occurred in a trace procedure,
 so great care should be taken that errors do not get silently lost.
 .SH "MULTIPLE TRACES"
@@ -146,5 +142,22 @@ rename the command, the last renaming takes precedence.
 In a delete callback to \fIproc\fR, the \fBTCL_TRACE_DESTROYED\fR bit
 is set in \fIflags\fR.
 .\" Perhaps need some more comments here? - DKF
+.SH "TCL_INTERP_DESTROYED"
+.PP
+When an interpreter is destroyed, unset traces are called for
+all of its commands.
+The \fBTCL_INTERP_DESTROYED\fR bit will be set in the \fIflags\fR
+argument passed to the trace procedures.
+Trace procedures must be extremely careful in what they do if
+the \fBTCL_INTERP_DESTROYED\fR bit is set.
+It is not safe for the procedures to invoke any Tcl procedures
+on the interpreter, since its state is partially deleted.
+All that trace procedures should do under these circumstances is
+to clean up and free their own internal data structures.
+.SH BUGS
+.PP
+Tcl does not do any error checking to prevent trace procedures
+from misusing the interpreter during traces with \fBTCL_INTERP_DESTROYED\fR
+set.
 .SH KEYWORDS
 clientData, trace, command

doc/tclsh.1

@@ -143,6 +143,15 @@ incomplete commands.
 .SH "STANDARD CHANNELS"
 .PP
 See \fBTcl_StandardChannels\fR for more explanations.
+.SH ZIPVFS
+.PP
+When a zipfile is concatenated to the end of a \fBtclsh\fR, on
+startup the contents of the zip archive will be mounted as the
+virtual file system /zvfs. If a top level directory tcl8.6 is
+present in the zip archive, it will become the directory loaded
+as env(TCL_LIBRARY). If a file named \fBmain.tcl\fR is present
+in the top level directory of the zip archive, it will be sourced
+instead of the shell's normal command line handing.
 .SH "SEE ALSO"
 auto_path(n), encoding(n), env(n), fconfigure(n)
 .SH KEYWORDS

doc/zvfs.n

@@ -0,0 +1,114 @@
+'\"
+'\" Copyright (c) 2014 Sean Woods
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.TH zvfs n 0.1 Zvfs "Zvfs Commands"
+.so man.macros
+.BS
+'\" Note:  do not modify the .SH NAME line immediately below!
+.SH NAME
+zvfs \- Mount and work with ZIP files within Tcl
+.SH SYNOPSIS
+.nf
+\fBpackage require zvfs \fR?\fB0.1\fR?
+.sp
+\fB::zvfs::add\fR ?\fB\-fconfigure \fIoptpairs...\fR? \fIarchive file1\fR ?\fIfile2 ...\fR?
+\fB::zvfs::append\fR \fIarchive\fR ?\fIsource destination\fR? ?\fIsource destination...\fR?
+\fB::zvfs::dump\fR \fIzipfile\fR
+\fB::zvfs::exists\fR \fIfilename\fR
+\fB::zvfs::info\fR \fIfile\fR
+\fB::zvfs::list\fR ?\fB\-glob\fR|\fB\-regexp\fR? ?\fIpattern\fR?
+\fB::zvfs::mount ?\fIarchive\fR? ?\fImountpoint\fR?
+\fB::zvfs::start\fR \fIzipfile\fR
+\fB::zvfs::unmount \fIarchive\fR
+.fi
+.BE
+.SH DESCRIPTION
+.PP
+The \fBzvfs\fR package provides tcl with the ability to manipulate
+the contents of a zip file archive as a virtual file system.
+.TP
+\fB::zvfs::mount ?\fIarchive\fR? ?\fImountpoint\fR?
+.
+The \fB::zvfs::mount\fR procedure mounts a zipfile as a VFS.
+After this command
+executes, files contained in the ZIP archive, \fIarchive\fR, will appear to Tcl to be
+regular files at the mount point.
+.RS
+.PP
+With no \fImountpoint\fR, returns the mount point for \fIarchive\fR. With no \fIarchive\fR,
+return all archive/mount pairs. If \fImountpoint\fR is specified as an empty
+string, mount on file path.
+.RE
+.TP
+\fB::zvfs::unmount \fIarchive\fR
+.
+Unmounts a previously mounted zip, \fIarchive\fR.
+.TP
+\fB::zvfs::append\fR \fIarchive\fR ?\fIsource destination\fR? ?\fIsource destination...\fR?
+.
+This command reads \fIsource\fR files and appends them (using the name
+\fIdestination\fR) to the zip archive named \fIarchive\fR. A new zip archive is created
+if it does not already exist. If \fIarchive\fR refers to a file which exists but
+is not a zip archive, then this command turns \fIarchive\fR into a zip archive by
+appending the necessary records and the table of contents. Treat all files
+as binary.
+.RS
+.PP
+Note: No duplicate checking is done, so multiple occurances of the same file is
+allowed.
+.RE
+.TP
+\fB::zvfs::add\fR ?\fB\-fconfigure \fIoptpairs...\fR? \fIarchive file1\fR ?\fIfile2 ...\fR?
+.
+This command is similar to \fBzvfs::append\fR in that it adds files to the zip archive
+named \fIarchive\fR, however file names are relative the current directory.  In
+addition, \fBfconfigure\fR is used to apply option pairs to set upon opening of
+each file.  Otherwise, default translation is allowed for those file
+extensions listed in the \fB::zvfs::auto_ext\fR variable.  Binary translation will be
+used for unknown extensions.
+.RS
+.PP
+NOTE: Use 
+.QW "\fB\-fconfigure {}\fR"
+to use auto translation for all.
+.RE
+.TP
+\fB::zvfs::exists\fR \fIfilename\fR
+.
+Return TRUE if the given filename exists in the mounted ZVFS and FALSE if it does
+not.
+.TP
+\fB::zvfs::info\fR \fIfile\fR
+.
+Return information about the given file in the mounted ZVFS.  The information
+consists of (1) the name of the ZIP archive that contains the file, (2) the
+size of the file after decompressions, (3) the compressed size of the file,
+and (4) the offset of the compressed data in the archive.
+.RS
+.PP
+Note: querying the mount point gives the start of zip data offset in (4),
+which can be used to truncate the zip info off an executable.
+.RE
+.TP
+\fB::zvfs::list\fR ?\fB\-glob\fR|\fB\-regexp\fR? ?\fIpattern\fR?
+.
+Return a list of all files in the mounted ZVFS.  The order of the names in the list
+is arbitrary.
+.TP
+\fB::zvfs::dump\fR \fIzipfile\fR
+.
+Describe the contents of a zip.
+.TP
+\fB::zvfs::start\fR \fIzipfile\fR
+.
+This command strips returns the offset of zip data.
+.SH "SEE ALSO"
+tclsh(1), file(n), zlib(n)
+.SH "KEYWORDS"
+compress, filesystem, zip
+'\" Local Variables:
+'\" mode: nroff
+'\" End:

generic/tcl.decls

@@ -2326,6 +2326,11 @@ declare 630 {
 
 # ----- BASELINE -- FOR -- 8.6.0 ----- #
 
+# ZipVfs
+declare 631 {
+  int Tcl_Zvfs_Boot(Tcl_Interp *interp)
+}
+
 ##############################################################################
 
 # Define the platform specific public Tcl interface. These functions are only

generic/tclAlloc.c

@@ -31,7 +31,7 @@
  * until Tcl uses config.h properly.
  */
 
-#if defined(_MSC_VER) || defined(__MSVCRT__) || defined(__BORLANDC__)
+#if defined(_MSC_VER) || defined(__MINGW32__) || defined(__BORLANDC__)
 typedef unsigned long caddr_t;
 #endif
 

generic/tclBasic.c

@@ -840,9 +840,7 @@ Tcl_CreateInterp(void)
      */
 
     Tcl_CreateObjCommand(interp, "::tcl::unsupported::disassemble",
-	    Tcl_DisassembleObjCmd, INT2PTR(0), NULL);
-    Tcl_CreateObjCommand(interp, "::tcl::unsupported::getbytecode",
-	    Tcl_DisassembleObjCmd, INT2PTR(1), NULL);
+	    Tcl_DisassembleObjCmd, NULL, NULL);
     Tcl_CreateObjCommand(interp, "::tcl::unsupported::representation",
 	    Tcl_RepresentationCmd, NULL, NULL);
 

generic/tclCompCmds.c

@@ -26,23 +26,14 @@ static void		FreeDictUpdateInfo(ClientData clientData);
 static void		PrintDictUpdateInfo(ClientData clientData,
 			    Tcl_Obj *appendObj, ByteCode *codePtr,
 			    unsigned int pcOffset);
-static void		DisassembleDictUpdateInfo(ClientData clientData,
-			    Tcl_Obj *dictObj, ByteCode *codePtr,
-			    unsigned int pcOffset);
 static ClientData	DupForeachInfo(ClientData clientData);
 static void		FreeForeachInfo(ClientData clientData);
 static void		PrintForeachInfo(ClientData clientData,
 			    Tcl_Obj *appendObj, ByteCode *codePtr,
 			    unsigned int pcOffset);
-static void		DisassembleForeachInfo(ClientData clientData,
-			    Tcl_Obj *dictObj, ByteCode *codePtr,
-			    unsigned int pcOffset);
 static void		PrintNewForeachInfo(ClientData clientData,
 			    Tcl_Obj *appendObj, ByteCode *codePtr,
 			    unsigned int pcOffset);
-static void		DisassembleNewForeachInfo(ClientData clientData,
-			    Tcl_Obj *dictObj, ByteCode *codePtr,
-			    unsigned int pcOffset);
 static int		CompileEachloopCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    CompileEnv *envPtr, int collect);
@@ -58,24 +49,21 @@ const AuxDataType tclForeachInfoType = {
     "ForeachInfo",		/* name */
     DupForeachInfo,		/* dupProc */
     FreeForeachInfo,		/* freeProc */
-    PrintForeachInfo,		/* printProc */
-    DisassembleForeachInfo	/* disassembleProc */
+    PrintForeachInfo		/* printProc */
 };
 
 const AuxDataType tclNewForeachInfoType = {
     "NewForeachInfo",		/* name */
     DupForeachInfo,		/* dupProc */
     FreeForeachInfo,		/* freeProc */
-    PrintNewForeachInfo,	/* printProc */
-    DisassembleNewForeachInfo	/* disassembleProc */
+    PrintNewForeachInfo		/* printProc */
 };
 
 const AuxDataType tclDictUpdateInfoType = {
     "DictUpdateInfo",		/* name */
     DupDictUpdateInfo,		/* dupProc */
     FreeDictUpdateInfo,		/* freeProc */
-    PrintDictUpdateInfo,	/* printProc */
-    DisassembleDictUpdateInfo	/* disassembleProc */
+    PrintDictUpdateInfo		/* printProc */
 };
 
 /*
@@ -301,8 +289,7 @@ TclCompileArraySetCmd(
      * a proc, we cannot do a better compile than generic.
      */
 
-    if ((varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) ||
-	    (envPtr->procPtr == NULL && !(isDataEven && len == 0))) {
+    if (envPtr->procPtr == NULL && !(isDataEven && len == 0)) {
 	code = TclCompileBasic2ArgCmd(interp, parsePtr, cmdPtr, envPtr);
 	goto done;
     }
@@ -343,9 +330,8 @@ TclCompileArraySetCmd(
 	 * a non-local variable: upvar from a local one! This consumes the
 	 * variable name that was left at stacktop.
 	 */
-
-	localIndex = TclFindCompiledLocal(varTokenPtr->start,
-		varTokenPtr->size, 1, envPtr);
+	
+	localIndex = AnonymousLocal(envPtr);
 	PushStringLiteral(envPtr, "0");
 	TclEmitInstInt4(INST_REVERSE, 2,        		envPtr);
 	TclEmitInstInt4(INST_UPVAR, localIndex, 		envPtr);
@@ -2098,13 +2084,11 @@ TclCompileDictWithCmd(
  *	DupDictUpdateInfo: a copy of the auxiliary data
  *	FreeDictUpdateInfo: none
  *	PrintDictUpdateInfo: none
- *	DisassembleDictUpdateInfo: none
  *
  * Side effects:
  *	DupDictUpdateInfo: allocates memory
  *	FreeDictUpdateInfo: releases memory
  *	PrintDictUpdateInfo: none
- *	DisassembleDictUpdateInfo: none
  *
  *----------------------------------------------------------------------
  */
@@ -2147,25 +2131,6 @@ PrintDictUpdateInfo(
 	Tcl_AppendPrintfToObj(appendObj, "%%v%u", duiPtr->varIndices[i]);
     }
 }
-
-static void
-DisassembleDictUpdateInfo(
-    ClientData clientData,
-    Tcl_Obj *dictObj,
-    ByteCode *codePtr,
-    unsigned int pcOffset)
-{
-    DictUpdateInfo *duiPtr = clientData;
-    int i;
-    Tcl_Obj *variables = Tcl_NewObj();
-
-    for (i=0 ; i<duiPtr->length ; i++) {
-	Tcl_ListObjAppendElement(NULL, variables,
-		Tcl_NewIntObj(duiPtr->varIndices[i]));
-    }
-    Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("variables", -1),
-	    variables);
-}
 
 /*
  *----------------------------------------------------------------------
@@ -2403,6 +2368,7 @@ TclCompileForCmd(
 
     SetLineInformation(2);
     TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
+    TclClearNumConversion(envPtr);
 
     jumpDist = CurrentOffset(envPtr) - bodyCodeOffset;
     if (jumpDist > 127) {
@@ -2843,10 +2809,10 @@ FreeForeachInfo(
 /*
  *----------------------------------------------------------------------
  *
- * PrintForeachInfo, DisassembleForeachInfo --
+ * PrintForeachInfo --
  *
- *	Functions to write a human-readable or script-readablerepresentation
- *	of a ForeachInfo structure to a Tcl_Obj for debugging.
+ *	Function to write a human-readable representation of a ForeachInfo
+ *	structure to stdout for debugging.
  *
  * Results:
  *	None.
@@ -2926,89 +2892,6 @@ PrintNewForeachInfo(
 	Tcl_AppendToObj(appendObj, "]", -1);
     }
 }
-
-static void
-DisassembleForeachInfo(
-    ClientData clientData,
-    Tcl_Obj *dictObj,
-    ByteCode *codePtr,
-    unsigned int pcOffset)
-{
-    register ForeachInfo *infoPtr = clientData;
-    register ForeachVarList *varsPtr;
-    int i, j;
-    Tcl_Obj *objPtr, *innerPtr;
-
-    /*
-     * Data stores.
-     */
-
-    objPtr = Tcl_NewObj();
-    for (i=0 ; i<infoPtr->numLists ; i++) {
-	Tcl_ListObjAppendElement(NULL, objPtr,
-		Tcl_NewIntObj(infoPtr->firstValueTemp + i));
-    }
-    Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("data", -1), objPtr);
-
-    /*
-     * Loop counter.
-     */
-
-    Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("loop", -1),
-	   Tcl_NewIntObj(infoPtr->loopCtTemp));
-
-    /*
-     * Assignment targets.
-     */
-
-    objPtr = Tcl_NewObj();
-    for (i=0 ; i<infoPtr->numLists ; i++) {
-	innerPtr = Tcl_NewObj();
-	varsPtr = infoPtr->varLists[i];
-	for (j=0 ; j<varsPtr->numVars ; j++) {
-	    Tcl_ListObjAppendElement(NULL, innerPtr,
-		    Tcl_NewIntObj(varsPtr->varIndexes[j]));
-	}
-	Tcl_ListObjAppendElement(NULL, objPtr, innerPtr);
-    }
-    Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("assign", -1), objPtr);
-}
-
-static void
-DisassembleNewForeachInfo(
-    ClientData clientData,
-    Tcl_Obj *dictObj,
-    ByteCode *codePtr,
-    unsigned int pcOffset)
-{
-    register ForeachInfo *infoPtr = clientData;
-    register ForeachVarList *varsPtr;
-    int i, j;
-    Tcl_Obj *objPtr, *innerPtr;
-
-    /*
-     * Jump offset.
-     */
-
-    Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("jumpOffset", -1),
-	   Tcl_NewIntObj(infoPtr->loopCtTemp));
-
-    /*
-     * Assignment targets.
-     */
-
-    objPtr = Tcl_NewObj();
-    for (i=0 ; i<infoPtr->numLists ; i++) {
-	innerPtr = Tcl_NewObj();
-	varsPtr = infoPtr->varLists[i];
-	for (j=0 ; j<varsPtr->numVars ; j++) {
-	    Tcl_ListObjAppendElement(NULL, innerPtr,
-		    Tcl_NewIntObj(varsPtr->varIndexes[j]));
-	}
-	Tcl_ListObjAppendElement(NULL, objPtr, innerPtr);
-    }
-    Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("assign", -1), objPtr);
-}
 
 /*
  *----------------------------------------------------------------------

generic/tclCompCmdsGR.c

@@ -281,6 +281,7 @@ TclCompileIfCmd(
 		SetLineInformation(wordIdx);
 		Tcl_ResetResult(interp);
 		TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
+		TclClearNumConversion(envPtr);
 		if (jumpFalseFixupArray.next >= jumpFalseFixupArray.end) {
 		    TclExpandJumpFixupArray(&jumpFalseFixupArray);
 		}
@@ -530,6 +531,7 @@ TclCompileIncrCmd(
 	} else {
 	    SetLineInformation(2);
 	    CompileTokens(envPtr, incrTokenPtr, interp);
+	    TclClearNumConversion(envPtr);
 	}
     } else {			/* No incr amount given so use 1. */
 	haveImmValue = 1;
@@ -1478,7 +1480,7 @@ TclCompileLreplaceCmd(
     Tcl_Token *tokenPtr, *listTokenPtr;
     DefineLineInformation;	/* TIP #280 */
     Tcl_Obj *tmpObj;
-    int idx1, idx2, i, offset, offset2;
+    int idx1, idx2, i, offset;
 
     if (parsePtr->numWords < 4) {
 	return TCL_ERROR;
@@ -1584,18 +1586,12 @@ TclCompileLreplaceCmd(
 	TclEmitOpcode(		INST_GT,			envPtr);
 	offset = CurrentOffset(envPtr);
 	TclEmitInstInt1(	INST_JUMP_TRUE1, 0,		envPtr);
-	TclEmitOpcode(		INST_DUP,			envPtr);
-	TclEmitOpcode(		INST_LIST_LENGTH,		envPtr);
-	offset2 = CurrentOffset(envPtr);
-	TclEmitInstInt1(	INST_JUMP_FALSE1, 0,		envPtr);
 	TclEmitPush(TclAddLiteralObj(envPtr, Tcl_ObjPrintf(
 		"list doesn't contain element %d", idx1), NULL), envPtr);
 	CompileReturnInternal(envPtr, INST_RETURN_IMM, TCL_ERROR, 0,
 		Tcl_ObjPrintf("-errorcode {TCL OPERATION LREPLACE BADIDX}"));
 	TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset,
 		envPtr->codeStart + offset + 1);
-	TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset2,
-		envPtr->codeStart + offset2 + 1);
 	TclAdjustStackDepth(-1, envPtr);
     }
     TclEmitOpcode(		INST_DUP,			envPtr);
@@ -1640,18 +1636,12 @@ TclCompileLreplaceCmd(
 	TclEmitOpcode(		INST_GT,			envPtr);
 	offset = CurrentOffset(envPtr);
 	TclEmitInstInt1(	INST_JUMP_TRUE1, 0,		envPtr);
-	TclEmitOpcode(		INST_DUP,			envPtr);
-	TclEmitOpcode(		INST_LIST_LENGTH,		envPtr);
-	offset2 = CurrentOffset(envPtr);
-	TclEmitInstInt1(	INST_JUMP_TRUE1, 0,		envPtr);
 	TclEmitPush(TclAddLiteralObj(envPtr, Tcl_ObjPrintf(
 		"list doesn't contain element %d", idx1), NULL), envPtr);
 	CompileReturnInternal(envPtr, INST_RETURN_IMM, TCL_ERROR, 0,
 		Tcl_ObjPrintf("-errorcode {TCL OPERATION LREPLACE BADIDX}"));
 	TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset,
 		envPtr->codeStart + offset + 1);
-	TclStoreInt1AtPtr(CurrentOffset(envPtr) - offset2,
-		envPtr->codeStart + offset2 + 1);
 	TclAdjustStackDepth(-1, envPtr);
     }
     TclEmitOpcode(		INST_DUP,			envPtr);
@@ -2268,7 +2258,7 @@ TclCompileRegexpCmd(
 	 * converted pattern as a literal.
 	 */
 
-	if (TclReToGlob(NULL, varTokenPtr[1].start, len, &ds, &exact, NULL)
+	if (TclReToGlob(NULL, varTokenPtr[1].start, len, &ds, &exact)
 		== TCL_OK) {
 	    simple = 1;
 	    PushLiteral(envPtr, Tcl_DStringValue(&ds),Tcl_DStringLength(&ds));
@@ -2360,7 +2350,7 @@ TclCompileRegsubCmd(
     Tcl_Obj *patternObj = NULL, *replacementObj = NULL;
     Tcl_DString pattern;
     const char *bytes;
-    int len, exact, quantified, result = TCL_ERROR;
+    int len, exact, result = TCL_ERROR;
 
     if (parsePtr->numWords < 5 || parsePtr->numWords > 6) {
 	return TCL_ERROR;
@@ -2420,8 +2410,7 @@ TclCompileRegsubCmd(
      */
 
     bytes = Tcl_GetStringFromObj(patternObj, &len);
-    if (TclReToGlob(NULL, bytes, len, &pattern, &exact, &quantified)
-	    != TCL_OK || exact || quantified) {
+    if (TclReToGlob(NULL, bytes, len, &pattern, &exact) != TCL_OK || exact) {
 	goto done;
     }
     bytes = Tcl_DStringValue(&pattern);

generic/tclCompCmdsSZ.c

@@ -28,9 +28,6 @@ static void		FreeJumptableInfo(ClientData clientData);
 static void		PrintJumptableInfo(ClientData clientData,
 			    Tcl_Obj *appendObj, ByteCode *codePtr,
 			    unsigned int pcOffset);
-static void		DisassembleJumptableInfo(ClientData clientData,
-			    Tcl_Obj *dictObj, ByteCode *codePtr,
-			    unsigned int pcOffset);
 static int		CompileAssociativeBinaryOpCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, const char *identity,
 			    int instruction, CompileEnv *envPtr);
@@ -75,8 +72,7 @@ const AuxDataType tclJumptableInfoType = {
     "JumptableInfo",		/* name */
     DupJumptableInfo,		/* dupProc */
     FreeJumptableInfo,		/* freeProc */
-    PrintJumptableInfo,		/* printProc */
-    DisassembleJumptableInfo	/* disassembleProc */
+    PrintJumptableInfo		/* printProc */
 };
 
 /*
@@ -322,8 +318,8 @@ TclCompileStringCatCmd(
 	    CompileWord(envPtr, wordTokenPtr, interp, i);
 	    numArgs ++;
 	    if (numArgs >= 254) { /* 254 to take care of the possible +1 of "folded" above */
-		TclEmitInstInt1(INST_STR_CONCAT1, numArgs, envPtr);
-		numArgs = 1;	/* concat pushes 1 obj, the result */
+		TclEmitInstInt1(INST_STR_CONCAT1, 254, envPtr);
+		numArgs -= 253;	/* concat pushes 1 obj, the result */
 	    }
 	}
 	wordTokenPtr = TokenAfter(wordTokenPtr);
@@ -2095,7 +2091,7 @@ IssueSwitchChainedTests(
 		     */
 
 		    if (TclReToGlob(NULL, bodyToken[i]->start,
-			    bodyToken[i]->size, &ds, &exact, NULL) == TCL_OK){
+			    bodyToken[i]->size, &ds, &exact) == TCL_OK) {
 			simple = 1;
 			PushLiteral(envPtr, Tcl_DStringValue(&ds),
 				Tcl_DStringLength(&ds));
@@ -2445,13 +2441,11 @@ IssueSwitchJumpTable(
  *	DupJumptableInfo: a copy of the jump-table
  *	FreeJumptableInfo: none
  *	PrintJumptableInfo: none
- *	DisassembleJumptableInfo: none
  *
  * Side effects:
  *	DupJumptableInfo: allocates memory
  *	FreeJumptableInfo: releases memory
  *	PrintJumptableInfo: none
- *	DisassembleJumptableInfo: none
  *
  *----------------------------------------------------------------------
  */
@@ -2514,30 +2508,6 @@ PrintJumptableInfo(
 		keyPtr, pcOffset + offset);
     }
 }
-
-static void
-DisassembleJumptableInfo(
-    ClientData clientData,
-    Tcl_Obj *dictObj,
-    ByteCode *codePtr,
-    unsigned int pcOffset)
-{
-    register JumptableInfo *jtPtr = clientData;
-    Tcl_Obj *mapping = Tcl_NewObj();
-    Tcl_HashEntry *hPtr;
-    Tcl_HashSearch search;
-    const char *keyPtr;
-    int offset;
-
-    hPtr = Tcl_FirstHashEntry(&jtPtr->hashTable, &search);
-    for (; hPtr ; hPtr = Tcl_NextHashEntry(&search)) {
-	keyPtr = Tcl_GetHashKey(&jtPtr->hashTable, hPtr);
-	offset = PTR2INT(Tcl_GetHashValue(hPtr));
-	Tcl_DictObjPut(NULL, mapping, Tcl_NewStringObj(keyPtr, -1),
-		Tcl_NewIntObj(offset));
-    }
-    Tcl_DictObjPut(NULL, dictObj, Tcl_NewStringObj("mapping", -1), mapping);
-}
 
 /*
  *----------------------------------------------------------------------
@@ -3068,7 +3038,6 @@ IssueTryClausesInstructions(
 	if (!handlerTokens[i]) {
 	    forwardsNeedFixing = 1;
 	    JUMP4(			JUMP, forwardsToFix[i]);
-	    TclAdjustStackDepth(1, envPtr);
 	} else {
 	    int dontChangeOptions;
 
@@ -3782,6 +3751,7 @@ TclCompileWhileCmd(
 	}
 	SetLineInformation(1);
 	TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
+	TclClearNumConversion(envPtr);
 
 	jumpDist = CurrentOffset(envPtr) - bodyCodeOffset;
 	if (jumpDist > 127) {

generic/tclCompile.c

@@ -55,9 +55,9 @@ InstructionDesc const tclInstructionTable[] = {
     /* Name	      Bytes stackEffect #Opnds  Operand types */
     {"done",		  1,   -1,         0,	{OPERAND_NONE}},
 	/* Finish ByteCode execution and return stktop (top stack item) */
-    {"push1",		  2,   +1,         1,	{OPERAND_LIT1}},
+    {"push1",		  2,   +1,         1,	{OPERAND_UINT1}},
 	/* Push object at ByteCode objArray[op1] */
-    {"push4",		  5,   +1,         1,	{OPERAND_LIT4}},
+    {"push4",		  5,   +1,         1,	{OPERAND_UINT4}},
 	/* Push object at ByteCode objArray[op4] */
     {"pop",		  1,   -1,         0,	{OPERAND_NONE}},
 	/* Pop the topmost stack object */
@@ -125,17 +125,17 @@ InstructionDesc const tclInstructionTable[] = {
     {"incrStkImm",	  2,   0,	   1,	{OPERAND_INT1}},
 	/* Incr general variable; unparsed name is top, amount is op1 */
 
-    {"jump1",		  2,   0,          1,	{OPERAND_OFFSET1}},
+    {"jump1",		  2,   0,          1,	{OPERAND_INT1}},
 	/* Jump relative to (pc + op1) */
-    {"jump4",		  5,   0,          1,	{OPERAND_OFFSET4}},
+    {"jump4",		  5,   0,          1,	{OPERAND_INT4}},
 	/* Jump relative to (pc + op4) */
-    {"jumpTrue1",	  2,   -1,         1,	{OPERAND_OFFSET1}},
+    {"jumpTrue1",	  2,   -1,         1,	{OPERAND_INT1}},
 	/* Jump relative to (pc + op1) if stktop expr object is true */
-    {"jumpTrue4",	  5,   -1,         1,	{OPERAND_OFFSET4}},
+    {"jumpTrue4",	  5,   -1,         1,	{OPERAND_INT4}},
 	/* Jump relative to (pc + op4) if stktop expr object is true */
-    {"jumpFalse1",	  2,   -1,         1,	{OPERAND_OFFSET1}},
+    {"jumpFalse1",	  2,   -1,         1,	{OPERAND_INT1}},
 	/* Jump relative to (pc + op1) if stktop expr object is false */
-    {"jumpFalse4",	  5,   -1,         1,	{OPERAND_OFFSET4}},
+    {"jumpFalse4",	  5,   -1,         1,	{OPERAND_INT4}},
 	/* Jump relative to (pc + op4) if stktop expr object is false */
 
     {"lor",		  1,   -1,         0,	{OPERAND_NONE}},
@@ -298,7 +298,7 @@ InstructionDesc const tclInstructionTable[] = {
 	/* List Index:	push (lindex stktop op4) */
     {"listRangeImm",	  9,	0,	   2,	{OPERAND_IDX4, OPERAND_IDX4}},
 	/* List Range:	push (lrange stktop op4 op4) */
-    {"startCommand",	  9,	0,	   2,	{OPERAND_OFFSET4, OPERAND_UINT4}},
+    {"startCommand",	  9,	0,	   2,	{OPERAND_INT4,OPERAND_UINT4}},
 	/* Start of bytecoded command: op is the length of the cmd's code, op2
 	 * is number of commands here */
 
@@ -692,6 +692,11 @@ static void		RegisterAuxDataType(const AuxDataType *typePtr);
 static int		SetByteCodeFromAny(Tcl_Interp *interp,
 			    Tcl_Obj *objPtr);
 static void		StartExpanding(CompileEnv *envPtr);
+static int		FormatInstruction(ByteCode *codePtr,
+			    const unsigned char *pc, Tcl_Obj *bufferObj);
+static void		PrintSourceToObj(Tcl_Obj *appendObj,
+			    const char *stringPtr, int maxChars);
+static void		UpdateStringOfInstName(Tcl_Obj *objPtr);
 
 /*
  * TIP #280: Helper for building the per-word line information of all compiled
@@ -729,6 +734,19 @@ static const Tcl_ObjType substCodeType = {
     NULL,			/* setFromAnyProc */
 };
 
+/*
+ * The structure below defines an instruction name Tcl object to allow
+ * reporting of inner contexts in errorstack without string allocation.
+ */
+
+static const Tcl_ObjType tclInstNameType = {
+    "instname",			/* name */
+    NULL,			/* freeIntRepProc */
+    NULL,			/* dupIntRepProc */
+    UpdateStringOfInstName,	/* updateStringProc */
+    NULL,			/* setFromAnyProc */
+};
+
 /*
  * Helper macros.
  */
@@ -4578,6 +4596,796 @@ EncodeCmdLocMap(
     return p;
 }
 
+#ifdef TCL_COMPILE_DEBUG
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclPrintByteCodeObj --
+ *
+ *	This procedure prints ("disassembles") the instructions of a bytecode
+ *	object to stdout.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclPrintByteCodeObj(
+    Tcl_Interp *interp,		/* Used only for Tcl_GetStringFromObj. */
+    Tcl_Obj *objPtr)		/* The bytecode object to disassemble. */
+{
+    Tcl_Obj *bufPtr = TclDisassembleByteCodeObj(objPtr);
+
+    fprintf(stdout, "\n%s", TclGetString(bufPtr));
+    Tcl_DecrRefCount(bufPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclPrintInstruction --
+ *
+ *	This procedure prints ("disassembles") one instruction from a bytecode
+ *	object to stdout.
+ *
+ * Results:
+ *	Returns the length in bytes of the current instruiction.
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclPrintInstruction(
+    ByteCode *codePtr,		/* Bytecode containing the instruction. */
+    const unsigned char *pc)	/* Points to first byte of instruction. */
+{
+    Tcl_Obj *bufferObj;
+    int numBytes;
+
+    TclNewObj(bufferObj);
+    numBytes = FormatInstruction(codePtr, pc, bufferObj);
+    fprintf(stdout, "%s", TclGetString(bufferObj));
+    Tcl_DecrRefCount(bufferObj);
+    return numBytes;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclPrintObject --
+ *
+ *	This procedure prints up to a specified number of characters from the
+ *	argument Tcl object's string representation to a specified file.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Outputs characters to the specified file.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclPrintObject(
+    FILE *outFile,		/* The file to print the source to. */
+    Tcl_Obj *objPtr,		/* Points to the Tcl object whose string
+				 * representation should be printed. */
+    int maxChars)		/* Maximum number of chars to print. */
+{
+    char *bytes;
+    int length;
+
+    bytes = Tcl_GetStringFromObj(objPtr, &length);
+    TclPrintSource(outFile, bytes, TclMin(length, maxChars));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclPrintSource --
+ *
+ *	This procedure prints up to a specified number of characters from the
+ *	argument string to a specified file. It tries to produce legible
+ *	output by adding backslashes as necessary.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Outputs characters to the specified file.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclPrintSource(
+    FILE *outFile,		/* The file to print the source to. */
+    const char *stringPtr,	/* The string to print. */
+    int maxChars)		/* Maximum number of chars to print. */
+{
+    Tcl_Obj *bufferObj;
+
+    TclNewObj(bufferObj);
+    PrintSourceToObj(bufferObj, stringPtr, maxChars);
+    fprintf(outFile, "%s", TclGetString(bufferObj));
+    Tcl_DecrRefCount(bufferObj);
+}
+#endif /* TCL_COMPILE_DEBUG */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclDisassembleByteCodeObj --
+ *
+ *	Given an object which is of bytecode type, return a disassembled
+ *	version of the bytecode (in a new refcount 0 object). No guarantees
+ *	are made about the details of the contents of the result.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclDisassembleByteCodeObj(
+    Tcl_Obj *objPtr)		/* The bytecode object to disassemble. */
+{
+    ByteCode *codePtr = objPtr->internalRep.twoPtrValue.ptr1;
+    unsigned char *codeStart, *codeLimit, *pc;
+    unsigned char *codeDeltaNext, *codeLengthNext;
+    unsigned char *srcDeltaNext, *srcLengthNext;
+    int codeOffset, codeLen, srcOffset, srcLen, numCmds, delta, i;
+    Interp *iPtr = (Interp *) *codePtr->interpHandle;
+    Tcl_Obj *bufferObj;
+    char ptrBuf1[20], ptrBuf2[20];
+
+    TclNewObj(bufferObj);
+    if (codePtr->refCount <= 0) {
+	return bufferObj;	/* Already freed. */
+    }
+
+    codeStart = codePtr->codeStart;
+    codeLimit = codeStart + codePtr->numCodeBytes;
+    numCmds = codePtr->numCommands;
+
+    /*
+     * Print header lines describing the ByteCode.
+     */
+
+    sprintf(ptrBuf1, "%p", codePtr);
+    sprintf(ptrBuf2, "%p", iPtr);
+    Tcl_AppendPrintfToObj(bufferObj,
+	    "ByteCode 0x%s, refCt %u, epoch %u, interp 0x%s (epoch %u)\n",
+	    ptrBuf1, codePtr->refCount, codePtr->compileEpoch, ptrBuf2,
+	    iPtr->compileEpoch);
+    Tcl_AppendToObj(bufferObj, "  Source ", -1);
+    PrintSourceToObj(bufferObj, codePtr->source,
+	    TclMin(codePtr->numSrcBytes, 55));
+    Tcl_AppendPrintfToObj(bufferObj,
+	    "\n  Cmds %d, src %d, inst %d, litObjs %u, aux %d, stkDepth %u, code/src %.2f\n",
+	    numCmds, codePtr->numSrcBytes, codePtr->numCodeBytes,
+	    codePtr->numLitObjects, codePtr->numAuxDataItems,
+	    codePtr->maxStackDepth,
+#ifdef TCL_COMPILE_STATS
+	    codePtr->numSrcBytes?
+		    codePtr->structureSize/(float)codePtr->numSrcBytes :
+#endif
+	    0.0);
+
+#ifdef TCL_COMPILE_STATS
+    Tcl_AppendPrintfToObj(bufferObj,
+	    "  Code %lu = header %lu+inst %d+litObj %lu+exc %lu+aux %lu+cmdMap %d\n",
+	    (unsigned long) codePtr->structureSize,
+	    (unsigned long) (sizeof(ByteCode) - sizeof(size_t) - sizeof(Tcl_Time)),
+	    codePtr->numCodeBytes,
+	    (unsigned long) (codePtr->numLitObjects * sizeof(Tcl_Obj *)),
+	    (unsigned long) (codePtr->numExceptRanges*sizeof(ExceptionRange)),
+	    (unsigned long) (codePtr->numAuxDataItems * sizeof(AuxData)),
+	    codePtr->numCmdLocBytes);
+#endif /* TCL_COMPILE_STATS */
+
+    /*
+     * If the ByteCode is the compiled body of a Tcl procedure, print
+     * information about that procedure. Note that we don't know the
+     * procedure's name since ByteCode's can be shared among procedures.
+     */
+
+    if (codePtr->procPtr != NULL) {
+	Proc *procPtr = codePtr->procPtr;
+	int numCompiledLocals = procPtr->numCompiledLocals;
+
+	sprintf(ptrBuf1, "%p", procPtr);
+	Tcl_AppendPrintfToObj(bufferObj,
+		"  Proc 0x%s, refCt %d, args %d, compiled locals %d\n",
+		ptrBuf1, procPtr->refCount, procPtr->numArgs,
+		numCompiledLocals);
+	if (numCompiledLocals > 0) {
+	    CompiledLocal *localPtr = procPtr->firstLocalPtr;
+
+	    for (i = 0;  i < numCompiledLocals;  i++) {
+		Tcl_AppendPrintfToObj(bufferObj,
+			"      slot %d%s%s%s%s%s%s", i,
+			(localPtr->flags & (VAR_ARRAY|VAR_LINK)) ? "" : ", scalar",
+			(localPtr->flags & VAR_ARRAY) ? ", array" : "",
+			(localPtr->flags & VAR_LINK) ? ", link" : "",
+			(localPtr->flags & VAR_ARGUMENT) ? ", arg" : "",
+			(localPtr->flags & VAR_TEMPORARY) ? ", temp" : "",
+			(localPtr->flags & VAR_RESOLVED) ? ", resolved" : "");
+		if (TclIsVarTemporary(localPtr)) {
+		    Tcl_AppendToObj(bufferObj, "\n", -1);
+		} else {
+		    Tcl_AppendPrintfToObj(bufferObj, ", \"%s\"\n",
+			    localPtr->name);
+		}
+		localPtr = localPtr->nextPtr;
+	    }
+	}
+    }
+
+    /*
+     * Print the ExceptionRange array.
+     */
+
+    if (codePtr->numExceptRanges > 0) {
+	Tcl_AppendPrintfToObj(bufferObj, "  Exception ranges %d, depth %d:\n",
+		codePtr->numExceptRanges, codePtr->maxExceptDepth);
+	for (i = 0;  i < codePtr->numExceptRanges;  i++) {
+	    ExceptionRange *rangePtr = &codePtr->exceptArrayPtr[i];
+
+	    Tcl_AppendPrintfToObj(bufferObj,
+		    "      %d: level %d, %s, pc %d-%d, ",
+		    i, rangePtr->nestingLevel,
+		    (rangePtr->type==LOOP_EXCEPTION_RANGE ? "loop" : "catch"),
+		    rangePtr->codeOffset,
+		    (rangePtr->codeOffset + rangePtr->numCodeBytes - 1));
+	    switch (rangePtr->type) {
+	    case LOOP_EXCEPTION_RANGE:
+		Tcl_AppendPrintfToObj(bufferObj, "continue %d, break %d\n",
+			rangePtr->continueOffset, rangePtr->breakOffset);
+		break;
+	    case CATCH_EXCEPTION_RANGE:
+		Tcl_AppendPrintfToObj(bufferObj, "catch %d\n",
+			rangePtr->catchOffset);
+		break;
+	    default:
+		Tcl_Panic("TclDisassembleByteCodeObj: bad ExceptionRange type %d",
+			rangePtr->type);
+	    }
+	}
+    }
+
+    /*
+     * If there were no commands (e.g., an expression or an empty string was
+     * compiled), just print all instructions and return.
+     */
+
+    if (numCmds == 0) {
+	pc = codeStart;
+	while (pc < codeLimit) {
+	    Tcl_AppendToObj(bufferObj, "    ", -1);
+	    pc += FormatInstruction(codePtr, pc, bufferObj);
+	}
+	return bufferObj;
+    }
+
+    /*
+     * Print table showing the code offset, source offset, and source length
+     * for each command. These are encoded as a sequence of bytes.
+     */
+
+    Tcl_AppendPrintfToObj(bufferObj, "  Commands %d:", numCmds);
+    codeDeltaNext = codePtr->codeDeltaStart;
+    codeLengthNext = codePtr->codeLengthStart;
+    srcDeltaNext = codePtr->srcDeltaStart;
+    srcLengthNext = codePtr->srcLengthStart;
+    codeOffset = srcOffset = 0;
+    for (i = 0;  i < numCmds;  i++) {
+	if ((unsigned) *codeDeltaNext == (unsigned) 0xFF) {
+	    codeDeltaNext++;
+	    delta = TclGetInt4AtPtr(codeDeltaNext);
+	    codeDeltaNext += 4;
+	} else {
+	    delta = TclGetInt1AtPtr(codeDeltaNext);
+	    codeDeltaNext++;
+	}
+	codeOffset += delta;
+
+	if ((unsigned) *codeLengthNext == (unsigned) 0xFF) {
+	    codeLengthNext++;
+	    codeLen = TclGetInt4AtPtr(codeLengthNext);
+	    codeLengthNext += 4;
+	} else {
+	    codeLen = TclGetInt1AtPtr(codeLengthNext);
+	    codeLengthNext++;
+	}
+
+	if ((unsigned) *srcDeltaNext == (unsigned) 0xFF) {
+	    srcDeltaNext++;
+	    delta = TclGetInt4AtPtr(srcDeltaNext);
+	    srcDeltaNext += 4;
+	} else {
+	    delta = TclGetInt1AtPtr(srcDeltaNext);
+	    srcDeltaNext++;
+	}
+	srcOffset += delta;
+
+	if ((unsigned) *srcLengthNext == (unsigned) 0xFF) {
+	    srcLengthNext++;
+	    srcLen = TclGetInt4AtPtr(srcLengthNext);
+	    srcLengthNext += 4;
+	} else {
+	    srcLen = TclGetInt1AtPtr(srcLengthNext);
+	    srcLengthNext++;
+	}
+
+	Tcl_AppendPrintfToObj(bufferObj, "%s%4d: pc %d-%d, src %d-%d",
+		((i % 2)? "     " : "\n   "),
+		(i+1), codeOffset, (codeOffset + codeLen - 1),
+		srcOffset, (srcOffset + srcLen - 1));
+    }
+    if (numCmds > 0) {
+	Tcl_AppendToObj(bufferObj, "\n", -1);
+    }
+
+    /*
+     * Print each instruction. If the instruction corresponds to the start of
+     * a command, print the command's source. Note that we don't need the code
+     * length here.
+     */
+
+    codeDeltaNext = codePtr->codeDeltaStart;
+    srcDeltaNext = codePtr->srcDeltaStart;
+    srcLengthNext = codePtr->srcLengthStart;
+    codeOffset = srcOffset = 0;
+    pc = codeStart;
+    for (i = 0;  i < numCmds;  i++) {
+	if ((unsigned) *codeDeltaNext == (unsigned) 0xFF) {
+	    codeDeltaNext++;
+	    delta = TclGetInt4AtPtr(codeDeltaNext);
+	    codeDeltaNext += 4;
+	} else {
+	    delta = TclGetInt1AtPtr(codeDeltaNext);
+	    codeDeltaNext++;
+	}
+	codeOffset += delta;
+
+	if ((unsigned) *srcDeltaNext == (unsigned) 0xFF) {
+	    srcDeltaNext++;
+	    delta = TclGetInt4AtPtr(srcDeltaNext);
+	    srcDeltaNext += 4;
+	} else {
+	    delta = TclGetInt1AtPtr(srcDeltaNext);
+	    srcDeltaNext++;
+	}
+	srcOffset += delta;
+
+	if ((unsigned) *srcLengthNext == (unsigned) 0xFF) {
+	    srcLengthNext++;
+	    srcLen = TclGetInt4AtPtr(srcLengthNext);
+	    srcLengthNext += 4;
+	} else {
+	    srcLen = TclGetInt1AtPtr(srcLengthNext);
+	    srcLengthNext++;
+	}
+
+	/*
+	 * Print instructions before command i.
+	 */
+
+	while ((pc-codeStart) < codeOffset) {
+	    Tcl_AppendToObj(bufferObj, "    ", -1);
+	    pc += FormatInstruction(codePtr, pc, bufferObj);
+	}
+
+	Tcl_AppendPrintfToObj(bufferObj, "  Command %d: ", i+1);
+	PrintSourceToObj(bufferObj, (codePtr->source + srcOffset),
+		TclMin(srcLen, 55));
+	Tcl_AppendToObj(bufferObj, "\n", -1);
+    }
+    if (pc < codeLimit) {
+	/*
+	 * Print instructions after the last command.
+	 */
+
+	while (pc < codeLimit) {
+	    Tcl_AppendToObj(bufferObj, "    ", -1);
+	    pc += FormatInstruction(codePtr, pc, bufferObj);
+	}
+    }
+    return bufferObj;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FormatInstruction --
+ *
+ *	Appends a representation of a bytecode instruction to a Tcl_Obj.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FormatInstruction(
+    ByteCode *codePtr,		/* Bytecode containing the instruction. */
+    const unsigned char *pc,	/* Points to first byte of instruction. */
+    Tcl_Obj *bufferObj)		/* Object to append instruction info to. */
+{
+    Proc *procPtr = codePtr->procPtr;
+    unsigned char opCode = *pc;
+    register const InstructionDesc *instDesc = &tclInstructionTable[opCode];
+    unsigned char *codeStart = codePtr->codeStart;
+    unsigned pcOffset = pc - codeStart;
+    int opnd = 0, i, j, numBytes = 1;
+    int localCt = procPtr ? procPtr->numCompiledLocals : 0;
+    CompiledLocal *localPtr = procPtr ? procPtr->firstLocalPtr : NULL;
+    char suffixBuffer[128];	/* Additional info to print after main opcode
+				 * and immediates. */
+    char *suffixSrc = NULL;
+    Tcl_Obj *suffixObj = NULL;
+    AuxData *auxPtr = NULL;
+
+    suffixBuffer[0] = '\0';
+    Tcl_AppendPrintfToObj(bufferObj, "(%u) %s ", pcOffset, instDesc->name);
+    for (i = 0;  i < instDesc->numOperands;  i++) {
+	switch (instDesc->opTypes[i]) {
+	case OPERAND_INT1:
+	    opnd = TclGetInt1AtPtr(pc+numBytes); numBytes++;
+	    if (opCode == INST_JUMP1 || opCode == INST_JUMP_TRUE1
+		    || opCode == INST_JUMP_FALSE1) {
+		sprintf(suffixBuffer, "pc %u", pcOffset+opnd);
+	    }
+	    Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd);
+	    break;
+	case OPERAND_INT4:
+	    opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4;
+	    if (opCode == INST_JUMP4 || opCode == INST_JUMP_TRUE4
+		    || opCode == INST_JUMP_FALSE4) {
+		sprintf(suffixBuffer, "pc %u", pcOffset+opnd);
+	    } else if (opCode == INST_START_CMD) {
+		sprintf(suffixBuffer, "next cmd at pc %u", pcOffset+opnd);
+	    }
+	    Tcl_AppendPrintfToObj(bufferObj, "%+d ", opnd);
+	    break;
+	case OPERAND_UINT1:
+	    opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++;
+	    if (opCode == INST_PUSH1) {
+		suffixObj = codePtr->objArrayPtr[opnd];
+	    }
+	    Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd);
+	    break;
+	case OPERAND_AUX4:
+	case OPERAND_UINT4:
+	    opnd = TclGetUInt4AtPtr(pc+numBytes); numBytes += 4;
+	    if (opCode == INST_PUSH4) {
+		suffixObj = codePtr->objArrayPtr[opnd];
+	    } else if (opCode == INST_START_CMD && opnd != 1) {
+		sprintf(suffixBuffer+strlen(suffixBuffer),
+			", %u cmds start here", opnd);
+	    }
+	    Tcl_AppendPrintfToObj(bufferObj, "%u ", (unsigned) opnd);
+	    if (instDesc->opTypes[i] == OPERAND_AUX4) {
+		auxPtr = &codePtr->auxDataArrayPtr[opnd];
+	    }
+	    break;
+	case OPERAND_IDX4:
+	    opnd = TclGetInt4AtPtr(pc+numBytes); numBytes += 4;
+	    if (opnd >= -1) {
+		Tcl_AppendPrintfToObj(bufferObj, "%d ", opnd);
+	    } else if (opnd == -2) {
+		Tcl_AppendPrintfToObj(bufferObj, "end ");
+	    } else {
+		Tcl_AppendPrintfToObj(bufferObj, "end-%d ", -2-opnd);
+	    }
+	    break;
+	case OPERAND_LVT1:
+	    opnd = TclGetUInt1AtPtr(pc+numBytes);
+	    numBytes++;
+	    goto printLVTindex;
+	case OPERAND_LVT4:
+	    opnd = TclGetUInt4AtPtr(pc+numBytes);
+	    numBytes += 4;
+	printLVTindex:
+	    if (localPtr != NULL) {
+		if (opnd >= localCt) {
+		    Tcl_Panic("FormatInstruction: bad local var index %u (%u locals)",
+			    (unsigned) opnd, localCt);
+		}
+		for (j = 0;  j < opnd;  j++) {
+		    localPtr = localPtr->nextPtr;
+		}
+		if (TclIsVarTemporary(localPtr)) {
+		    sprintf(suffixBuffer, "temp var %u", (unsigned) opnd);
+		} else {
+		    sprintf(suffixBuffer, "var ");
+		    suffixSrc = localPtr->name;
+		}
+	    }
+	    Tcl_AppendPrintfToObj(bufferObj, "%%v%u ", (unsigned) opnd);
+	    break;
+	case OPERAND_SCLS1:
+	    opnd = TclGetUInt1AtPtr(pc+numBytes); numBytes++;
+	    Tcl_AppendPrintfToObj(bufferObj, "%s ",
+		    tclStringClassTable[opnd].name);
+	    break;
+	case OPERAND_NONE:
+	default:
+	    break;
+	}
+    }
+    if (suffixObj) {
+	const char *bytes;
+	int length;
+
+	Tcl_AppendToObj(bufferObj, "\t# ", -1);
+	bytes = Tcl_GetStringFromObj(codePtr->objArrayPtr[opnd], &length);
+	PrintSourceToObj(bufferObj, bytes, TclMin(length, 40));
+    } else if (suffixBuffer[0]) {
+	Tcl_AppendPrintfToObj(bufferObj, "\t# %s", suffixBuffer);
+	if (suffixSrc) {
+	    PrintSourceToObj(bufferObj, suffixSrc, 40);
+	}
+    }
+    Tcl_AppendToObj(bufferObj, "\n", -1);
+    if (auxPtr && auxPtr->type->printProc) {
+	Tcl_AppendToObj(bufferObj, "\t\t[", -1);
+	auxPtr->type->printProc(auxPtr->clientData, bufferObj, codePtr,
+		pcOffset);
+	Tcl_AppendToObj(bufferObj, "]\n", -1);
+    }
+    return numBytes;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetInnerContext --
+ *
+ *	If possible, returns a list capturing the inner context. Otherwise
+ *	return NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclGetInnerContext(
+    Tcl_Interp *interp,
+    const unsigned char *pc,
+    Tcl_Obj **tosPtr)
+{
+    int objc = 0, off = 0;
+    Tcl_Obj *result;
+    Interp *iPtr = (Interp *) interp;
+
+    switch (*pc) {
+    case INST_STR_LEN:
+    case INST_LNOT:
+    case INST_BITNOT:
+    case INST_UMINUS:
+    case INST_UPLUS:
+    case INST_TRY_CVT_TO_NUMERIC:
+    case INST_EXPAND_STKTOP:
+    case INST_EXPR_STK:
+        objc = 1;
+        break;
+
+    case INST_LIST_IN:
+    case INST_LIST_NOT_IN:	/* Basic list containment operators. */
+    case INST_STR_EQ:
+    case INST_STR_NEQ:		/* String (in)equality check */
+    case INST_STR_CMP:		/* String compare. */
+    case INST_STR_INDEX:
+    case INST_STR_MATCH:
+    case INST_REGEXP:
+    case INST_EQ:
+    case INST_NEQ:
+    case INST_LT:
+    case INST_GT:
+    case INST_LE:
+    case INST_GE:
+    case INST_MOD:
+    case INST_LSHIFT:
+    case INST_RSHIFT:
+    case INST_BITOR:
+    case INST_BITXOR:
+    case INST_BITAND:
+    case INST_EXPON:
+    case INST_ADD:
+    case INST_SUB:
+    case INST_DIV:
+    case INST_MULT:
+        objc = 2;
+        break;
+
+    case INST_RETURN_STK:
+        /* early pop. TODO: dig out opt dict too :/ */
+        objc = 1;
+        break;
+
+    case INST_SYNTAX:
+    case INST_RETURN_IMM:
+        objc = 2;
+        break;
+
+    case INST_INVOKE_STK4:
+	objc = TclGetUInt4AtPtr(pc+1);
+        break;
+
+    case INST_INVOKE_STK1:
+	objc = TclGetUInt1AtPtr(pc+1);
+	break;
+    }
+
+    result = iPtr->innerContext;
+    if (Tcl_IsShared(result)) {
+        Tcl_DecrRefCount(result);
+        iPtr->innerContext = result = Tcl_NewListObj(objc + 1, NULL);
+        Tcl_IncrRefCount(result);
+    } else {
+        int len;
+
+        /*
+         * Reset while keeping the list intrep as much as possible.
+         */
+
+	Tcl_ListObjLength(interp, result, &len);
+        Tcl_ListObjReplace(interp, result, 0, len, 0, NULL);
+    }
+    Tcl_ListObjAppendElement(NULL, result, TclNewInstNameObj(*pc));
+
+    for (; objc>0 ; objc--) {
+        Tcl_Obj *objPtr;
+
+        objPtr = tosPtr[1 - objc + off];
+        if (!objPtr) {
+            Tcl_Panic("InnerContext: bad tos -- appending null object");
+        }
+        if ((objPtr->refCount<=0)
+#ifdef TCL_MEM_DEBUG
+                || (objPtr->refCount==0x61616161)
+#endif
+        ) {
+            Tcl_Panic("InnerContext: bad tos -- appending freed object %p",
+                    objPtr);
+        }
+        Tcl_ListObjAppendElement(NULL, result, objPtr);
+    }
+
+    return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclNewInstNameObj --
+ *
+ *	Creates a new InstName Tcl_Obj based on the given instruction
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_Obj *
+TclNewInstNameObj(
+    unsigned char inst)
+{
+    Tcl_Obj *objPtr = Tcl_NewObj();
+
+    objPtr->typePtr = &tclInstNameType;
+    objPtr->internalRep.longValue = (long) inst;
+    objPtr->bytes = NULL;
+
+    return objPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateStringOfInstName --
+ *
+ *	Update the string representation for an instruction name object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateStringOfInstName(
+    Tcl_Obj *objPtr)
+{
+    int inst = objPtr->internalRep.longValue;
+    char *s, buf[20];
+    int len;
+
+    if ((inst < 0) || (inst > LAST_INST_OPCODE)) {
+        sprintf(buf, "inst_%d", inst);
+        s = buf;
+    } else {
+        s = (char *) tclInstructionTable[objPtr->internalRep.longValue].name;
+    }
+    len = strlen(s);
+    objPtr->bytes = ckalloc(len + 1);
+    memcpy(objPtr->bytes, s, len + 1);
+    objPtr->length = len;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PrintSourceToObj --
+ *
+ *	Appends a quoted representation of a string to a Tcl_Obj.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+PrintSourceToObj(
+    Tcl_Obj *appendObj,		/* The object to print the source to. */
+    const char *stringPtr,	/* The string to print. */
+    int maxChars)		/* Maximum number of chars to print. */
+{
+    register const char *p;
+    register int i = 0, len;
+
+    if (stringPtr == NULL) {
+	Tcl_AppendToObj(appendObj, "\"\"", -1);
+	return;
+    }
+
+    Tcl_AppendToObj(appendObj, "\"", -1);
+    p = stringPtr;
+    for (;  (*p != '\0') && (i < maxChars);  p+=len) {
+	Tcl_UniChar ch;
+
+	len = TclUtfToUniChar(p, &ch);
+	switch (ch) {
+	case '"':
+	    Tcl_AppendToObj(appendObj, "\\\"", -1);
+	    i += 2;
+	    continue;
+	case '\f':
+	    Tcl_AppendToObj(appendObj, "\\f", -1);
+	    i += 2;
+	    continue;
+	case '\n':
+	    Tcl_AppendToObj(appendObj, "\\n", -1);
+	    i += 2;
+	    continue;
+	case '\r':
+	    Tcl_AppendToObj(appendObj, "\\r", -1);
+	    i += 2;
+	    continue;
+	case '\t':
+	    Tcl_AppendToObj(appendObj, "\\t", -1);
+	    i += 2;
+	    continue;
+	case '\v':
+	    Tcl_AppendToObj(appendObj, "\\v", -1);
+	    i += 2;
+	    continue;
+	default:
+	    if (ch < 0x20 || ch >= 0x7f) {
+		Tcl_AppendPrintfToObj(appendObj, "\\u%04x", ch);
+		i += 6;
+	    } else {
+		Tcl_AppendPrintfToObj(appendObj, "%c", ch);
+		i++;
+	    }
+	    continue;
+	}
+    }
+    Tcl_AppendToObj(appendObj, "\"", -1);
+    if (*p != '\0') {
+	Tcl_AppendToObj(appendObj, "...", -1);
+    }
+}
+
 #ifdef TCL_COMPILE_STATS
 /*
  *----------------------------------------------------------------------

generic/tclCompile.h

@@ -48,13 +48,6 @@ MODULE_SCOPE int 	tclTraceCompile;
 
 MODULE_SCOPE int 	tclTraceExec;
 #endif
-
-/*
- * The type of lambda expressions. Note that every lambda will *always* have a
- * string representation.
- */
-
-MODULE_SCOPE const Tcl_ObjType tclLambdaType;
 
 /*
  *------------------------------------------------------------------------
@@ -245,16 +238,6 @@ typedef struct AuxDataType {
     AuxDataPrintProc *printProc;/* Callback function to invoke when printing
 				 * the aux data as part of debugging. NULL
 				 * means that the data can't be printed. */
-    AuxDataPrintProc *disassembleProc;
-				/* Callback function to invoke when doing a
-				 * disassembly of the aux data (like the
-				 * printProc, except that the output is
-				 * intended to be script-readable). The
-				 * appendObj argument should be filled in with
-				 * a descriptive dictionary; it will start out
-				 * with "name" mapped to the content of the
-				 * name field. NULL means that the printProc
-				 * should be used instead. */
 } AuxDataType;
 
 /*
@@ -849,12 +832,6 @@ typedef enum InstOperandType {
 				 * variable table. */
     OPERAND_AUX4,		/* Four byte unsigned index into the aux data
 				 * table. */
-    OPERAND_OFFSET1,		/* One byte signed jump offset. */
-    OPERAND_OFFSET4,		/* Four byte signed jump offset. */
-    OPERAND_LIT1,		/* One byte unsigned index into table of
-				 * literals. */
-    OPERAND_LIT4,		/* Four byte unsigned index into table of
-				 * literals. */
     OPERAND_SCLS1		/* Index into tclStringClassTable. */
 } InstOperandType;
 
@@ -1188,15 +1165,12 @@ MODULE_SCOPE void	TclVerifyLocalLiteralTable(CompileEnv *envPtr);
 MODULE_SCOPE int	TclWordKnownAtCompileTime(Tcl_Token *tokenPtr,
 			    Tcl_Obj *valuePtr);
 MODULE_SCOPE void	TclLogCommandInfo(Tcl_Interp *interp,
-			    const char *script, const char *command,
-			    int length, const unsigned char *pc,
-			    Tcl_Obj **tosPtr); 
+					  const char *script,
+					  const char *command, int length,
+					  const unsigned char *pc, Tcl_Obj **tosPtr); 
 MODULE_SCOPE Tcl_Obj	*TclGetInnerContext(Tcl_Interp *interp,
-			    const unsigned char *pc, Tcl_Obj **tosPtr);
+					    const unsigned char *pc, Tcl_Obj **tosPtr);
 MODULE_SCOPE Tcl_Obj	*TclNewInstNameObj(unsigned char inst);
-MODULE_SCOPE int	TclPushProcCallFrame(ClientData clientData,
-			    register Tcl_Interp *interp, int objc,
-			    Tcl_Obj *const objv[], int isLambda);
 
 
 /*
@@ -1413,6 +1387,18 @@ MODULE_SCOPE int	TclPushProcCallFrame(ClientData clientData,
 	}							 \
     } while (0)
 
+/*
+ * If the expr compiler finished with TRY_CONVERT, macro to remove it when the
+ * job is done by the following instruction.
+ */
+
+#define TclClearNumConversion(envPtr) \
+    do {								\
+	if (*(envPtr->codeNext - 1) == INST_TRY_CVT_TO_NUMERIC) {	\
+	    envPtr->codeNext--;						\
+	}								\
+    } while (0)
+
 /*
  * Macros to update a (signed or unsigned) integer starting at a pointer. The
  * two variants depend on the number of bytes. The ANSI C "prototypes" for

generic/tclDecls.h

@@ -1815,6 +1815,8 @@ EXTERN int		Tcl_FSUnloadFile(Tcl_Interp *interp,
 EXTERN void		Tcl_ZlibStreamSetCompressionDictionary(
 				Tcl_ZlibStream zhandle,
 				Tcl_Obj *compressionDictionaryObj);
+/* 631 */
+EXTERN int		Tcl_Zvfs_Boot(Tcl_Interp *interp);
 
 typedef struct {
     const struct TclPlatStubs *tclPlatStubs;
@@ -2481,6 +2483,7 @@ typedef struct TclStubs {
     void * (*tcl_FindSymbol) (Tcl_Interp *interp, Tcl_LoadHandle handle, const char *symbol); /* 628 */
     int (*tcl_FSUnloadFile) (Tcl_Interp *interp, Tcl_LoadHandle handlePtr); /* 629 */
     void (*tcl_ZlibStreamSetCompressionDictionary) (Tcl_ZlibStream zhandle, Tcl_Obj *compressionDictionaryObj); /* 630 */
+    int (*tcl_Zvfs_Boot) (Tcl_Interp *interp); /* 631 */
 } TclStubs;
 
 extern const TclStubs *tclStubsPtr;
@@ -3773,6 +3776,8 @@ extern const TclStubs *tclStubsPtr;
 	(tclStubsPtr->tcl_FSUnloadFile) /* 629 */
 #define Tcl_ZlibStreamSetCompressionDictionary \
 	(tclStubsPtr->tcl_ZlibStreamSetCompressionDictionary) /* 630 */
+#define Tcl_Zvfs_Boot \
+	(tclStubsPtr->tcl_Zvfs_Boot) /* 631 */
 
 #endif /* defined(USE_TCL_STUBS) */
 

generic/tclEvent.c

@@ -1299,17 +1299,20 @@ Tcl_FinalizeThread(void)
 	TclFinalizeAsync();
 	TclFinalizeThreadObjects();
     }
+    if (TclFullFinalizationRequested()) { /* useless if we are facing a quick-exit */
 
-    /*
-     * Blow away all thread local storage blocks.
-     *
-     * Note that Tcl API allows creation of threads which do not use any Tcl
-     * interp or other Tcl subsytems. Those threads might, however, use thread
-     * local storage, so we must unconditionally finalize it.
-     *
-     * Fix [Bug #571002]
-     */
-    TclFinalizeThreadData();
+	/*
+	 * Blow away all thread local storage blocks.
+	 *
+	 * Note that Tcl API allows creation of threads which do not use any Tcl
+	 * interp or other Tcl subsytems. Those threads might, however, use thread
+	 * local storage, so we must unconditionally finalize it.
+	 *
+	 * Fix [Bug #571002]
+	 */
+	
+	TclFinalizeThreadData();
+    }
 }
 
 /*

generic/tclIO.c

@@ -35,15 +35,15 @@ typedef struct ChannelHandler {
 
 /*
  * This structure keeps track of the current ChannelHandler being invoked in
- * the current invocation of Tcl_NotifyChannel. There is a potential
+ * the current invocation of ChannelHandlerEventProc. There is a potential
  * problem if a ChannelHandler is deleted while it is the current one, since
- * Tcl_NotifyChannel needs to look at the nextPtr field. To handle this
+ * ChannelHandlerEventProc needs to look at the nextPtr field. To handle this
  * problem, structures of the type below indicate the next handler to be
  * processed for any (recursively nested) dispatches in progress. The
  * nextHandlerPtr field is updated if the handler being pointed to is deleted.
- * The nestedHandlerPtr field is used to chain together all recursive
- * invocations, so that Tcl_DeleteChannelHandler can find all the recursively
- * nested invocations of Tcl_NotifyChannel and compare the handler being
+ * The nextPtr field is used to chain together all recursive invocations, so
+ * that Tcl_DeleteChannelHandler can find all the recursively nested
+ * invocations of ChannelHandlerEventProc and compare the handler being
  * deleted against the NEXT handler to be invoked in that invocation; when it
  * finds such a situation, Tcl_DeleteChannelHandler updates the nextHandlerPtr
  * field of the structure to the next handler.
@@ -54,9 +54,20 @@ typedef struct NextChannelHandler {
 					 * this invocation. */
     struct NextChannelHandler *nestedHandlerPtr;
 					/* Next nested invocation of
-					 * Tcl_NotifyChannel. */
+					 * ChannelHandlerEventProc. */
 } NextChannelHandler;
 
+/*
+ * The following structure describes the event that is added to the Tcl
+ * event queue by the channel handler check procedure.
+ */
+
+typedef struct ChannelHandlerEvent {
+    Tcl_Event header;		/* Standard header for all events. */
+    Channel *chanPtr;		/* The channel that is ready. */
+    int readyMask;		/* Events that have occurred. */
+} ChannelHandlerEvent;
+
 /*
  * The following structure is used by Tcl_GetsObj() to encapsulates the
  * state for a "gets" operation.
@@ -119,7 +130,7 @@ typedef struct CopyState {
 typedef struct ThreadSpecificData {
     NextChannelHandler *nestedHandlerPtr;
 				/* This variable holds the list of nested
-				 * Tcl_NotifyChannel invocations. */
+				 * ChannelHandlerEventProc invocations. */
     ChannelState *firstCSPtr;	/* List of all channels currently open,
 				 * indexed by ChannelState, as only one
 				 * ChannelState exists per set of stacked
@@ -3894,10 +3905,7 @@ Tcl_Write(
     if (srcLen < 0) {
 	srcLen = strlen(src);
     }
-    if (WriteBytes(chanPtr, src, srcLen) < 0) {
-	return -1;
-    }
-    return srcLen;
+    return WriteBytes(chanPtr, src, srcLen);
 }
 
 /*
@@ -4801,7 +4809,6 @@ TclGetsObjBinary(
 
     eolChar = (statePtr->inputTranslation == TCL_TRANSLATE_LF) ? '\n' : '\r';
 
-    ResetFlag(statePtr, CHANNEL_BLOCKED);
     while (1) {
 	/*
 	 * Subtract the number of bytes that were removed from channel
@@ -6050,11 +6057,12 @@ ReadChars(
 	    /* 
 	     * We read more chars than allowed.  Reset limits to
 	     * prevent that and try again.  Don't forget the extra
-	     * padding of TCL_UTF_MAX bytes demanded by the
+	     * padding of TCL_UTF_MAX - 1 bytes demanded by the
 	     * Tcl_ExternalToUtf() call!
 	     */
 
-	    dstLimit = Tcl_UtfAtIndex(dst, charsToRead) + TCL_UTF_MAX - dst;
+	    dstLimit = Tcl_UtfAtIndex(dst, charsToRead + 1) 
+		    + TCL_UTF_MAX - 1 - dst;
 	    statePtr->flags = savedFlags;
 	    statePtr->inputEncodingFlags = savedIEFlags;
 	    statePtr->inputEncodingState = savedState;
@@ -8092,7 +8100,7 @@ Tcl_NotifyChannel(
 
     /*
      * Add this invocation to the list of recursive invocations of
-     * Tcl_NotifyChannel.
+     * ChannelHandlerEventProc.
      */
 
     nh.nextHandlerPtr = NULL;
@@ -8411,7 +8419,7 @@ Tcl_DeleteChannelHandler(
     }
 
     /*
-     * If Tcl_NotifyChannel is about to process this handler, tell it to
+     * If ChannelHandlerEventProc is about to process this handler, tell it to
      * process the next one instead - we are going to delete *this* one.
      */
 
@@ -9024,7 +9032,7 @@ MBRead(
     }
 
     code = GetInput(inStatePtr->topChanPtr);
-    if (code == 0 || GotFlag(inStatePtr, CHANNEL_BLOCKED)) {
+    if (code == 0) {
 	return TCL_OK;
     } else {
 	MBError(csPtr, TCL_READABLE, code);
@@ -9274,10 +9282,6 @@ CopyData(
 			csPtr);
 	    }
 	    if (size == 0) {
-		if (!GotFlag(inStatePtr, CHANNEL_NONBLOCKING)) {
-		    /* We allowed a short read.  Keep trying. */
-		    continue;
-		}
 		if (bufObj != NULL) {
 		    TclDecrRefCount(bufObj);
 		    bufObj = NULL;
@@ -9510,39 +9514,21 @@ DoRead(
 	}
 
 	/*
-	 * Don't read more data if we have what we need. 
+	 * If there is not enough data in the buffers to possibly
+	 * complete the read, then go get more.
 	 */
 
-	while (!bufPtr ||			/* We got no buffer!   OR */
-		(!IsBufferFull(bufPtr) && 	/* Our buffer has room AND */
-		(BytesLeft(bufPtr) < bytesToRead) ) ) {
-						/* Not enough bytes in it 
-						 * yet to fill the dst */
-	    int code;
-
+	if (bufPtr == NULL || BytesLeft(bufPtr) < bytesToRead) {
 	moreData:
-	    code = GetInput(chanPtr);
-	    bufPtr = statePtr->inQueueHead;
-
-	    assert (bufPtr != NULL);
-
-	    if (GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)) {
-		/* Further reads cannot do any more */
-		break;
-	    }
-
-	    if (code) {
+	    if (GetInput(chanPtr)) {
 		/* Read error */
 		UpdateInterest(chanPtr);
 		TclChannelRelease((Tcl_Channel)chanPtr);
 		return -1;
 	    }
-
-	    assert (IsBufferFull(bufPtr));
+	    bufPtr = statePtr->inQueueHead;
 	}
 
-	assert (bufPtr != NULL);
-
 	bytesRead = BytesLeft(bufPtr);
 	bytesWritten = bytesToRead;
 

generic/tclInt.h

@@ -1741,7 +1741,7 @@ enum PkgPreferOptions {
  * definition there.
  * Some macros require knowledge of some fields in the struct in order to
  * avoid hitting the TSD unnecessarily. In order to facilitate this, a pointer
- * to the relevant fields is kept in the allocCache field in struct Interp.
+ * to the relevant fields is kept in the objCache field in struct Interp.
  *----------------------------------------------------------------
  */
 
@@ -3095,8 +3095,7 @@ MODULE_SCOPE void	TclRememberJoinableThread(Tcl_ThreadId id);
 MODULE_SCOPE void	TclRememberMutex(Tcl_Mutex *mutex);
 MODULE_SCOPE void	TclRemoveScriptLimitCallbacks(Tcl_Interp *interp);
 MODULE_SCOPE int	TclReToGlob(Tcl_Interp *interp, const char *reStr,
-			    int reStrLen, Tcl_DString *dsPtr, int *flagsPtr,
-			    int *quantifiersFoundPtr);
+			    int reStrLen, Tcl_DString *dsPtr, int *flagsPtr);
 MODULE_SCOPE int	TclScanElement(const char *string, int length,
 			    int *flagPtr);
 MODULE_SCOPE void	TclSetBgErrorHandler(Tcl_Interp *interp,

generic/tclOO.c

@@ -1287,9 +1287,7 @@ TclOORemoveFromInstances(
 
   removeInstance:
     if (Deleted(clsPtr->thisPtr)) {
-	if (!IsRootClass(clsPtr)) {
-	    DelRef(clsPtr->instances.list[i]);
-	}
+	DelRef(clsPtr->instances.list[i]);
 	clsPtr->instances.list[i] = NULL;
     } else {
 	clsPtr->instances.num--;

generic/tclProc.c

@@ -15,6 +15,7 @@
 
 #include "tclInt.h"
 #include "tclCompile.h"
+#include "tclOOInt.h"
 
 /*
  * Variables that are part of the [apply] command implementation and which
@@ -40,6 +41,9 @@ static void		InitResolvedLocals(Tcl_Interp *interp,
 			    ByteCode *codePtr, Var *defPtr,
 			    Namespace *nsPtr);
 static void		InitLocalCache(Proc *procPtr);
+static int		PushProcCallFrame(ClientData clientData,
+			    register Tcl_Interp *interp, int objc,
+			    Tcl_Obj *const objv[], int isLambda);
 static void		ProcBodyDup(Tcl_Obj *srcPtr, Tcl_Obj *dupPtr);
 static void		ProcBodyFree(Tcl_Obj *objPtr);
 static int		ProcWrongNumArgs(Tcl_Interp *interp, int skip);
@@ -88,10 +92,10 @@ static const Tcl_ObjType levelReferenceType = {
  *
  * Internally, ptr1 is a pointer to a Proc instance that is not bound to a
  * command name, and ptr2 is a pointer to the namespace that the Proc instance
- * will execute within. IF YOU CHANGE THIS, CHECK IN tclDisassemble.c TOO.
+ * will execute within.
  */
 
-const Tcl_ObjType tclLambdaType = {
+static const Tcl_ObjType lambdaType = {
     "lambdaExpr",		/* name */
     FreeLambdaInternalRep,	/* freeIntRepProc */
     DupLambdaInternalRep,	/* dupIntRepProc */
@@ -217,7 +221,7 @@ Tcl_ProcObjCmd(
      *
      * This code is nearly identical to the #280 code in SetLambdaFromAny, see
      * this file. The differences are the different index of the body in the
-     * line array of the context, and the lambda code requires some special
+     * line array of the context, and the lamdba code requires some special
      * processing. Find a way to factor the common elements into a single
      * function.
      */
@@ -1567,7 +1571,7 @@ InitArgsAndLocals(
 /*
  *----------------------------------------------------------------------
  *
- * TclPushProcCallFrame --
+ * PushProcCallFrame --
  *
  *	Compiles a proc body if necessary, then pushes a CallFrame suitable
  *	for executing it.
@@ -1582,8 +1586,8 @@ InitArgsAndLocals(
  *----------------------------------------------------------------------
  */
 
-int
-TclPushProcCallFrame(
+static int
+PushProcCallFrame(
     ClientData clientData,	/* Record describing procedure to be
 				 * interpreted. */
     register Tcl_Interp *interp,/* Interpreter in which procedure was
@@ -1704,7 +1708,7 @@ TclNRInterpProc(
 				 * procedure. */
     Tcl_Obj *const objv[])	/* Argument value objects. */
 {
-    int result = TclPushProcCallFrame(clientData, interp, objc, objv,
+    int result = PushProcCallFrame(clientData, interp, objc, objv,
 	    /*isLambda*/ 0);
 
     if (result != TCL_OK) {
@@ -2439,7 +2443,7 @@ DupLambdaInternalRep(
 
     procPtr->refCount++;
     Tcl_IncrRefCount(nsObjPtr);
-    copyPtr->typePtr = &tclLambdaType;
+    copyPtr->typePtr = &lambdaType;
 }
 
 static void
@@ -2476,7 +2480,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);
@@ -2622,14 +2626,14 @@ SetLambdaFromAny(
     /*
      * 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;
+    objPtr->typePtr = &lambdaType;
     return TCL_OK;
 }
 
@@ -2680,12 +2684,12 @@ TclNRApplyObjCmd(
     }
 
     /*
-     * Set lambdaPtr, convert it to tclLambdaType in the current interp if
+     * Set lambdaPtr, convert it to lambdaType in the current interp if
      * necessary.
      */
 
     lambdaPtr = objv[1];
-    if (lambdaPtr->typePtr == &tclLambdaType) {
+    if (lambdaPtr->typePtr == &lambdaType) {
 	procPtr = lambdaPtr->internalRep.twoPtrValue.ptr1;
     }
 
@@ -2763,7 +2767,7 @@ TclNRApplyObjCmd(
     }
     extraPtr->isRootEnsemble = isRootEnsemble;
 
-    result = TclPushProcCallFrame(procPtr, interp, objc, objv, 1);
+    result = PushProcCallFrame(procPtr, interp, objc, objv, 1);
     if (result == TCL_OK) {
 	TclNRAddCallback(interp, ApplyNR2, extraPtr, NULL, NULL, NULL);
 	result = TclNRInterpProcCore(interp, objv[1], 2, &MakeLambdaError);
@@ -2822,6 +2826,234 @@ MakeLambdaError(
 	    (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
 }
 
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_DisassembleObjCmd --
+ *
+ *	Implementation of the "::tcl::unsupported::disassemble" command. This
+ *	command is not documented, but will disassemble procedures, lambda
+ *	terms and general scripts. Note that will compile terms if necessary
+ *	in order to disassemble them.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_DisassembleObjCmd(
+    ClientData dummy,		/* Not used. */
+    Tcl_Interp *interp,		/* Current interpreter. */
+    int objc,			/* Number of arguments. */
+    Tcl_Obj *const objv[])	/* Argument objects. */
+{
+    static const char *const types[] = {
+	"lambda", "method", "objmethod", "proc", "script", NULL
+    };
+    enum Types {
+	DISAS_LAMBDA, DISAS_CLASS_METHOD, DISAS_OBJECT_METHOD, DISAS_PROC,
+	DISAS_SCRIPT
+    };
+    int idx, result;
+    Tcl_Obj *codeObjPtr = NULL;
+    Proc *procPtr = NULL;
+    Tcl_HashEntry *hPtr;
+    Object *oPtr;
+
+    if (objc < 2) {
+	Tcl_WrongNumArgs(interp, 1, objv, "type ...");
+	return TCL_ERROR;
+    }
+    if (Tcl_GetIndexFromObj(interp, objv[1], types, "type", 0, &idx)!=TCL_OK){
+	return TCL_ERROR;
+    }
+
+    switch ((enum Types) idx) {
+    case DISAS_LAMBDA: {
+	Command cmd;
+	Tcl_Obj *nsObjPtr;
+	Tcl_Namespace *nsPtr;
+
+	/*
+	 * Compile (if uncompiled) and disassemble a lambda term.
+	 */
+
+	if (objc != 3) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "lambdaTerm");
+	    return TCL_ERROR;
+	}
+	if (objv[2]->typePtr == &lambdaType) {
+	    procPtr = objv[2]->internalRep.twoPtrValue.ptr1;
+	}
+	if (procPtr == NULL || procPtr->iPtr != (Interp *) interp) {
+	    result = SetLambdaFromAny(interp, objv[2]);
+	    if (result != TCL_OK) {
+		return result;
+	    }
+	    procPtr = objv[2]->internalRep.twoPtrValue.ptr1;
+	}
+
+	memset(&cmd, 0, sizeof(Command));
+	nsObjPtr = objv[2]->internalRep.twoPtrValue.ptr2;
+	result = TclGetNamespaceFromObj(interp, nsObjPtr, &nsPtr);
+	if (result != TCL_OK) {
+	    return result;
+	}
+	cmd.nsPtr = (Namespace *) nsPtr;
+	procPtr->cmdPtr = &cmd;
+	result = PushProcCallFrame(procPtr, interp, objc, objv, 1);
+	if (result != TCL_OK) {
+	    return result;
+	}
+	TclPopStackFrame(interp);
+	codeObjPtr = procPtr->bodyPtr;
+	break;
+    }
+    case DISAS_PROC:
+	if (objc != 3) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "procName");
+	    return TCL_ERROR;
+	}
+
+	procPtr = TclFindProc((Interp *) interp, TclGetString(objv[2]));
+	if (procPtr == NULL) {
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "\"%s\" isn't a procedure", TclGetString(objv[2])));
+	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "PROC",
+		    TclGetString(objv[2]), NULL);
+	    return TCL_ERROR;
+	}
+
+	/*
+	 * Compile (if uncompiled) and disassemble a procedure.
+	 */
+
+	result = PushProcCallFrame(procPtr, interp, 2, objv+1, 1);
+	if (result != TCL_OK) {
+	    return result;
+	}
+	TclPopStackFrame(interp);
+	codeObjPtr = procPtr->bodyPtr;
+	break;
+    case DISAS_SCRIPT:
+	/*
+	 * Compile and disassemble a script.
+	 */
+
+	if (objc != 3) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "script");
+	    return TCL_ERROR;
+	}
+	if ((objv[2]->typePtr != &tclByteCodeType)
+		&& (TclSetByteCodeFromAny(interp, objv[2], NULL, NULL) != TCL_OK)) {
+	    return TCL_ERROR;
+	}
+	codeObjPtr = objv[2];
+	break;
+
+    case DISAS_CLASS_METHOD:
+	if (objc != 4) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "className methodName");
+	    return TCL_ERROR;
+	}
+
+	/*
+	 * Look up the body of a class method.
+	 */
+
+	oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]);
+	if (oPtr == NULL) {
+	    return TCL_ERROR;
+	}
+	if (oPtr->classPtr == NULL) {
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "\"%s\" is not a class", TclGetString(objv[2])));
+	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "CLASS",
+		    TclGetString(objv[2]), NULL);
+	    return TCL_ERROR;
+	}
+	hPtr = Tcl_FindHashEntry(&oPtr->classPtr->classMethods,
+		(char *) objv[3]);
+	goto methodBody;
+    case DISAS_OBJECT_METHOD:
+	if (objc != 4) {
+	    Tcl_WrongNumArgs(interp, 2, objv, "objectName methodName");
+	    return TCL_ERROR;
+	}
+
+	/*
+	 * Look up the body of an instance method.
+	 */
+
+	oPtr = (Object *) Tcl_GetObjectFromObj(interp, objv[2]);
+	if (oPtr == NULL) {
+	    return TCL_ERROR;
+	}
+	if (oPtr->methodsPtr == NULL) {
+	    goto unknownMethod;
+	}
+	hPtr = Tcl_FindHashEntry(oPtr->methodsPtr, (char *) objv[3]);
+
+	/*
+	 * Compile (if necessary) and disassemble a method body.
+	 */
+
+    methodBody:
+	if (hPtr == NULL) {
+	unknownMethod:
+	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+		    "unknown method \"%s\"", TclGetString(objv[3])));
+	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "METHOD",
+		    TclGetString(objv[3]), NULL);
+	    return TCL_ERROR;
+	}
+	procPtr = TclOOGetProcFromMethod(Tcl_GetHashValue(hPtr));
+	if (procPtr == NULL) {
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
+		    "body not available for this kind of method", -1));
+	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "DISASSEMBLE",
+		    "METHODTYPE", NULL);
+	    return TCL_ERROR;
+	}
+	if (procPtr->bodyPtr->typePtr != &tclByteCodeType) {
+	    Command cmd;
+
+	    /*
+	     * Yes, this is ugly, but we need to pass the namespace in to the
+	     * compiler in two places.
+	     */
+
+	    cmd.nsPtr = (Namespace *) oPtr->namespacePtr;
+	    procPtr->cmdPtr = &cmd;
+	    result = TclProcCompileProc(interp, procPtr, procPtr->bodyPtr,
+		    (Namespace *) oPtr->namespacePtr, "body of method",
+		    TclGetString(objv[3]));
+	    procPtr->cmdPtr = NULL;
+	    if (result != TCL_OK) {
+		return result;
+	    }
+	}
+	codeObjPtr = procPtr->bodyPtr;
+	break;
+    default:
+	CLANG_ASSERT(0);
+    }
+
+    /*
+     * Do the actual disassembly.
+     */
+
+    if (((ByteCode *) codeObjPtr->internalRep.twoPtrValue.ptr1)->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;
+    }
+    Tcl_SetObjResult(interp, TclDisassembleByteCodeObj(codeObjPtr));
+    return TCL_OK;
+}
+
 /*
  * Local Variables:
  * mode: c

generic/tclRegexp.c

@@ -946,8 +946,7 @@ CompileRegexp(
      * Tcl_RegExpExecObj to optionally do a fast match (avoids RE engine).
      */
 
-    if (TclReToGlob(NULL, string, length, &stringBuf, &exact,
-	    NULL) == TCL_OK) {
+    if (TclReToGlob(NULL, string, length, &stringBuf, &exact) == TCL_OK) {
 	regexpPtr->globObjPtr = TclDStringToObj(&stringBuf);
 	Tcl_IncrRefCount(regexpPtr->globObjPtr);
     } else {

generic/tclStubInit.c

@@ -1412,6 +1412,7 @@ const TclStubs tclStubs = {
     Tcl_FindSymbol, /* 628 */
     Tcl_FSUnloadFile, /* 629 */
     Tcl_ZlibStreamSetCompressionDictionary, /* 630 */
+    Tcl_Zvfs_Boot, /* 631 */
 };
 
 /* !END!: Do not edit above this line. */

generic/tclThread.c

@@ -357,12 +357,7 @@ TclFinalizeThreadData(void)
 {
     TclFinalizeThreadDataThread();
 #if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
-    if ((!TclInExit())||TclFullFinalizationRequested()) {
-	/*
-	 * Quick exit principle makes it useless to terminate allocators
-	 */
-	TclFinalizeThreadAllocThread();
-    }
+    TclFinalizeThreadAllocThread();
 #endif
 }
 

generic/tclThreadAlloc.c

@@ -217,11 +217,10 @@ GetCache(void)
 
     cachePtr = TclpGetAllocCache();
     if (cachePtr == NULL) {
-	cachePtr = TclpSysAlloc(sizeof(Cache), 0);
+	cachePtr = calloc(1, sizeof(Cache));
 	if (cachePtr == NULL) {
 	    Tcl_Panic("alloc: could not allocate new cache");
 	}
-        memset(cachePtr, 0, sizeof(Cache));
 	Tcl_MutexLock(listLockPtr);
 	cachePtr->nextPtr = firstCachePtr;
 	firstCachePtr = cachePtr;

generic/tclTrace.c

@@ -2511,9 +2511,6 @@ TclObjCallVarTraces(
     if (!part1Ptr) {
 	part1Ptr = localName(iPtr->varFramePtr, index);
     }
-    if (!part1Ptr) {
-	Tcl_Panic("Cannot trace a variable with no name");
-    }
     part1 = TclGetString(part1Ptr);
     part2 = part2Ptr? TclGetString(part2Ptr) : NULL;
 

generic/tclUtil.c

@@ -4249,8 +4249,7 @@ TclReToGlob(
     const char *reStr,
     int reStrLen,
     Tcl_DString *dsPtr,
-    int *exactPtr,
-    int *quantifiersFoundPtr)
+    int *exactPtr)
 {
     int anchorLeft, anchorRight, lastIsStar, numStars;
     char *dsStr, *dsStrStart;
@@ -4258,9 +4257,6 @@ TclReToGlob(
 
     strEnd = reStr + reStrLen;
     Tcl_DStringInit(dsPtr);
-    if (quantifiersFoundPtr != NULL) {
-	*quantifiersFoundPtr = 0;
-    }
 
     /*
      * "***=xxx" == "*xxx*", watch for glob-sensitive chars.
@@ -4373,9 +4369,6 @@ TclReToGlob(
 	    }
 	    break;
 	case '.':
-	    if (quantifiersFoundPtr != NULL) {
-		*quantifiersFoundPtr = 1;
-	    }
 	    anchorLeft = 0; /* prevent exact match */
 	    if (p+1 < strEnd) {
 		if (p[1] == '*') {

generic/tclVar.c

@@ -4405,8 +4405,8 @@ ObjMakeUpvar(
 			|| !HasLocalVars(varFramePtr)
 			|| (strstr(TclGetString(myNamePtr), "::") != NULL))) {
 	    Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_ObjPrintf(
-		    "bad variable name \"%s\": can't create namespace "
-		    "variable that refers to procedure variable",
+		    "bad variable name \"%s\": upvar won't create "
+		    "namespace variable that refers to procedure variable",
 		    TclGetString(myNamePtr)));
 	    Tcl_SetErrorCode(interp, "TCL", "UPVAR", "INVERTED", NULL);
 	    return TCL_ERROR;
@@ -4506,8 +4506,9 @@ TclPtrObjMakeUpvar(
 		 */
 
 		Tcl_SetObjResult((Tcl_Interp *) iPtr, Tcl_ObjPrintf(
-			"bad variable name \"%s\": can't create a scalar "
-			"variable that looks like an array element", myName));
+			"bad variable name \"%s\": upvar won't create a"
+			" scalar variable that looks like an array element",
+			myName));
 		Tcl_SetErrorCode(interp, "TCL", "UPVAR", "LOCAL_ELEMENT",
 			NULL);
 		return TCL_ERROR;

tests/aaa_exit.test

@@ -16,35 +16,22 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
     namespace import -force ::tcltest::*
 }
 
+
 test exit-1.1 {normal, quick exit} {
-     set f [open "|[interpreter] << \"exec [interpreter] << {set ::env(TCL_FINALIZE_ON_EXIT) 0;exit}\"" r]
-     set aft [after 1000 {set done "Quick exit hangs !!!"}]
+     set f [open "|[interpreter] << \"exec [interpreter] << {set ::env(TCL_FINALIZE_ON_EXIT) 0;exit}\" 2>@ stderr" r]
+     set aft [after 5000 {set done "Quick exit hangs !!!"}]
      fileevent $f readable {after cancel $aft;set done OK}
      vwait done
-     if {$done != "OK"} {
-     	fconfigure $f -blocking 0
-	close $f
-     } else {
-	if {[catch {close $f} err]} {
-	    set done "Quick exit misbehaves: $err"
-	}
-     }
+     catch {fconfigure $f -blocking 0;close $f}
      set done
 } OK
 
 test exit-1.2 {full-finalized exit} {
-     set f [open "|[interpreter] << \"exec [interpreter] << {set ::env(TCL_FINALIZE_ON_EXIT) 1;exit}\"" r]
-     set aft [after 1000 {set done "Full-finalized exit hangs !!!"}]
+     set f [open "|[interpreter] << \"exec [interpreter] << {set ::env(TCL_FINALIZE_ON_EXIT) 1;exit}\" 2>@ stderr" r]
+     set aft [after 5000 {set done "Full-finalized exit hangs !!!"}]
      fileevent $f readable {after cancel $aft;set done OK}
      vwait done
-     if {$done != "OK"} {
-     	fconfigure $f -blocking 0
-	close $f
-     } else {
-	if {[catch {close $f} err]} {
-	    set done "Full-finalized exit misbehaves: $err"
-	}
-     }
+     catch {fconfigure $f -blocking 0;close $f}
      set done
 } OK
 

tests/compile.test

@@ -658,15 +658,12 @@ test compile-17.2 {Command interpretation binding for non-compiled code} -setup
 # does not check the format of disassembled bytecode though; that's liable to
 # change without warning.
 
-set disassemblables [linsert [join {
-    lambda method objmethod proc script
-} ", "] end-1 or]
 test compile-18.1 {disassembler - basics} -returnCodes error -body {
     tcl::unsupported::disassemble
 } -match glob -result {wrong # args: should be "*"}
 test compile-18.2 {disassembler - basics} -returnCodes error -body {
     tcl::unsupported::disassemble ?
-} -result "bad type \"?\": must be $disassemblables"
+} -match glob -result {bad type "?": must be *}
 test compile-18.3 {disassembler - basics} -returnCodes error -body {
     tcl::unsupported::disassemble lambda
 } -match glob -result {wrong # args: should be "* lambda lambdaTerm"}
@@ -740,83 +737,6 @@ test compile-18.19 {disassembler - basics} -setup {
 } -cleanup {
     foo destroy
 } -match glob -result *
-# There never was a compile-18.20.
-# The keys of the dictionary produced by [getbytecode] are defined.
-set bytecodekeys {literals variables exception instructions auxiliary commands script namespace stackdepth exceptdepth}
-test compile-18.21 {disassembler - basics} -returnCodes error -body {
-    tcl::unsupported::getbytecode
-} -match glob -result {wrong # args: should be "*"}
-test compile-18.22 {disassembler - basics} -returnCodes error -body {
-    tcl::unsupported::getbytecode ?
-} -result "bad type \"?\": must be $disassemblables"
-test compile-18.23 {disassembler - basics} -returnCodes error -body {
-    tcl::unsupported::getbytecode lambda
-} -match glob -result {wrong # args: should be "* lambda lambdaTerm"}
-test compile-18.24 {disassembler - basics} -returnCodes error -body {
-    tcl::unsupported::getbytecode lambda \{
-} -result "can't interpret \"\{\" as a lambda expression"
-test compile-18.25 {disassembler - basics} -body {
-    dict keys [tcl::unsupported::getbytecode lambda {{} {}}]
-} -result $bytecodekeys
-test compile-18.26 {disassembler - basics} -returnCodes error -body {
-    tcl::unsupported::getbytecode proc
-} -match glob -result {wrong # args: should be "* proc procName"}
-test compile-18.27 {disassembler - basics} -returnCodes error -body {
-    tcl::unsupported::getbytecode proc nosuchproc
-} -result {"nosuchproc" isn't a procedure}
-test compile-18.28 {disassembler - basics} -setup {
-    proc chewonthis {} {}
-} -body {
-    dict keys [tcl::unsupported::getbytecode proc chewonthis]
-} -cleanup {
-    rename chewonthis {}
-} -result $bytecodekeys
-test compile-18.29 {disassembler - basics} -returnCodes error -body {
-    tcl::unsupported::getbytecode script
-} -match glob -result {wrong # args: should be "* script script"}
-test compile-18.30 {disassembler - basics} -body {
-    dict keys [tcl::unsupported::getbytecode script {}]
-} -result $bytecodekeys
-test compile-18.31 {disassembler - basics} -returnCodes error -body {
-    tcl::unsupported::getbytecode method
-} -match glob -result {wrong # args: should be "* method className methodName"}
-test compile-18.32 {disassembler - basics} -returnCodes error -body {
-    tcl::unsupported::getbytecode method nosuchclass foo
-} -result {nosuchclass does not refer to an object}
-test compile-18.33 {disassembler - basics} -returnCodes error -setup {
-    oo::object create justanobject
-} -body {
-    tcl::unsupported::getbytecode method justanobject foo
-} -cleanup {
-    justanobject destroy
-} -result {"justanobject" is not a class}
-test compile-18.34 {disassembler - basics} -returnCodes error -body {
-    tcl::unsupported::getbytecode method oo::object nosuchmethod
-} -result {unknown method "nosuchmethod"}
-test compile-18.35 {disassembler - basics} -setup {
-    oo::class create foo {method bar {} {}}
-} -body {
-    dict keys [tcl::unsupported::getbytecode method foo bar]
-} -cleanup {
-    foo destroy
-} -result $bytecodekeys
-test compile-18.36 {disassembler - basics} -returnCodes error -body {
-    tcl::unsupported::getbytecode objmethod
-} -match glob -result {wrong # args: should be "* objmethod objectName methodName"}
-test compile-18.37 {disassembler - basics} -returnCodes error -body {
-    tcl::unsupported::getbytecode objmethod nosuchobject foo
-} -result {nosuchobject does not refer to an object}
-test compile-18.38 {disassembler - basics} -returnCodes error -body {
-    tcl::unsupported::getbytecode objmethod oo::object nosuchmethod
-} -result {unknown method "nosuchmethod"}
-test compile-18.39 {disassembler - basics} -setup {
-    oo::object create foo
-    oo::objdefine foo {method bar {} {}}
-} -body {
-    dict keys [tcl::unsupported::getbytecode objmethod foo bar]
-} -cleanup {
-    foo destroy
-} -result $bytecodekeys
 
 test compile-19.0 {Bug 3614102: reset stack housekeeping} -body {
     # This will panic in a --enable-symbols=compile build, unless bug is fixed.

tests/coroutine.test

@@ -726,20 +726,6 @@ test coroutine-7.11 {yieldto context nuke: Bug a90d9331bc} -setup {
     catch {namespace delete ::cotest}
     catch {rename cotest ""}
 } -result {yieldto called in deleted namespace}
-test coroutine-7.12 {coro floor above street level #3008307} -body {
-    proc c {} {
-	yield
-    }
-    proc cc {} {
-	coroutine C c
-    }
-    proc boom {} {
-	cc ; # coro created at level 2
-	C  ; # and called at level 1
-    }
-    boom   ; # does not crash: the coro floor is a good insulator
-    list
-} -result {}
 
 
 # cleanup

tests/error.test

@@ -1184,12 +1184,6 @@ test error-21.8 {memory leaks in try: Bug 2910044} memory {
     }
 } 0
 
-test error-21.9 {Bug cee90e4e88} {
-    # Just don't panic.
-    apply {{} {try {} on ok {} - on return {} {}}}
-} {}
-
-
 # negative case try tests - bad "trap" handler
 # what is the effect if we attempt to trap an errorcode that is not a list?
 # nested try

tests/io.test

@@ -1484,39 +1484,6 @@ test io-12.6 {ReadChars: too many chars read} {
     }
     close $c
 } {}
-test io-12.7 {ReadChars: too many chars read [bc5b790099]} {
-    proc driver {cmd args} {
-        variable buffer
-        variable index
-        set chan [lindex $args 0]
-        switch -- $cmd {
-            initialize {
-                set index($chan) 0
-                set buffer($chan) [encoding convertto utf-8 \
-                        [string repeat \uBEEF 10]....\uBEEF]
-                return {initialize finalize watch read}
-            }
-            finalize {
-                unset index($chan) buffer($chan)
-                return
-            }
-            watch {}
-            read {
-                set n [lindex $args 1]
-                set new [expr {$index($chan) + $n}]
-                set result [string range $buffer($chan) $index($chan) $new-1]
-                set index($chan) $new
-                return $result
-            }
-        }
-    }
-    set c [chan create read [namespace which driver]]
-    chan configure $c -encoding utf-8
-    while {![eof $c]} {
-        read $c 7
-    }
-    close $c
-} {}
 
 test io-13.1 {TranslateInputEOL: cr mode} {} {
     set f [open $path(test1) w]
@@ -4325,74 +4292,6 @@ test io-33.10 {Tcl_Gets, exercising double buffering} {
     close $f
     set y
 } 300
-test io-33.11 {TclGetsObjBinary, [10dc6daa37]} -setup {
-    proc driver {cmd args} {
-        variable buffer
-        variable index
-        set chan [lindex $args 0]
-        switch -- $cmd {
-            initialize {
-                set index($chan) 0
-                set buffer($chan) .......
-                return {initialize finalize watch read}
-            }
-            finalize {
-                unset index($chan) buffer($chan)
-                return
-            }
-            watch {}
-            read {
-                set n [lindex $args 1]
-		if {$n > 3} {set n 3}
-                set new [expr {$index($chan) + $n}]
-                set result [string range $buffer($chan) $index($chan) $new-1]
-                set index($chan) $new
-                return $result
-            }
-        }
-    }
-} -body {
-    set c [chan create read [namespace which driver]]
-    chan configure $c -translation binary -blocking 0
-    list [gets $c] [gets $c] [gets $c] [gets $c]
-} -cleanup {
-    close $c
-    rename driver {}
-} -result {{} {} {} .......}
-test io-33.12 {TclGetsObjBinary, [10dc6daa37]} -setup {
-    proc driver {cmd args} {
-        variable buffer
-        variable index
-        set chan [lindex $args 0]
-        switch -- $cmd {
-            initialize {
-                set index($chan) 0
-                set buffer($chan) .......
-                return {initialize finalize watch read}
-            }
-            finalize {
-                unset index($chan) buffer($chan)
-                return
-            }
-            watch {}
-            read {
-                set n [lindex $args 1]
-		if {$n > 3} {set n 3}
-                set new [expr {$index($chan) + $n}]
-                set result [string range $buffer($chan) $index($chan) $new-1]
-                set index($chan) $new
-                return $result
-            }
-        }
-    }
-} -body {
-    set c [chan create read [namespace which driver]]
-    chan configure $c -blocking 0
-    list [gets $c] [gets $c] [gets $c] [gets $c]
-} -cleanup {
-    close $c
-    rename driver {}
-} -result {{} {} {} .......}
 
 # Test Tcl_Seek and Tcl_Tell.
 
@@ -7776,94 +7675,6 @@ test io-53.14 {TclCopyChannel: write error reporting} -setup {
     removeFile in
     rename driver {}
 } -result {error writing "*": *} -returnCodes error -match glob
-test io-53.15 {[ed29c4da21] DoRead: fblocked seen as error} -setup {
-    proc driver {cmd args} {
-        variable buffer
-        variable index
-        variable blocked
-        set chan [lindex $args 0]
-        switch -- $cmd {
-            initialize {
-                set index($chan) 0
-                set buffer($chan) [encoding convertto utf-8 \
-                        [string repeat a 100]]
-                set blocked($chan) 1
-                return {initialize finalize watch read}
-            }
-            finalize {
-                unset index($chan) buffer($chan) blocked($chan)
-                return
-            }
-            watch {}
-            read {
-                if {$blocked($chan)} {
-                    set blocked($chan) [expr {!$blocked($chan)}]
-                    return -code error EAGAIN
-                }
-                set n [lindex $args 1]
-                set new [expr {$index($chan) + $n}]
-                set result [string range $buffer($chan) $index($chan) $new-1]
-                set index($chan) $new
-                return $result
-            }
-        }
-    }
-    set c [chan create read [namespace which driver]]
-    chan configure $c -encoding utf-8
-    set out [makeFile {} out]
-    set outChan [open $out w]
-    chan configure $outChan -encoding utf-8
-} -body {
-    chan copy $c $outChan
-} -cleanup {
-    close $outChan
-    close $c
-    removeFile out
-} -result 100
-test io-53.16 {[ed29c4da21] MBRead: fblocked seen as error} -setup {
-    proc driver {cmd args} {
-        variable buffer
-        variable index
-        variable blocked
-        set chan [lindex $args 0]
-        switch -- $cmd {
-            initialize {
-                set index($chan) 0
-                set buffer($chan) [encoding convertto utf-8 \
-                        [string repeat a 100]]
-                set blocked($chan) 1
-                return {initialize finalize watch read}
-            }
-            finalize {
-                unset index($chan) buffer($chan) blocked($chan)
-                return
-            }
-            watch {}
-            read {
-                if {$blocked($chan)} {
-                    set blocked($chan) [expr {!$blocked($chan)}]
-                    return -code error EAGAIN
-                }
-                set n [lindex $args 1]
-                set new [expr {$index($chan) + $n}]
-                set result [string range $buffer($chan) $index($chan) $new-1]
-                set index($chan) $new
-                return $result
-            }
-        }
-    }
-    set c [chan create read [namespace which driver]]
-    chan configure $c -encoding utf-8 -translation lf
-    set out [makeFile {} out]
-    set outChan [open $out w]
-    chan configure $outChan -encoding utf-8 -translation lf
-} -body {
-    chan copy $c $outChan
-} -cleanup {
-    close $outChan
-    close $c
-    removeFile out
-} -result 100
 
 test io-54.1 {Recursive channel events} {socket fileevent} {
     # This test checks to see if file events are delivered during recursive

tests/lreplace.test

@@ -15,7 +15,7 @@ if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
     namespace import -force ::tcltest::*
 }
-
+
 test lreplace-1.1 {lreplace command} {
     lreplace {1 2 3 4 5} 0 0 a
 } {a 2 3 4 5}
@@ -130,19 +130,7 @@ test lreplace-3.1 {lreplace won't modify shared argument objects} {
     p
 } "a b c"
 
-test lreplace-4.1 {Bug ccc2c2cc98: lreplace edge case} {
-    lreplace {} 1 1
-} {}
-# Note that this test will fail in 8.5
-test lreplace-4.2 {Bug ccc2c2cc98: lreplace edge case} {
-    lreplace { } 1 1
-} {}
-
 # cleanup
 catch {unset foo}
 ::tcltest::cleanupTests
 return
-
-# Local Variables:
-# mode: tcl
-# End:

tests/oo.test

@@ -271,16 +271,6 @@ test oo-1.18.1 {Bug 75b8433707: memory leak in oo-1.18} -setup {
 } -cleanup {
     rename test-oo-1.18 {}
 } -result 0
-test oo-1.18.2 {Bug 21c144f0f5} -setup {
-    interp create slave
-} -body {
-    slave eval {
-	oo::define [oo::class create foo] superclass oo::class
-	oo::class destroy
-    }
-} -cleanup {
-    interp delete slave
-} 
 test oo-1.19 {basic test of OO functionality: teardown order} -body {
     oo::object create o
     namespace delete [info object namespace o]

tests/regexpComp.test

@@ -526,11 +526,6 @@ test regexpComp-9.6 {-all option to regsub} {
 	list [regsub -all ^ xxx 123 foo] $foo
     }
 } {1 123xxx}
-test regexpComp-9.7 {Bug 84af1192f5: -all option to regsub} {
-    evalInProc {
-	regsub -all {\(.*} 123(qwe) ""
-    }
-} 123
 
 test regexpComp-10.1 {expanded syntax in regsub} {
     evalInProc {

tests/socket.test

@@ -2321,28 +2321,6 @@ test socket-14.15 {blocking read on async socket should not trigger event handle
         set x
     } -result ok
 
-# v4 and v6 is required to prevent that the async connect does not terminate
-# before the fconfigure command. There is always an additional ip to try.
-test socket-14.16 {empty -peername while [socket -async] connecting} \
-    -constraints {socket localhost_v4 localhost_v6} \
-    -body {
-        set client [socket -async localhost [randport]]
-        fconfigure $client -peername
-    } -cleanup {
-        catch {close $client}
-    } -result {}
-
-# v4 and v6 is required to prevent that the async connect does not terminate
-# before the fconfigure command. There is always an additional ip to try.
-test socket-14.17 {empty -sockname while [socket -async] connecting} \
-    -constraints {socket localhost_v4 localhost_v6} \
-    -body {
-        set client [socket -async localhost [randport]]
-        fconfigure $client -sockname
-    } -cleanup {
-        catch {close $client}
-    } -result {}
-
 set num 0
 
 set x {localhost {socket} 127.0.0.1 {supported_inet} ::1 {supported_inet6}}

tests/upvar.test

@@ -339,7 +339,7 @@ test upvar-8.9 {upvar won't create namespace variable that refers to procedure v
 	unset ::test_ns_1::a
     }
     MakeLink 1
-} -result {bad variable name "a": can't create namespace variable that refers to procedure variable}
+} -result {bad variable name "a": upvar won't create namespace variable that refers to procedure variable}
 test upvar-8.10 {upvar will create element alias for new array element} -setup {
     catch {unset upvarArray}
 } -body {
@@ -578,6 +578,7 @@ test upvar-NS-3.3 {CompileWord OBOE} -setup {
 } -cleanup {
     rename linenumber {}
 } -result 1
+
 
 # cleanup
 ::tcltest::cleanupTests

tests/utf.test

@@ -287,11 +287,9 @@ test utf-18.5 {Tcl_UniCharToTitle, no delta} {
     string totitle !
 } !
 
-test utf-19.1 {TclUniCharLen} -body {
+test utf-19.1 {TclUniCharLen} {
     list [regexp \\d abc456def foo] $foo
-} -cleanup {
-    unset -nocomplain foo
-} -result {1 4}
+} {1 4}
 
 test utf-20.1 {TclUniCharNcmp} {
 } {}

tests/var.test

@@ -289,7 +289,7 @@ test var-3.11 {MakeUpvar, my var looks like array elem} -setup {
 } -returnCodes error -body {
     set aaaaa 789789
     upvar #0 aaaaa foo(bar)
-} -result {bad variable name "foo(bar)": can't create a scalar variable that looks like an array element}
+} -result {bad variable name "foo(bar)": upvar won't create a scalar variable that looks like an array element}
 
 test var-4.1 {Tcl_GetVariableName, global variable} testgetvarfullname {
     catch {unset a}
@@ -865,22 +865,6 @@ test var-20.8 {array set compilation correctness: Bug 3603163} -setup {
     }}
     array size x
 } -result 0
-test var-20.9 {[bc1a96407a] array set compiled w/ trace} -setup {
-    variable foo
-    variable lambda
-    unset -nocomplain lambda foo
-    array set foo {}
-    lappend lambda {}
-    lappend lambda [list array set [namespace which -variable foo] {a 1}]
-} -body {
-    after 0 [list apply $lambda]
-    vwait [namespace which -variable foo]
-} -cleanup {
-    unset -nocomplain lambda foo
-} -result {}
-test var-20.10 {[bc1a96407a] array set don't compile bad varname} -body {
-    apply {{} {set name foo(bar); array set $name {a 1}}}
-} -returnCodes error -match glob -result *
 
 test var-21.0 {PushVarNameWord OBOE in compiled unset} -setup {
     proc linenumber {} {dict get [info frame -1] line}

unix/Makefile.in

@@ -167,6 +167,7 @@ INSTALL_DATA_DIR	= ${INSTALL} -d -m 755
 # Do not use SHELL_ENV for NATIVE_TCLSH unless it is the tclsh being built.
 EXE_SUFFIX		= @EXEEXT@
 TCL_EXE			= tclsh${EXE_SUFFIX}
+TCLKIT_EXE		= tclkit${EXE_SUFFIX}
 TCLTEST_EXE		= tcltest${EXE_SUFFIX}
 NATIVE_TCLSH		= @TCLSH_PROG@
 
@@ -294,7 +295,7 @@ GENERIC_OBJS = regcomp.o regexec.o regfree.o regerror.o tclAlloc.o \
 	tclAssembly.o tclAsync.o tclBasic.o tclBinary.o tclCkalloc.o \
 	tclClock.o tclCmdAH.o tclCmdIL.o tclCmdMZ.o \
 	tclCompCmds.o tclCompCmdsGR.o tclCompCmdsSZ.o tclCompExpr.o \
-	tclCompile.o tclConfig.o tclDate.o tclDictObj.o tclDisassemble.o \
+	tclCompile.o tclConfig.o tclDate.o tclDictObj.o \
 	tclEncoding.o tclEnsemble.o \
 	tclEnv.o tclEvent.o tclExecute.o tclFCmd.o tclFileName.o tclGet.o \
 	tclHash.o tclHistory.o tclIndexObj.o tclInterp.o tclIO.o tclIOCmd.o \
@@ -307,7 +308,7 @@ GENERIC_OBJS = regcomp.o regexec.o regfree.o regerror.o tclAlloc.o \
 	tclResolve.o tclResult.o tclScan.o tclStringObj.o \
 	tclStrToD.o tclThread.o \
 	tclThreadAlloc.o tclThreadJoin.o tclThreadStorage.o tclStubInit.o \
-	tclTimer.o tclTrace.o tclUtf.o tclUtil.o tclVar.o tclZlib.o \
+	tclTimer.o tclTrace.o tclUtf.o tclUtil.o tclVar.o tclZlib.o tclZipVfs.o \
 	tclTomMathInterface.o
 
 OO_OBJS = tclOO.o tclOOBasic.o tclOOCall.o tclOODefineCmds.o tclOOInfo.o \
@@ -407,7 +408,6 @@ GENERIC_SRCS = \
 	$(GENERIC_DIR)/tclConfig.c \
 	$(GENERIC_DIR)/tclDate.c \
 	$(GENERIC_DIR)/tclDictObj.c \
-	$(GENERIC_DIR)/tclDisassemble.c \
 	$(GENERIC_DIR)/tclEncoding.c \
 	$(GENERIC_DIR)/tclEnsemble.c \
 	$(GENERIC_DIR)/tclEnv.c \
@@ -463,6 +463,7 @@ GENERIC_SRCS = \
 	$(GENERIC_DIR)/tclUtil.c \
 	$(GENERIC_DIR)/tclVar.c \
 	$(GENERIC_DIR)/tclAssembly.c \
+	$(GENERIC_DIR)/tclZipVfs.obj \
 	$(GENERIC_DIR)/tclZlib.c
 
 OO_SRCS = \
@@ -648,6 +649,16 @@ ${TCL_EXE}: ${TCLSH_OBJS} ${TCL_LIB_FILE} ${TCL_STUB_LIB_FILE}
 		@TCL_BUILD_LIB_SPEC@ ${TCL_STUB_LIB_FILE} ${LIBS} @EXTRA_TCLSH_LIBS@ \
 		${CC_SEARCH_FLAGS} -o ${TCL_EXE}
 
+null.zip:
+	touch .empty
+	zip null.zip .empty 
+
+${TCLKIT_EXE}: ${TCL_EXE} null.zip
+	PWD=`pwd`
+	cp -f ${TCL_EXE} ${TCLKIT_EXE}
+	cat null.zip >> ${TCLKIT_EXE}
+	cd ${prefix}/lib ; zip -rAq ${PWD}/${TCLKIT_EXE} tcl8 tcl8.6
+	
 # Must be empty so it doesn't conflict with rule for ${TCL_EXE} above
 ${NATIVE_TCLSH}:
 
@@ -1109,9 +1120,6 @@ tclConfig.o: $(GENERIC_DIR)/tclConfig.c
 tclDictObj.o: $(GENERIC_DIR)/tclDictObj.c $(MATHHDRS)
 	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclDictObj.c
 
-tclDisassemble.o: $(GENERIC_DIR)/tclDisassemble.c $(COMPILEHDR)
-	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclDisassemble.c
-
 tclEncoding.o: $(GENERIC_DIR)/tclEncoding.c
 	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclEncoding.c
 
@@ -1323,6 +1331,9 @@ tclUtf.o: $(GENERIC_DIR)/tclUtf.c $(GENERIC_DIR)/tclUniData.c
 tclVar.o: $(GENERIC_DIR)/tclVar.c
 	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclVar.c
 
+tclZipVfs.o:  $(GENERIC_DIR)/tclZipVfs.c
+	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclZipVfs.c
+
 tclZlib.o: $(GENERIC_DIR)/tclZlib.c
 	$(CC) -c $(CC_SWITCHES) $(ZLIB_INCLUDE) $(GENERIC_DIR)/tclZlib.c
 
@@ -1578,9 +1589,10 @@ tclUnixThrd.o: $(UNIX_DIR)/tclUnixThrd.c
 tclUnixTime.o: $(UNIX_DIR)/tclUnixTime.c
 	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixTime.c
 
-TCL_LOCATIONS=-DTCL_LIBRARY="\"${TCL_LIBRARY}\"" -DTCL_PACKAGE_PATH="\"${TCL_PACKAGE_PATH}\""
 tclUnixInit.o: $(UNIX_DIR)/tclUnixInit.c tclConfig.sh
-	$(CC) -c $(CC_SWITCHES) $(TCL_LOCATIONS) $(UNIX_DIR)/tclUnixInit.c
+	$(CC) -c $(CC_SWITCHES) -DTCL_LIBRARY=\"${TCL_LIBRARY}\" \
+		-DTCL_PACKAGE_PATH="\"${TCL_PACKAGE_PATH}\"" \
+		$(UNIX_DIR)/tclUnixInit.c
 
 tclUnixCompat.o: $(UNIX_DIR)/tclUnixCompat.c
 	$(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclUnixCompat.c

unix/configure

@@ -7676,14 +7676,7 @@ fi
 		LDFLAGS=""
 		;;
 	    *)
-		case "$arch" in
-		alpha|sparc64)
-		    SHLIB_CFLAGS="-fPIC"
-		    ;;
-		*)
-		    SHLIB_CFLAGS="-fpic"
-		    ;;
-		esac
+		SHLIB_CFLAGS="-fPIC"
 		SHLIB_LD='${CC} -shared ${SHLIB_CFLAGS}'
 		SHLIB_SUFFIX=".so"
 		DL_OBJS="tclLoadDl.o"

unix/tcl.m4

@@ -1475,14 +1475,7 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
 		LDFLAGS=""
 		;;
 	    *)
-		case "$arch" in
-		alpha|sparc64)
-		    SHLIB_CFLAGS="-fPIC"
-		    ;;
-		*)
-		    SHLIB_CFLAGS="-fpic"
-		    ;;
-		esac
+		SHLIB_CFLAGS="-fPIC"
 		SHLIB_LD='${CC} -shared ${SHLIB_CFLAGS}'
 		SHLIB_SUFFIX=".so"
 		DL_OBJS="tclLoadDl.o"

unix/tclAppInit.c

@@ -15,7 +15,7 @@
 #undef BUILD_tcl
 #undef STATIC_BUILD
 #include "tcl.h"
-
+#include "tclInt.h"
 #ifdef TCL_TEST
 extern Tcl_PackageInitProc Tcltest_Init;
 extern Tcl_PackageInitProc Tcltest_SafeInit;
@@ -108,6 +108,8 @@ int
 Tcl_AppInit(
     Tcl_Interp *interp)		/* Interpreter for application. */
 {
+    Tcl_Zvfs_Boot(interp);
+    
     if ((Tcl_Init)(interp) == TCL_ERROR) {
 	return TCL_ERROR;
     }
@@ -124,7 +126,7 @@ Tcl_AppInit(
     }
     Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init, Tcltest_SafeInit);
 #endif /* TCL_TEST */
-
+    
     /*
      * Call the init procedures for included packages. Each call should look
      * like this:

unix/tclUnixSock.c

@@ -823,20 +823,7 @@ TcpGetOptionProc(
         address peername;
         socklen_t size = sizeof(peername);
 
-	if ( (statePtr->flags & TCP_ASYNC_CONNECT) ) {
-	    /*
-	     * In async connect output an empty string
-	     */
-	    if (len == 0) {
-		Tcl_DStringAppendElement(dsPtr, "-peername");
-		Tcl_DStringAppendElement(dsPtr, "");
-	    } else {
-		return TCL_OK;
-	    }
-	} else if (getpeername(statePtr->fds.fd, &peername.sa, &size) >= 0) {
-	    /*
-	     * Peername fetch succeeded - output list
-	     */
+	if (getpeername(statePtr->fds.fd, &peername.sa, &size) >= 0) {
 	    if (len == 0) {
 		Tcl_DStringAppendElement(dsPtr, "-peername");
 		Tcl_DStringStartSublist(dsPtr);
@@ -876,18 +863,11 @@ TcpGetOptionProc(
 	    Tcl_DStringAppendElement(dsPtr, "-sockname");
 	    Tcl_DStringStartSublist(dsPtr);
 	}
-	if ( (statePtr->flags & TCP_ASYNC_CONNECT) ) {
-	    /*
-	     * In async connect output an empty string
-	     */
-	     found = 1;
-	} else {
-	    for (fds = &statePtr->fds; fds != NULL; fds = fds->next) {
-		size = sizeof(sockname);
-		if (getsockname(fds->fd, &(sockname.sa), &size) >= 0) {
-		    found = 1;
-		    TcpHostPortList(interp, dsPtr, sockname, size);
-		}
+	for (fds = &statePtr->fds; fds != NULL; fds = fds->next) {
+	    size = sizeof(sockname);
+	    if (getsockname(fds->fd, &(sockname.sa), &size) >= 0) {
+		found = 1;
+                TcpHostPortList(interp, dsPtr, sockname, size);
 	    }
 	}
         if (found) {

unix/tclUnixTime.c

@@ -16,6 +16,9 @@
 #include <mach/mach_time.h>
 #endif
 
+#define TM_YEAR_BASE 1900
+#define IsLeapYear(x)	(((x)%4 == 0) && ((x)%100 != 0 || (x)%400 == 0))
+
 /*
  * TclpGetDate is coded to return a pointer to a 'struct tm'. For thread
  * safety, this structure must be in thread-specific data. The 'tmKey'

win/Makefile.in

@@ -145,6 +145,7 @@ SHARED_LIBRARIES 	= $(TCL_DLL_FILE) @ZLIB_DLL_FILE@
 STATIC_LIBRARIES	= $(TCL_LIB_FILE)
 
 TCLSH			= tclsh$(VER)${EXESUFFIX}
+TCLKIT			= tclkit$(VER)${EXESUFFIX}
 CAT32			= cat32$(EXEEXT)
 MAN2TCL			= man2tcl$(EXEEXT)
 
@@ -232,7 +233,6 @@ GENERIC_OBJS = \
 	tclConfig.$(OBJEXT) \
 	tclDate.$(OBJEXT) \
 	tclDictObj.$(OBJEXT) \
-	tclDisassemble.$(OBJEXT) \
 	tclEncoding.$(OBJEXT) \
 	tclEnsemble.$(OBJEXT) \
 	tclEnv.$(OBJEXT) \
@@ -295,7 +295,8 @@ GENERIC_OBJS = \
 	tclUtf.$(OBJEXT) \
 	tclUtil.$(OBJEXT) \
 	tclVar.$(OBJEXT) \
-	tclZlib.$(OBJEXT)
+	tclZlib.$(OBJEXT) \
+	tclZipVfs.$(OBJEXT)
 
 TOMMATH_OBJS = \
 	bncore.${OBJEXT} \
@@ -423,6 +424,18 @@ $(TCLSH): $(TCLSH_OBJS) @LIBRARIES@ $(TCL_STUB_LIB_FILE) tclsh.$(RES)
         tclsh.$(RES) $(CC_EXENAME) $(LDFLAGS_CONSOLE)
 	@VC_MANIFEST_EMBED_EXE@
 
+tclkit: $(TCLKIT)
+
+null.zip:
+	touch .empty
+	zip null.zip .empty
+	
+$(TCLKIT): $(TCLSH) null.zip
+	PWD=`pwd`
+	cp -f $(WISH) $(TCLKIT)
+	cat null.zip >> $(TCLKIT)
+	cd ${prefix}/lib ; zip -rAq ${PWD}/$(TCLKIT) tcl8 tcl8.6
+
 cat32.$(OBJEXT): cat.c
 	$(CC) -c $(CC_SWITCHES) @DEPARG@ $(CC_OBJNAME)
 
@@ -868,6 +881,6 @@ html-tk: $(TCLSH)
 .PHONY: install-doc install-private-headers test test-tcl runtest shell
 .PHONY: gdb depend cleanhelp clean distclean packages install-packages
 .PHONY: test-packages clean-packages distclean-packages genstubs html
-.PHONY: html-tcl html-tk
+.PHONY: html-tcl html-tk tclkit
 
 # DO NOT DELETE THIS LINE -- make depend depends on it.

win/makefile.bc

@@ -207,7 +207,6 @@ TCLOBJS	= \
 	$(TMPDIR)\tclConfig.obj \
 	$(TMPDIR)\tclDate.obj \
 	$(TMPDIR)\tclDictObj.obj \
-	$(TMPDIR)\tclDisassemble.obj \
 	$(TMPDIR)\tclEncoding.obj \
 	$(TMPDIR)\tclEnsemble.obj \
 	$(TMPDIR)\tclEnv.obj \
@@ -276,6 +275,7 @@ TCLOBJS	= \
 	$(TMPDIR)\tclWinSock.obj \
 	$(TMPDIR)\tclWinThrd.obj \
 	$(TMPDIR)\tclWinTime.obj \
+	$(TMP_DIR)\tclZipVfs.obj \
 	$(TMPDIR)\tclZlib.obj
 
 TCLSTUBOBJS	= \
@@ -588,7 +588,3 @@ clean:
 	-@$(RM) $(TMPDIR)\*.exe
 	-@$(RMDIR) $(OUTDIR)
 	-@$(RMDIR) $(TMPDIR)
-
-# Local Variables:
-# mode: makefile
-# End:

win/makefile.vc

@@ -1,4 +1,4 @@
-#-------------------------------------------------------------
+#------------------------------------------------------------- -*- makefile -*-
 # makefile.vc --
 #
 #	Microsoft Visual C++ makefile for use with nmake.exe v1.62+ (VC++ 5.0+)
@@ -281,7 +281,6 @@ COREOBJS = \
 	$(TMP_DIR)\tclConfig.obj \
 	$(TMP_DIR)\tclDate.obj \
 	$(TMP_DIR)\tclDictObj.obj \
-	$(TMP_DIR)\tclDisassemble.obj \
 	$(TMP_DIR)\tclEncoding.obj \
 	$(TMP_DIR)\tclEnsemble.obj \
 	$(TMP_DIR)\tclEnv.obj \
@@ -344,6 +343,7 @@ COREOBJS = \
 	$(TMP_DIR)\tclUtf.obj \
 	$(TMP_DIR)\tclUtil.obj \
 	$(TMP_DIR)\tclVar.obj \
+	$(TMP_DIR)\tclZipVfs.obj \
 	$(TMP_DIR)\tclZlib.obj
 
 ZLIBOBJS = \
@@ -932,6 +932,9 @@ $(TMP_DIR)\tclTestObj.obj: $(GENERICDIR)\tclTestObj.c
 $(TMP_DIR)\tclWinTest.obj: $(WINDIR)\tclWinTest.c
 	$(cc32) $(TCL_CFLAGS) -Fo$@ $?
 
+$(TMP_DIR)\tclZipVfs.obj: $(GENERICDIR)\tclZipVfs.c
+	$(cc32) $(TCL_CFLAGS) -I$(COMPATDIR)\zlib -DBUILD_tcl -Fo$@ $?
+
 $(TMP_DIR)\tclZlib.obj: $(GENERICDIR)\tclZlib.c
 	$(cc32) $(TCL_CFLAGS) -I$(COMPATDIR)\zlib -DBUILD_tcl -Fo$@ $?
 
@@ -1230,7 +1233,3 @@ realclean: hose
 hose:
 	@echo Hosing $(OUT_DIR)\* ...
 	@if exist $(OUT_DIR)\nul $(RMDIR) $(OUT_DIR)
-
-# Local Variables:
-# mode: makefile
-# End:

win/tclAppInit.c

@@ -15,6 +15,7 @@
  */
 
 #include "tcl.h"
+#include "tclInt.h"
 #define WIN32_LEAN_AND_MEAN
 #include <windows.h>
 #undef WIN32_LEAN_AND_MEAN
@@ -151,6 +152,8 @@ int
 Tcl_AppInit(
     Tcl_Interp *interp)		/* Interpreter for application. */
 {
+    Tcl_Zvfs_Boot(interp);
+    
     if ((Tcl_Init)(interp) == TCL_ERROR) {
 	return TCL_ERROR;
     }

win/tclWinPort.h

@@ -433,17 +433,17 @@ typedef DWORD_PTR * PDWORD_PTR;
  * EDEADLK as the same value, which confuses Tcl_ErrnoId().
  */
 
-#if defined(_MSC_VER) || defined(__MSVCRT__)
+#if defined(_MSC_VER) || defined(__MINGW32__)
 #   define environ _environ
 #   if defined(_MSC_VER) && (_MSC_VER < 1600)
 #	define hypot _hypot
 #   endif
 #   define exception _exception
 #   undef EDEADLOCK
-#   if defined(_MSC_VER) && (_MSC_VER >= 1700)
+#   if defined(__MINGW32__) && !defined(__MSVCRT__)
 #	define timezone _timezone
 #   endif
-#endif /* _MSC_VER || __MSVCRT__ */
+#endif /* _MSC_VER || __MINGW32__ */
 
 /*
  * Borland's timezone and environ functions.
@@ -505,7 +505,7 @@ typedef DWORD_PTR * PDWORD_PTR;
  * Msvcrt's putenv() copies the string rather than takes ownership of it.
  */
 
-#if defined(_MSC_VER) || defined(__MSVCRT__)
+#if defined(_MSC_VER) || defined(__MINGW32__)
 #   define HAVE_PUTENV_THAT_COPIES 1
 #endif
 

win/tclWinSock.c

@@ -1337,20 +1337,7 @@ TcpGetOptionProc(
 	address peername;
 	socklen_t size = sizeof(peername);
 
-	if ( (statePtr->flags & TCP_ASYNC_PENDING) ) {
-	    /*
-	     * In async connect output an empty string
-	     */
-	    if (len == 0) {
-		Tcl_DStringAppendElement(dsPtr, "-peername");
-		Tcl_DStringAppendElement(dsPtr, "");
-	    } else {
-		return TCL_OK;
-	    }
-	} else if ( getpeername(sock, (LPSOCKADDR) &(peername.sa), &size) == 0) {
-	    /*
-	     * Peername fetch succeeded - output list
-	     */
+	if (getpeername(sock, (LPSOCKADDR) &(peername.sa), &size) == 0) {
 	    if (len == 0) {
 		Tcl_DStringAppendElement(dsPtr, "-peername");
 		Tcl_DStringStartSublist(dsPtr);
@@ -1399,55 +1386,49 @@ TcpGetOptionProc(
 	    Tcl_DStringAppendElement(dsPtr, "-sockname");
 	    Tcl_DStringStartSublist(dsPtr);
 	}
-	if ( (statePtr->flags & TCP_ASYNC_PENDING ) ) {
-	    /*
-	     * In async connect output an empty string
-	     */
-	     found = 1;
-	} else {
-	    for (fds = statePtr->sockets; fds != NULL; fds = fds->next) {
-		sock = fds->fd;
-		size = sizeof(sockname);
-		if (getsockname(sock, &(sockname.sa), &size) >= 0) {
-		    int flags = reverseDNS;
+	for (fds = statePtr->sockets; fds != NULL; fds = fds->next) {
+	    sock = fds->fd;
+	    size = sizeof(sockname);
+	    if (getsockname(sock, &(sockname.sa), &size) >= 0) {
+		int flags = reverseDNS;
 
-		    found = 1;
-		    getnameinfo(&sockname.sa, size, host, sizeof(host),
-			    NULL, 0, NI_NUMERICHOST);
-		    Tcl_DStringAppendElement(dsPtr, host);
+		found = 1;
+		getnameinfo(&sockname.sa, size, host, sizeof(host),
+			NULL, 0, NI_NUMERICHOST);
+		Tcl_DStringAppendElement(dsPtr, host);
 
-		    /*
-		     * We don't want to resolve INADDR_ANY and sin6addr_any; they
-		     * can sometimes cause problems (and never have a name).
-		     */
-		    flags |= NI_NUMERICSERV;
-		    if (sockname.sa.sa_family == AF_INET) {
-			if (sockname.sa4.sin_addr.s_addr == INADDR_ANY) {
-			    flags |= NI_NUMERICHOST;
-			}
-		    } else if (sockname.sa.sa_family == AF_INET6) {
-			if ((IN6_ARE_ADDR_EQUAL(&sockname.sa6.sin6_addr,
-				    &in6addr_any)) ||
-				(IN6_IS_ADDR_V4MAPPED(&sockname.sa6.sin6_addr)
-				&& sockname.sa6.sin6_addr.s6_addr[12] == 0
-				&& sockname.sa6.sin6_addr.s6_addr[13] == 0
-				&& sockname.sa6.sin6_addr.s6_addr[14] == 0
-				&& sockname.sa6.sin6_addr.s6_addr[15] == 0)) {
-			    flags |= NI_NUMERICHOST;
-			}
+		/*
+		 * We don't want to resolve INADDR_ANY and sin6addr_any; they
+		 * can sometimes cause problems (and never have a name).
+		 */
+		flags |= NI_NUMERICSERV;
+		if (sockname.sa.sa_family == AF_INET) {
+		    if (sockname.sa4.sin_addr.s_addr == INADDR_ANY) {
+			flags |= NI_NUMERICHOST;
+		    }
+		} else if (sockname.sa.sa_family == AF_INET6) {
+		    if ((IN6_ARE_ADDR_EQUAL(&sockname.sa6.sin6_addr,
+				&in6addr_any)) ||
+			    (IN6_IS_ADDR_V4MAPPED(&sockname.sa6.sin6_addr)
+			    && sockname.sa6.sin6_addr.s6_addr[12] == 0
+			    && sockname.sa6.sin6_addr.s6_addr[13] == 0
+			    && sockname.sa6.sin6_addr.s6_addr[14] == 0
+			    && sockname.sa6.sin6_addr.s6_addr[15] == 0)) {
+			flags |= NI_NUMERICHOST;
 		    }
-		    getnameinfo(&sockname.sa, size, host, sizeof(host),
-			    port, sizeof(port), flags);
-		    Tcl_DStringAppendElement(dsPtr, host);
-		    Tcl_DStringAppendElement(dsPtr, port);
 		}
+		getnameinfo(&sockname.sa, size, host, sizeof(host),
+			port, sizeof(port), flags);
+		Tcl_DStringAppendElement(dsPtr, host);
+		Tcl_DStringAppendElement(dsPtr, port);
 	    }
 	}
 	if (found) {
-	    if (len) {
+	    if (len == 0) {
+		Tcl_DStringEndSublist(dsPtr);
+	    } else {
 		return TCL_OK;
 	    }
-	    Tcl_DStringEndSublist(dsPtr);
 	} else {
 	    if (interp) {
 		TclWinConvertError((DWORD) WSAGetLastError());

win/tclkit.exe.manifest.in

@@ -0,0 +1,51 @@
+<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
+<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0"
+	xmlns:asmv3="urn:schemas-microsoft-com:asm.v3">
+    <assemblyIdentity
+	    version="@TCL_WIN_VERSION@"
+	    processorArchitecture="@MACHINE@"
+	    name="Tcl.tclsh"
+	    type="win32"
+	/>
+    <description>Tcl self-contained executable (tclkit)</description>
+    <trustInfo xmlns="urn:schemas-microsoft-com:asm.v3">
+	<security>
+	    <requestedPrivileges>
+		<requestedExecutionLevel
+			level="asInvoker"
+			uiAccess="false"
+		    />
+	    </requestedPrivileges>
+	</security>
+    </trustInfo>
+    <compatibility xmlns="urn:schemas-microsoft-com:compatibility.v1">
+	<application>
+	    <!-- Windows 8.1 -->
+	    <supportedOS Id="{1f676c76-80e1-4239-95bb-83d0f6d0da78}"/>
+	    <!-- Windows 8 -->
+	    <supportedOS Id="{4a2f28e3-53b9-4441-ba9c-d69d4a4a6e38}"/>
+	    <!-- Windows 7 -->
+	    <supportedOS Id="{35138b9a-5d96-4fbd-8e2d-a2440225f93a}"/>
+	    <!-- Windows Vista -->
+	    <supportedOS Id="{e2011457-1546-43c5-a5fe-008deee3d3f0}"/>
+	</application>
+    </compatibility>
+    <asmv3:application>
+	<asmv3:windowsSettings
+		xmlns="http://schemas.microsoft.com/SMI/2005/WindowsSettings">
+	    <dpiAware>true</dpiAware>
+	</asmv3:windowsSettings>
+    </asmv3:application>
+    <dependency>
+	<dependentAssembly>
+	    <assemblyIdentity
+		    type="win32"
+		    name="Microsoft.Windows.Common-Controls"
+		    version="6.0.0.0"
+		    processorArchitecture="@MACHINE@"
+		    publicKeyToken="6595b64144ccf1df"
+		    language="*"
+		/>
+	</dependentAssembly>
+    </dependency>
+</assembly>

win/tclkit.rc

@@ -0,0 +1,82 @@
+//
+// Version Resource Script
+//
+
+#include <winver.h>
+#include <tcl.h>
+
+//
+// build-up the name suffix that defines the type of build this is.
+//
+#if TCL_THREADS
+#define SUFFIX_THREADS	    "t"
+#else
+#define SUFFIX_THREADS	    ""
+#endif
+
+#if STATIC_BUILD
+#define SUFFIX_STATIC	    "s"
+#else
+#define SUFFIX_STATIC	    ""
+#endif
+
+#if DEBUG && !UNCHECKED
+#define SUFFIX_DEBUG	    "g"
+#else
+#define SUFFIX_DEBUG	    ""
+#endif
+
+#define SUFFIX		    SUFFIX_THREADS SUFFIX_STATIC SUFFIX_DEBUG
+
+
+LANGUAGE 0x9, 0x1	/* LANG_ENGLISH, SUBLANG_DEFAULT */
+
+VS_VERSION_INFO VERSIONINFO
+ FILEVERSION 	TCL_MAJOR_VERSION,TCL_MINOR_VERSION,TCL_RELEASE_LEVEL,TCL_RELEASE_SERIAL
+ PRODUCTVERSION TCL_MAJOR_VERSION,TCL_MINOR_VERSION,TCL_RELEASE_LEVEL,TCL_RELEASE_SERIAL
+ FILEFLAGSMASK 	0x3fL
+#ifdef DEBUG
+ FILEFLAGS 	VS_FF_DEBUG
+#else
+ FILEFLAGS 	0x0L
+#endif
+ FILEOS 	VOS__WINDOWS32
+ FILETYPE 	VFT_APP
+ FILESUBTYPE 	0x0L
+BEGIN
+    BLOCK "StringFileInfo"
+    BEGIN
+        BLOCK "040904b0"
+        BEGIN
+            VALUE "FileDescription", "Tclkit Application\0"
+            VALUE "OriginalFilename", "tclkit" STRINGIFY(TCL_MAJOR_VERSION) STRINGIFY(TCL_MINOR_VERSION) SUFFIX ".exe\0"
+            VALUE "CompanyName", "ActiveState Corporation\0"
+            VALUE "FileVersion", TCL_PATCH_LEVEL
+            VALUE "LegalCopyright", "Copyright \251 2000 by ActiveState Corporation, et al\0"
+            VALUE "ProductName", "Tcl " TCL_VERSION " for Windows\0"
+            VALUE "ProductVersion", TCL_PATCH_LEVEL
+        END
+    END
+    BLOCK "VarFileInfo"
+    BEGIN
+        VALUE "Translation", 0x409, 1200
+    END
+END
+
+//
+// Icon
+//
+
+tclsh                      ICON    DISCARDABLE     "tclsh.ico"
+
+//
+// This is needed for Windows 8.1 onwards.
+//
+
+#ifndef RT_MANIFEST
+#define RT_MANIFEST     24
+#endif
+#ifndef CREATEPROCESS_MANIFEST_RESOURCE_ID
+#define CREATEPROCESS_MANIFEST_RESOURCE_ID 1
+#endif
+CREATEPROCESS_MANIFEST_RESOURCE_ID RT_MANIFEST "tclkit.exe.manifest"